Real-time collaboration for Jupyter Notebooks, Linux Terminals, LaTeX, VS Code, R IDE, and more,
all in one place.
Real-time collaboration for Jupyter Notebooks, Linux Terminals, LaTeX, VS Code, R IDE, and more,
all in one place.
| Download
GAP 4.8.9 installation with standard packages -- copy to your CoCalc project to get it
Project: cocalc-sagemath-dev-slelievre
Views: 418346#############################################################################
##
## HAPPRIME - derivation.gi
## Functions, Operations and Methods to implement derivations
## Paul Smith
##
## Copyright (C) 2008
## Paul Smith
## National University of Ireland Galway
##
## This file is part of HAPprime.
##
## HAPprime is free software; you can redistribute it and/or modify
## it under the terms of the GNU General Public License as published by
## the Free Software Foundation; either version 2 of the License, or
## (at your option) any later version.
##
## HAPprime is distributed in the hope that it will be useful,
## but WITHOUT ANY WARRANTY; without even the implied warranty of
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
## GNU General Public License for more details.
##
## You should have received a copy of the GNU General Public License
## along with this program. If not, see <http://www.gnu.org/licenses/>.
##
## $Id: derivation.gi 341 2008-11-18 14:35:02Z pas $
##
#############################################################################
#####################################################################
## <#GAPDoc Label="HAPDerivationRep_DTmanDerivationNODOC">
## <ManSection>
## <Filt Name="IsHAPDerivationRep" Arg="O" Type="Representation"/>
## <Description>
## Returns <K>true</K> if the object is in the internal representation used for
## a <K>HAPDerivation</K>, or <K>false</K> otherwise
## </Returns>
## </ManSection>
## <#/GAPDoc>
#####################################################################
DeclareRepresentation(
"IsHAPDerivationRep",
IsComponentObjectRep and IsAttributeStoringRep,
["ring", "relations", "images"]
);
# Note this also defines the function IsHAPDerivationRep
#####################################################################
#####################################################################
# The type for a HAPDerivation is a HAPDerivation in
# HAPDerivationRep representation, in the HAPDerivation family
HAPDerivationType :=
NewType(NewFamily("HAPDerivationFamily"), IsHAPDerivation and IsHAPDerivationRep);
#####################################################################
#####################################################################
## <#GAPDoc Label="HAPDerivation_DTmanDerivation_Con">
## <ManSection Label="HAPDerivationConstructors">
## <Heading>HAPDerivation construction functions</Heading>
## <Oper Name="HAPDerivation" Arg="R[, I], images"/>
## <Oper Name="HAPDerivationNC" Arg="R, I, images"/>
##
## <Returns>
## <K>HAPDerivation</K>
## </Returns>
## <Description>
## Construct a <K>HAPDerivation</K> object representing the derivation
## <M>d</M> where <A>R</A> is a polynomial ring and
## <A>images</A> is the list of the images of the ring indeterminates under the
## derivation, <M>\{d(x_1), d(x_2), \ldots, d(x_n)\}</M>.
## An optional set of relations <A>I</A> can also be provided, which are
## passed to <Ref Oper="KernelOfDerivation"/> when calculating the kernel
## or homology of this derivation.
## The function <K>HAPDerivation</K> checks that the arguments are
## compatible, while the <C>NC</C> method performs no checks.
## </Description>
## </ManSection>
## <#/GAPDoc>
#####################################################################
InstallMethod(HAPDerivation,
[IsPolynomialRing, IsHomogeneousList, IsHomogeneousList and IsRationalFunctionCollection],
function(ring, relations, images)
local i;
# Check that there is one image for each ring indeterminant
if Length(IndeterminatesOfPolynomialRing(ring)) <> Length(images) then
Error("the number of images in <images> is not the same as the number of indeterminants in <ring>.");
fi;
# Check that each element in <relations> is in the ring
for i in relations do
if not i in ring then
Error("the entries in <relations> must all be polynomials from <ring>.");
fi;
od;
# Check that each element in <images> is in the ring
for i in images do
if not i in ring then
Error("the entries in <images> must all be polynomials from <ring>.");
fi;
od;
return HAPDerivationNC(ring, relations, images);
end
);
#####################################################################
InstallOtherMethod(HAPDerivation,
[IsPolynomialRing, IsHomogeneousList and IsRationalFunctionCollection],
function(ring, images)
return HAPDerivation(ring, [], images);
end
);
#####################################################################
InstallMethod(HAPDerivationNC,
[IsPolynomialRing, IsHomogeneousList, IsHomogeneousList and IsRationalFunctionCollection],
function(ring, relations, images)
local images2, indets, i;
# The ith entry in image corresponds to the ith entry in
# IndeterminatesOfPolynomialRing(ring), and not necessarily to
# the indeterminate _number_. We want to store them according to
# indeterminant number to make later operations more efficient.
images2 := [];
indets := IndeterminatesOfPolynomialRing(ring);
for i in [1..Length(images)] do
images2[IndeterminateNumberOfUnivariateRationalFunction(indets[i])] := images[i];
od;
return Objectify(
HAPDerivationType,
rec(ring := ring, relations := relations, images := images2)
);
end
);
#####################################################################
#####################################################################
## <#GAPDoc Label="DerivationRing_DTmanDerivation_Dat">
## <ManSection>
## <Attr Name="DerivationRing" Arg="d"/>
##
## <Returns>
## Polynomial ring
## </Returns>
## <Description>
## Returns the ring over which the derivation <A>d</A> is defined.
## </Description>
## </ManSection>
## <#/GAPDoc>
#####################################################################
InstallMethod(
DerivationRing,
[IsHAPDerivation],
function(d)
return d!.ring;
end
);
#####################################################################
#####################################################################
## <#GAPDoc Label="DerivationImages_DTmanDerivation_Dat">
## <ManSection>
## <Attr Name="DerivationImages" Arg="d"/>
##
## <Returns>
## List of polynomials
## </Returns>
## <Description>
## A derivation <A>d</A> over a (quotient) polynomial ring is defined by
## a set of images.
## This function returns this list of images. The <M>i</M>th element of the
## list is the image of indeterminate number <M>i</M> in that ring family.
## (Note that indeterminate number <M>i</M> is not necessarily the <M>i</M>th
## indeterminate in that particular ring.
## See <Ref Sect="Indeterminates" BookName="ref"/> for more details.)
## </Description>
## </ManSection>
## <#/GAPDoc>
#####################################################################
InstallMethod(
DerivationImages,
[IsHAPDerivation],
function(d)
return d!.images;
end
);
#####################################################################
#####################################################################
## <#GAPDoc Label="DerivationRelations_DTmanDerivation_Dat">
## <ManSection>
## <Attr Name="DerivationRelations" Arg="d"/>
##
## <Returns>
## List of polynomials
## </Returns>
## <Description>
## Returns the relations of the quotient ring over which the derivation
## <A>d</A> is defined.
## </Description>
## </ManSection>
## <#/GAPDoc>
#####################################################################
InstallMethod(
DerivationRelations,
[IsHAPDerivation],
function(d)
return d!.relations;
end
);
#####################################################################
#####################################################################
## <#GAPDoc Label="ViewObj_DTmanDerivationNODOC">
## <ManSection>
## <Meth Name="ViewObj" Arg="d" Label="for HAPDerivation"/>
##
## <Description>
## Prints a short description of the derivation <A>d</A>. This is the usual
## description printed by &GAP;.
## </Description>
## </ManSection>
## <Log><![CDATA[
## gap> View(d);
## <Derivation>
## ]]></Log>
## <#/GAPDoc>
#####################################################################
InstallMethod(
ViewObj,
"for HAPDerivation",
[IsHAPDerivation],
function(obj)
Print("<Derivation>");
end
);
#####################################################################
#####################################################################
## <#GAPDoc Label="PrintObj_DTmanDerivationNODOC">
## <ManSection>
## <Meth Name="PrintObj" Arg="d" Label="for HAPDerivation"/>
##
## <Description>
## Prints a detailed description of the derivation <A>d</A>.
## </Description>
## </ManSection>
## <Log><![CDATA[
## gap> Print(d);
## Derivation over PolynomialRing( GF(2), ["x_1", "x_2"] ), with images:
## d(x_1) = Z(2)^0
## d(x_2) = Z(2)^0
## ]]></Log>
## <#/GAPDoc>
#####################################################################
InstallMethod(
PrintObj,
"for HAPDerivation",
[IsHAPDerivation],
function(obj)
Print("HAPDerivation(", DerivationRing(obj), ", ",
DerivationRelations(obj), ", ",
DerivationImages(obj){
List(IndeterminatesOfPolynomialRing(DerivationRing(obj)),
IndeterminateNumberOfUnivariateRationalFunction)}, ")");
end
);
#####################################################################
#####################################################################
## <#GAPDoc Label="Display_DTmanDerivationNODOC">
## <ManSection>
## <Meth Name="Display" Arg="d" Label="for HAPDerivation"/>
##
## <Description>
## Displays the derivation <A>d</A> in a human-readable form.
## </Description>
## </ManSection>
## <Log><![CDATA[
## gap> Display(d);
## Derivation over PolynomialRing( GF(2), ["x_1", "x_2"] )
## , with images:
## d(x_1) = Z(2)^0
## d(x_2) = Z(2)^0
## ]]></Log>
## <#/GAPDoc>
#####################################################################
InstallMethod(
Display,
"for HAPDerivation",
[IsHAPDerivation],
function(obj)
local indets, i, images;
Print("Derivation over ");
Display(DerivationRing(obj));
if not IsEmpty(DerivationRelations(obj)) then
Print(" / ", DerivationRelations(obj));
fi;
Print(", with images:\n");
indets := IndeterminatesOfPolynomialRing(DerivationRing(obj));
images := DerivationImages(obj);
for i in [1..Length(indets)] do
Print("d(", indets[i], ") = ");
Display(images[IndeterminateNumberOfUnivariateRationalFunction(indets[i])]);
od;
end
);
#####################################################################
#####################################################################
## <#GAPDoc Label="ImageOfDerivation_DTmanDerivation_Hom">
## <ManSection>
## <Oper Name="ImageOfDerivation" Arg="d, poly"/>
##
## <Returns>
## Polynomial
## </Returns>
## <Description>
## Returns the image of the polynomial <A>poly</A> under the derivation
## <A>d</A>. (<A>poly</A> must be a polynomial in the
## derivation's ring.)
## </Description>
## </ManSection>
## <#/GAPDoc>
#####################################################################
InstallMethod(ImageOfDerivation,
[IsHAPDerivation, IsPolynomial],
function(d, poly)
local ring, images, oneR, zeroR, t, image, ImageOfMonomial;
ring := DerivationRing(d);
zeroR := Zero(ring);
if not poly in ring then
Error("<poly> must be a polynomial in the ring of <d>");
fi;
if IsOne(poly) or IsZero(poly) then
return zeroR;
fi;
images := DerivationImages(d);
oneR := One(ring);
##################################
# Return (as a polynomial) the image of the
# monomial
ImageOfMonomial := function(mon)
local coeff, n, i, j, image, im, ImageOfPart;
if IsZero(mon) or IsOne(mon) then
return zeroR;
fi;
##########################
ImageOfPart := function(mon)
local exp, indetnum, unimon;
unimon := IndeterminateAndExponentOfUnivariateMonomial(mon);
indetnum := IndeterminateNumberOfUnivariateRationalFunction(unimon[1]);
exp := unimon[2];
if exp = 1 then
return images[indetnum];
else
return exp*unimon[1]^(exp-1)*images[indetnum];
fi;
end;
##########################
image := zeroR;
for i in UnivariateMonomialsOfMonomial(mon) do
im := oneR;
for j in UnivariateMonomialsOfMonomial(mon) do
if j = i then
im := im * ImageOfPart(i);
else
im := im * j;
fi;
od;
image := image + im;
od;
return image;
end;
##################################
image := zeroR;
for t in TermsOfPolynomial(poly) do
image := image + t[2] * oneR * ImageOfMonomial(t[1]);
od;
return image;
end
);
#####################################################################
#if LoadPackage("singular") = true then
if IsPackageMarkedForLoading("singular","0") then
#####################################################################
## <#GAPDoc Label="KernelOfDerivation_DTmanDerivation_Hom">
## <ManSection>
## <Oper Name="KernelOfDerivation" Arg="d [, avoid]"/>
##
## <Returns>
## List
## </Returns>
## <Description>
## Returns a ring presentation <M>S/J</M> for the kernel of the derivation
## <A>d</A>, where <M>S</M> is a polynomial ring and <M>J</M> are a set of
## relations.
## This operation returns a list with the following elements:
## <Enum>
## <Item>the new polynomial ring <M>S</M></Item>
## <Item>a basis for the ideal, as a set of relations <M>J</M></Item>
## <Item>the ring isomorphism between the kernel (i.e. a subring of the
## derivation's ring) and the new ring. This is given using the
## <K>HAPRingHomomorphism</K> type, for details of which see
## <Ref Chap="RingHomomorphism"/></Item>
## </Enum>
## An optional parameter, <A>avoid</A>, can be provided which lists
## indeterminates to avoid when creating the the new polynomial ring.
## <P/>
## <E>This function is only available if the package
## <Package>singular</Package> is available</E>.
## </Description>
## </ManSection>
## <#/GAPDoc>
#####################################################################
InstallOtherMethod(KernelOfDerivation,
"for no alternative indeterminates",
[IsHAPDerivation],
function(d)
return KernelOfDerivation(d, []);
end
);
#####################################################################
InstallMethod(KernelOfDerivation,
"with specified alternative indeterminates",
[IsHAPDerivation, IsHomogeneousList],
function(d, avoid)
local ring, ideal, p, gens, g, img, B, coeffs, A, i, K, k, oneR, zeroR,
indets, kernelgenerators, kernelindets, newkernelring, kernelrelations,
foundunity, kernelindetexps, message, Smod, l, j, h, kernelmap,
reductionmap, combinedmap;
ring := DerivationRing(d);
indets := IndeterminatesOfPolynomialRing(ring);
ideal := DerivationRelations(d);
p := Characteristic(CoefficientsRing(ring));
if IsZero(p) then
Error("can only calculate the kernel of rings with a coefficient ring of positive characteristic");
fi;
oneR := One(ring);
zeroR := Zero(ring);
# Remember the smallext power of each exponent that we know is in the
# kernel
kernelindetexps := [];
for i in indets do
if IsZero(ImageOfDerivation(d, i)) then
Add(kernelindetexps, 1);
else
Add(kernelindetexps, p);
fi;
od;
# If all the images are zero, then the kernel is the whole ring
if ForAll(kernelindetexps, IsOne) then
newkernelring := PolynomialRing(
CoefficientsRing(ring), Length(indets),
Concatenation(indets, avoid));
kernelmap := HAPRingHomomorphismByIndeterminateMap(
ring, ideal, newkernelring);
if InfoLevel(InfoHAPprime) >= 2 then
Info(InfoHAPprime, 2, "Zero derivation: Kernel is whole ring");
message := "Change of indeterminates: ";
for i in [1..Length(SourceGenerators(kernelmap))] do
message := Concatenation(
message, String(SourceGenerators(kernelmap)[i]), "=",
String(ImageGenerators(kernelmap)[i]), ", ");
od;
Remove(message, Length(message)); # Remove the last space
Remove(message, Length(message)); # Remove the last comma
Info(InfoHAPprime, 2, message);
fi;
return [ImagePolynomialRing(kernelmap),
ImageRelations(kernelmap), kernelmap];
fi;
# We can now start to make a list of our kernel generators by using
# kernelindetexps
kernelgenerators := [];
for i in [1..Length(indets)] do
Add(kernelgenerators, indets[i]^kernelindetexps[i]);
od;
# We shall use Singular to find the kernel
# of the derivation, by finding the kernel of a S-module
# homomorphism
Smod := HAPPRIME_SModule(ring, kernelindetexps);
# Calculate the derivation of each of our S-module generators,
# and add it to A in S-module form
A := [];
for g in Smod.generators do
img := ImageOfDerivation(d, g);
Add(A, Smod.FromPoly(img));
od;
# And needs to be column-major
A := TransposedMat(A);
# B is made up of the generators of the ideal (again, in
# S-module form)
# We need the multiple with each of the S-module generators
# as well as the raw relations
if IsEmpty(ideal) then
B := [ListWithIdenticalEntries(Length(Smod.generators), zeroR)];
else
B := [];
for i in ideal do
for g in Smod.generators do
Add(B, Smod.FromPoly(i*g));
od;
od;
fi;
# And needs to be column-major
B := TransposedMat(B);
# Now calculate the kernel of the module homomorphism using singular
SingularSetBaseRing(Smod.Sring);
K := SingularInterface("modulo", [A, B], "matrix");
# And turn it back into GAP row-major
K := TransposedMat(K);
# And now the relations from our kernel
foundunity := false;
for coeffs in K do
g := Smod.ToPoly(coeffs);
if g = oneR then
foundunity := true;
else
Add(kernelgenerators, g);
fi;
od;
if not foundunity then
Error("no unity element in the kernel");
fi;
# Info(InfoHAPprime, 2, "Raw kernel generators are ", kernelgenerators);
# Our kernel ideal is the old ring ideal in the derivation, plus the
# relations that explain how our new indeterminates relate to the old ones
# Make sure there's no zeros in here, since that can cause problems later
kernelrelations := Filtered(ideal, i->not IsZero(i));
# And make sure that it's a Groebner Basis
SetTermOrdering(ring, "dp");
kernelrelations := SingularReducedGroebnerBasis(
Ideal(ring, kernelrelations));
# Now reduce this list
# First get rid of anything in the ideal
SingularSetNormalFormIdealNC(Ideal(ring, kernelrelations));
i := 1;
l := Length(kernelgenerators);
while i <= l do
if IsZero(SingularPolynomialNormalForm(kernelgenerators[i])) then
# If it's in the ideal, remove it
Remove(kernelgenerators, i);
l := l - 1;
else
i := i + 1;
fi;
od;
# We now want to remove any generators that are products of other ones
# that we have.
# Sort the generators into increasing degree so that the simplest
# ones are tested first
Sort(kernelgenerators);
i := 2;
l := Length(kernelgenerators);
while i <= l do
# Get the next generator
g := kernelgenerators[i];
# See if it can be divided by anything else in our list
# We only need to consider factors before this in the list since
# any factor has to have a smaller degree
j := 1;
while j < i do
h := g / kernelgenerators[j];
if IsOne(DenominatorOfRationalFunction(h)) then
# the division was OK, so keep the answer and try again
g := h;
else
# try another divisor
j := j + 1;
fi;
od;
if IsOne(g) then
# It is entirely generated as a product of other generators,
# so we remove it
Remove(kernelgenerators, i);
l := l - 1;
else
# Otherwise we keep it
i := i + 1;
fi;
od;
# Now assign indeterminates to each of the kernel generators
# There will be one indeterminate for each entry in kernelgenerators
newkernelring := PolynomialRing(
CoefficientsRing(ring), Length(kernelgenerators),
Concatenation(indets, avoid));
# And create the isomorphism between our kernel in the original ring
# and our kernel in this ring
# now make the map
kernelmap := HAPSubringToRingHomomorphism(
kernelgenerators, kernelrelations, newkernelring);
# But the image of this map may not be in reduced form, so
# compute the reduced form of this
reductionmap := HAPRingReductionHomomorphism(kernelmap);
combinedmap := CompositionRingHomomorphism(kernelmap, reductionmap);
if InfoLevel(InfoHAPprime) >= 2 then
for i in [1..Length(SourceGenerators(combinedmap))] do
Info(InfoHAPprime, 2,
"Kernel generator ", SourceGenerators(combinedmap)[i], " = ",
ImageGenerators(combinedmap)[i]);
od;
fi;
return [ImagePolynomialRing(combinedmap),
ImageRelations(combinedmap), combinedmap];
end
);
#####################################################################
#####################################################################
## <#GAPDoc Label="HomologyOfDerivation_DTmanDerivation_Hom">
## <ManSection>
## <Oper Name="HomologyOfDerivation" Arg="d[, avoid]"/>
##
## <Returns>
## List
## </Returns>
## <Description>
## Returns a ring presentation <M>S/J</M> for the homology of the derivation
## <A>d</A>, where <M>S</M> is a polynomial ring and <M>J</M> are a set of
## relations.
## Returns a polynomial ring presentation for the homology <M>ker(d)/im(d)</M>
## of the derivation <A>d</A>.
## This operation returns a list with the following elements:
## <Enum>
## <Item>the new polynomial ring <M>S</M></Item>
## <Item>a basis for the ideal, as a set of relations <M>J</M></Item>
## <Item>the ring isomorphism between the kernel (i.e. a subring of the
## derivation's ring) and the new ring. This is given using the
## <K>HAPRingHomomorphism</K> type, for details of which see
## <Ref Chap="RingHomomorphism"/></Item>
## </Enum>
## <P/>
## An optional parameter, <A>avoid</A>, can be provided which lists
## indeterminates to avoid when creating the the new polynomial ring.
## </Description>
## </ManSection>
## <#/GAPDoc>
#####################################################################
InstallOtherMethod(HomologyOfDerivation,
"for no alternative indeterminates",
[IsHAPDerivation],
function(d)
return HomologyOfDerivation(d, []);
end
);
#####################################################################
InstallMethod(HomologyOfDerivation,
"with a set of alternative indeterminates",
[IsHAPDerivation, IsHomogeneousList],
function(d, avoid)
local ring, gens, imgens, g, i, kernel, kernelindetexps, reductionmap, p,
Smod, message, totalmap, totalgens, totalrels;
ring := DerivationRing(d);
p := Characteristic(CoefficientsRing(ring));
# If all the images are zero, then the homology is the whole ring
# (and is the same as the kernel)
if IsZero(Compacted(DerivationImages(d))) then
# Just return the kernel
kernel := KernelOfDerivation(d, avoid);
Info(InfoHAPprime, 2, "Zero derivation: Homology is whole ring");
return kernel;
fi;
# Remember the smallest power of each exponent that we know is in the
# kernel
kernelindetexps := [];
for i in IndeterminatesOfPolynomialRing(ring) do
if IsZero(ImageOfDerivation(d, i)) then
Add(kernelindetexps, 1);
else
Add(kernelindetexps, p);
fi;
od;
# Find generators for the image.
# These are the images of all of the generators of the ring as an R-module
imgens := [];
Smod := HAPPRIME_SModule(ring, kernelindetexps);
for g in Smod.generators do
AddSet(imgens, ImageOfDerivation(d, g));
od;
# if there's a zero, remove it since it's not interesting
i := Position(imgens, Zero(ring));
if i <> fail then
Remove(imgens, i);
fi;
# If the image includes one then the answer is just the trivial
# ring
for i in imgens do
if IsOne(i) then
return [Ring(Zero(i)), [ ],
HAPZeroRingHomomorphism(ring, DerivationRelations(d)) ];
fi;
od;
# Calculate the kernel of the derivation
kernel := KernelOfDerivation(d, avoid);
Info(InfoHAPprime, 2, "Kernel relations ", kernel[2]);
# The image is expressed in terms of the indeterminates of d.
# We want to convert this into the indeterminates of the new kernel
# presentation. (This will always be
# possible since the image is a subring of the kernel - provided that
# the derivation squares to zero).
imgens := ImageOfRingHomomorphism(kernel[3], imgens);
Info(InfoHAPprime, 2, "Image relations ", imgens);
# Add these to the ideal from the kernel and calculate the Grobner basis
# to tidy things up
imgens := SingularGroebnerBasis(
Ideal(kernel[1], Concatenation(imgens, kernel[2])));
# Now see if we can reduce the presentation
reductionmap := HAPRingReductionHomomorphism(kernel[1], imgens,
Concatenation(IndeterminatesOfPolynomialRing(ring), avoid));
if InfoLevel(InfoHAPprime) >= 2 then
message := "Change of indeterminates: ";
for i in [1..Length(SourceGenerators(reductionmap))] do
message := Concatenation(
message, String(SourceGenerators(reductionmap)[i]), "=",
String(ImageGenerators(reductionmap)[i]), ", ");
od;
Remove(message, Length(message)); # Remove the last space
Remove(message, Length(message)); # Remove the last comma
Info(InfoHAPprime, 2, message);
fi;
# We want to return a mapping between the homology in the original ring
# indeterminates and the final reduced version.
# Feed the image of the homology map back through and through the kernel
# map to see what the generators of the kernel are.
totalgens :=
List(IndeterminatesOfPolynomialRing(ImagePolynomialRing(reductionmap)),
i->PreimageOfRingHomomorphism(kernel[3],
PreimageOfRingHomomorphism(reductionmap, i)));
# For the relations, we keep the kernel relations, but we also want
# any from the image that end up in the homology. So, we also feed the
# imgens the homology back through the kernel and define them at the
# source (removing any zeros). This may include
# indeterminates that do not feature in the generators of the homology,
# but which are killed in the homology, but that's OK
totalrels := Concatenation(SourceRelations(kernel[3]),
Filtered(List(SourceRelations(reductionmap),
i->PreimageOfRingHomomorphism(kernel[3], i)), j->not IsZero(j)));
# now build the map
totalmap := HAPSubringToRingHomomorphism(
totalgens, totalrels, ImagePolynomialRing(reductionmap));
return [
ImagePolynomialRing(reductionmap),
ImageRelations(reductionmap),
totalmap];
end
);
#####################################################################
else
InstallMethod(KernelOfDerivation,
[IsHAPDerivation, IsHomogeneousList],
function(d, indetsAlt)
Error("The package 'singular' cannot be loaded, so this 'HAPprime' function is not available");
end
);
#####################################################################
InstallMethod(HomologyOfDerivation,
[IsHAPDerivation, IsHomogeneousList],
function(d, indetsAlt)
Error("The package 'singular' cannot be loaded, so this 'HAPprime' function is not available");
end
);
fi;
#####################################################################
#####################################################################
## <#GAPDoc Label="HAPPRIME_SModule_DTmanDerivationInt">
## <ManSection>
## <Func Name="HAPPRIME_SModule" Arg="R, exps"/>
##
## <Returns>
## Record
## </Returns>
## <Description>
## For a polynomial ring <A>R</A>, <M>k[x_1, x_2, ..., x_n]</M>,
## and list of exponents <A>exps</A>, <M>[e_1, e_2, ..., e_n]</M>, returns
## a record which represents <A>R</A> as an <M>S</M>-module, where
## <M>S</M> is the subring of
## <A>R</A> given by <M>k[x_1^{e_1}, x_2^{e_2}, ..., x_n^{e_n}]</M>
## <P/>
## The record has the following components:
## <List>
## <Item><C>Rring</C> the original ring <A>R</A></Item>
## <Item><C>Sring</C> a ring isomorphic to the subring of powers <M>S</M></Item>
## <Item><C>Spows</C> the exponents <A>exps</A></Item>
## <Item><C>generators</C> the list of generators of <A>R</A> as an
## <M>S</M>-module</Item>
## <Item><C>FromPoly</C> a function which takes a polynomial in <A>R</A> and
## returns the corresponding element in the <M>S</M>-module (as a
## vector)</Item>
## <Item><C>ToPoly</C> a function which takes an element in the
## <M>S</M>-module (as a vector) and returns the corresponding polynomial
## in <A>R</A></Item>
## </List>
## </Description>
## </ManSection>
## <#/GAPDoc>
#####################################################################
InstallGlobalFunction(HAPPRIME_SModule,
function(R, exps)
local indets, n, field, p, Sring, Sindets, gens, oneR, zeroR, exps2, j, i,
gen, PolynomialToSModule, SModuleToPolynomial;
if not IsPolynomialRing(R) then
Error("<R> must be a polynomial ring");
fi;
indets := IndeterminatesOfPolynomialRing(R);
n := Length(indets);
if Length(exps) <> n or not IsHomogeneousList(exps) then
Error("<exps> must be a list of (positive integer) exponents for the indeterminates of <R>");
fi;
field := CoefficientsRing(R);
p := Characteristic(field);
if IsZero(p) then
Error("the S-module representation is only available for positive characteristics");
fi;
# We shall use a different set of indeterminates for the
# subring. Create this.
Sring := PolynomialRing(field, n, indets);
Sindets := IndeterminatesOfPolynomialRing(Sring);
# Create the set of generators
gens := [];
oneR := One(R);
zeroR := Zero(R);
# exps is the list of exponents for this generator
exps2 := ListWithIdenticalEntries(n, 0);
repeat
gen := oneR;
for j in [1..n] do
gen := gen * indets[j]^exps2[j];
od;
Add(gens, gen);
# Now move to the next generator
i := 1;
repeat
exps2[i] := exps2[i] + 1;
if exps2[i] = exps[i] then
exps2[i] := 0;
i := i + 1;
else
i := n+2; # this means we have successfully updated
fi;
until i > n;
until i = n+1;
###################
# Converts an element of R into an element in the S-module
# (as a vector)
PolynomialToSModule := function(poly)
local coeffs, terms, i, modrep,
MonomialToSModuleRep;
if IsZero(poly) then
# note that zeroR = zeroS and oneR = oneS
return ListWithIdenticalEntries(Length(gens), zeroR);
fi;
if IsOne(poly) then
coeffs := ListWithIdenticalEntries(Length(gens), zeroR);
coeffs[1] := oneR;
return coeffs;
fi;
##################################
# Convert a monomial to module coefficients
# Returns a list with as the first element the basis number, and as
# the second element the coefficient of that basis element
MonomialToSModuleRep := function(mon)
local umon, gen, coeff, i, inum, exp, Spow;
umon := UnivariateMonomialsOfMonomial(mon);
if IsZero(umon[1]) then
return [1, Zero(field)];
fi;
if IsOne(umon[1]) then
return [1, One(field)];
fi;
gen := oneR;
coeff := oneR;
for i in umon do
i := IndeterminateAndExponentOfUnivariateMonomial(i);
inum := Position(indets, i[1]);
exp := i[2];
# How much of this indeterminate in the Sring do we have?
Spow := QuoInt(exp, exps[inum]);
if Spow > 0 then
# Copy across the number of powers of p of this indeterminant in
# this exponent
coeff := coeff * Sindets[inum]^Spow;
fi;
# And build up the generator that this corresponds to
gen := gen * indets[inum]^(exp - Spow*exps[inum]);
od;
return [Position(gens, gen), coeff];
end;
##################################
coeffs := ListWithIdenticalEntries(Length(gens), zeroR);
terms := TermsOfPolynomial(poly);
for i in terms do
modrep := MonomialToSModuleRep(i[1]);
coeffs[modrep[1]] := coeffs[modrep[1]] + i[2]*modrep[2];
od;
return coeffs;
end;
###################
###################
# Converts a vector from the S-module into a polynomial element of R
SModuleToPolynomial := function(coeffs)
local poly, i, coeff, SMonomialToRMonomial, SPolynomialToRPolynomial;
##################################
# Convert a monomial in S to a monomial in R
SMonomialToRMonomial := function(mon)
local Rmon, umon, i, inum;
Rmon := oneR;
umon := UnivariateMonomialsOfMonomial(mon);
for i in umon do
i := IndeterminateAndExponentOfUnivariateMonomial(i);
inum := Position(Sindets, i[1]);
Rmon := Rmon * indets[inum]^(i[2] * exps[inum]);
od;
return Rmon;
end;
##################################
# Convert a polynomial in S to a polynomial in R
SPolynomialToRPolynomial := function(poly)
local Rpoly, terms, i, mon;
if IsZero(poly) or IsOne(poly) then
return poly;
fi;
Rpoly := zeroR;
terms := TermsOfPolynomial(poly);
for i in terms do
mon := SMonomialToRMonomial(i[1]);
Rpoly := Rpoly + i[2]*mon;
od;
return Rpoly;
end;
##################################
poly := zeroR;
for i in [1..Length(gens)] do
if not IsZero(coeffs[i]) then
coeff := SPolynomialToRPolynomial(coeffs[i]);
poly := poly + gens[i]*coeff;
fi;
od;
return poly;
end;
###################
return rec(
Rring := R,
Sring := Sring,
Spows := exps,
generators := gens,
FromPoly := PolynomialToSModule,
ToPoly := SModuleToPolynomial);
end
);
#####################################################################