Quelle affine-def.gi Sprache: unbekannt

#############################################################################
##
#W affine-def.gi Manuel Delgado <mdelgado@fc.up.pt>
#W Pedro Garcia-Sanchez <pedro@ugr.es>
##
#Y Copyright 2015-- Centro de Matemática da Universidade do Porto, Portugal and Universidad de Granada, Spain
#############################################################################
################# Defining Affine Semigroups ###############
###############################################################################
##
#F AffineSemigroupByGenerators(arg)
##
## Returns the affine semigroup generated by arg.
##
## The argument arg is either a list of lists of positive integers of equal length (a matrix) or consists of lists of integers with equal length
#############################################################################
InstallGlobalFunction(AffineSemigroupByGenerators, function(arg)
 local gens, M;

 if Length(arg) = 1 then
 if ForAll(arg[1], x -> (IsPosInt(x) or x = 0)) then
 gens := Set(arg);
 else
 gens := Set(arg[1]);
 fi;
 else
 gens := Set(arg);
 fi;

 if not IsRectangularTable(gens) then
 Error("The arguments must be lists of non negative integers with the same length, or a list of such lists");
 elif not ForAll(gens, l -> ForAll(l,x -> (IsPosInt(x) or x = 0))) then
 Error("The arguments must be lists of non negative integers with the same length, or a list of such lists");
 fi;
 M:= Objectify( AffineSemigroupsType, rec());

 SetGenerators(M,gens);
 SetDimension(M,Length(gens[1]));

# Setter(IsAffineSemigroupByGenerators)(M,true);
 return M;
end);

#############################################################################
##
#O Generators(S)
##
## Computes a set of generators of the affine semigroup S.
## If a set of generators has already been computed, this
## is the set returned.
############################################################################
InstallMethod(Generators,
 "Computes a set of generators of the affine semigroup",
 [IsAffineSemigroup],1,
 function(S)
 local basis, eq, H, Corollary9;

 if HasGenerators(S) then
 return Generators(S);
 fi;
 if HasMinimalGenerators(S) then
 return MinimalGenerators(S);
 fi;

 if HasEquations(S) then
 eq:=Equations(S);
 basis := HilbertBasisOfSystemOfHomogeneousEquations(eq[1],eq[2]);
 SetMinimalGenerators(S,basis);
 return MinimalGenerators(S);
 elif HasInequalities(S) then
 basis := HilbertBasisOfSystemOfHomogeneousInequalities(AffineSemigroupInequalities(S));
 SetMinimalGenerators(S,basis);
 return MinimalGenerators(S);
 fi;
 if HasGaps(S) then
 H:=Gaps(S);
 #########################################################
 #F Corollary9(<h>)
 # Returns if it is possible, a system of generators of
 # \N^(|h[1]|) \setminus <h>, or [] if not.
 #
 Corollary9 := function(h)
 local lSi, lSip, lH, lHi, le, si, sp, se, MinimalElements;

 #########################################################
 #F MinimalElements(<a>, , <c>)
 # Returns the minimal elements in with respect to
 # <a> \cup discarding every e in such that
 # exists z \in <a> \cup and e-z \notin <c> and
 # e-z is in the 1st ortant
 #
 MinimalElements := function(a, b, c)
 local slenA, slenB, si, lb, lminimals, ldif, bDiscard;

 slenA := Length(a);
 slenB := Length(b);
 lminimals := [];
 for lb in b do
 bDiscard := false;
 si := 1;
 while si<=slenA and not bDiscard do
 ldif := lb-a[si];
 if ForAll(ldif, v->v>=0) and not ldif in c then
 bDiscard := true;
 fi;
 si := si+1;
 od;
 if not bDiscard then
 si := 1;
 while si<=slenB and not bDiscard do
 if b[si]=lb then ## skip the same element
 si := si+1;
 continue;
 fi;
 ldif := lb-b[si];
 if ForAll(ldif, v->v>=0) and not ldif in c then
 bDiscard := true;
 fi;
 si := si+1;
 od;
 fi;
 if not bDiscard then
 Append(lminimals, [lb]);
 fi;
 od;
 return lminimals;
 end;

 if not IsRectangularTable(h) then
 Error("The argument must be a list of list");
 fi;
 sp := Length(h[1]);
 lH := ShallowCopy(h);
 lSi := IdentityMat(sp);
 lHi := [];
 si := 1;
 while lH <> [] and si<=Length(lH) do
 se := First([1..Length(lSi)], v->lSi[v]=lH[si]);
 if se=fail then
 si := si+1;
 continue;
 fi;
 le := lH[si];
 Remove(lH, si);
 Add(lHi, le);
 lSip := [List(3*le)];
 Append(lSip, List(lSi, v->v+le));
 Remove(lSi, se);
 se := 1;
 while se <= Length(lSip) do
 if lSip[se] in lSi then
 Remove(lSip, se);
 else
 se := se+1;
 fi;
 od;
 Append(lSi, MinimalElements(lSi, lSip, lHi));
 od;
 #if lH <> [] then
 # return [];
 #fi;
 return lSi;
 end;
 SetMinimalGenerators(S,Corollary9(H));
 return MinimalGenerators(S);
 fi;
end);

#############################################################################
##
#O Generators(S)
##
## Computes a set of generators of the affine semigroup S.
## If a set of generators has already been computed, this
## is the set returned.
############################################################################
InstallMethod(Generators,
 "Computes a set of generators of the affine semigroup",
 [IsAffineSemigroup and HasPMInequality],10,
 function(M)
 local MinimalGensAndMaybeGapsFromInequality, ineq,
 MinimalGensFromInequalityN2;

MinimalGensAndMaybeGapsFromInequality:=function(f, b, g)
 local ComputeForGGreaterThanZero, ComputeForGGreaterLowerZero;

 if ForAll(g, v->v<0) then
 # Setter #######################
 SetMinimalGenerators(M, []);
 ################################
 elif ForAll(g, v->v>0) then
 ComputeForGGreaterThanZero := function()
 local sp, si, se, lH, lsH, lSi, lSip, lHi, le, MinimalElements;

 #########################################################
 #F MinimalElements(<a>, , <c>)
 # Returns the minimal elements in with respect to
 # <a> \cup discarding every e in such that
 # exists z \in <a> \cup and e-z \notin <c> and
 # e-z is in the 1st ortant
 #
 MinimalElements := function(a, b, c)
 local slenA, slenB, si, lb, lminimals, ldif, bDiscard;

 slenA := Length(a);
 slenB := Length(b);
 lminimals := [];
 for lb in b do
 bDiscard := false;
 si := 1;
 while si<=slenA and not bDiscard do
 ldif := lb-a[si];
 if ForAll(ldif, v->v>=0) and not ldif in c then
 bDiscard := true;
 fi;
 si := si+1;
 od;
 if not bDiscard then
 si := 1;
 while si<=slenB and not bDiscard do
 if b[si]=lb then ## skip the same element
 si := si+1;
 continue;
 fi;
 ldif := lb-b[si];
 if ForAll(ldif, v->v>=0) and not ldif in c then
 bDiscard := true;
 fi;
 si := si+1;
 od;
 fi;
 if not bDiscard then
 Append(lminimals, [lb]);
 fi;
 od;
 return lminimals;
 end;

 sp := Length(g);
 lH := [];
 for si in [1..b-1] do
 lsH := FactorizationsIntegerWRTList(si, g);
 for se in lsH do
 if f*se mod b > g*se then
 Add(lH, se);
 fi;
 od;
 od;
 # Setter ###############
 SetGaps(M, lH);
 ########################
 lSi := IdentityMat(sp);
 lHi := [];
 si := 1;
 while lH <> [] do
 se := First([1..Length(lSi)], v->lSi[v]=lH[si]);
 if se<>fail then
 le := lH[si];
 Remove(lH, si);
 Add(lHi, le);
 lSip := [List(3*le)];
 Append(lSip, List(lSi, v->v+le));
 Remove(lSi, se);
 se := 1;
 while se <= Length(lSip) do
 if lSip[se] in lSi then
 Remove(lSip, se);
 else
 se := se+1;
 fi;
 od;
 Append(lSi, MinimalElements(lSi, lSip, lHi));
 else
 si := si+1;
 fi;
 od;
 return lSi;
 end;

 # Setter ######################################
 SetMinimalGenerators(M, ComputeForGGreaterThanZero());
 ###############################################
 else
 ComputeForGGreaterLowerZero:=function()
 local sd, sk, lheqs, slenf, lCdash, lMdk, le, lee, ls, lr, lzero,
 ComputeCdash;

 if b=1 then
 return HilbertBasisOfSystemOfHomogeneousInequalities(
 Concatenation([g], IdentityMat(Length(g))));
 else
 slenf := Length(f);
 ComputeCdash:=function()
 local lzero, lw, lV, lU, lwzetas, lC, lCk, lomegas,
 SplitMGSC0, GenSysOfCk, Dash;

 ######################################################
 #F SplitMGSC0(<v>, <c0>)
 #
 # Extracts from w \in <c0> those such that w \notin <v>,
 # and <g>(w)(w)>=b,
 # returning them in a list omegas of lists.
 # w \in omegas[i-1], if _g(w) = i
 # w \in omegas[b-1], if _g(w) >= _b
 SplitMGSC0 := function(v, c0)

 local si, lC0minusV, lomegas, lw;

 lC0minusV := Difference(c0, v);

 lomegas := List([1..b], v->[]);
 for lw in lC0minusV do
 si := g*lw;
 if si > b then
 si := b;
 fi;
 Add(lomegas[si], lw);
 od;
 return lomegas;
 end;

 ######################################################
 #F GenSysOfCk( <omegask>, <v>, <ckm1>)
 #
 # Recursive construction of set
 # C_k = <ckm1> \setminus <omegask> \cup
 # \{2<omegask>, 3<omegask>\} \cup
 # \{<omegask>+s | s \in <ckm1>\setminus <v>\}
 GenSysOfCk := function(omegask, v, ckm1)
 local lv, lw, lCk, lCkm1minusV, lws;

 lCk := Difference(ckm1, omegask);
 lCkm1minusV := Difference(ckm1, v);

 lws := [];
 for lv in omegask do
 lw := 2*lv;
 if not lw in lCk then
 Add(lCk, lw);
 fi;
 lw := lw+lv;
 if not lw in lCk then
 Add(lCk, lw);
 fi;

 Append(lws, Filtered(lCkm1minusV+lv, e->not e in lws));
 od;
 Append(lCk, Filtered(lws, u->not u in lCk));
 return lCk;
 end;

 ## Compute $V$, $x$ such that $g(x) = 0$
 lV := HilbertBasisOfSystemOfHomogeneousEquations([g], []);

 ## Compute $C_0$, the mgs of $L(S)\cap\N^p$
 ## $g(x)\ge 0$, $x_i\ge 0$
 lC := HilbertBasisOfSystemOfHomogeneousInequalities(
 Concatenation([g], IdentityMat(Length(g))));

 lomegas := SplitMGSC0(lV, lC);

 ## Compute C_k recursivelly
 lCk := [];
 Append(lCk, [lC]);
 for sk in [2..b] do
 Append(lCk, [GenSysOfCk(lomegas[sk-1], lV, lCk[sk-1])]);

 lomegas := SplitMGSC0(lV, lCk[sk]);
 od;

 ## Compute $U$, $x$ such that
 ## $f(x) \mod b = 0$, and $g(x) = 0$
 lzero := List([1..Length(f)], v->0);
 lU := Filtered(List(HilbertBasisOfSystemOfHomogeneousEquations([f, g], [b]),
 u->u{[1..slenf]}),
 e->e<>lzero);

 ## Compute $(C_{b-1}\setminus V)\cup U$
 lC := Set(List(Difference(lCk[b], lV)));
 UniteSet(lC, lU);

 ## Take $w \in C$ such that $g(w)\ge b$
 lw := Filtered(lC, e->g*e >= b);

 ######################################################
 #F Dash( <w>, <d> )
 # Computes the set
 # \cup_{<w>} \{z\in N^p | <w> < z <= <w> + <d>}
 # and returns it as a set
 Dash := function(w, d)
 local slend, luz, lw, lrngs, lwmd;

 luz := Set([]);
 slend := Length(d);
 for lw in w do
 lwmd := lw + d;
 lrngs := List([1..slend], e->[lw[e]..lwmd[e]]);
 # TODO: avoid repeating Cartesian computations for overlapping
 # ranges
 UniteSet(luz, Filtered(Cartesian(lrngs), r->g*r = g*w));
 RemoveSet(luz, lw);
 od;
 return luz;
 end;

 ## Compute $z\in \N^p, z!=w, z-w \in \N^p, w+\sum_{v\in V}b v - z \in \N^p$
 lwzetas := Dash(lw, Sum(List(lV, v->b*v)));
 ## \~C = C \cup wzetas
 UniteSet(lC, lwzetas);

 return lC;
 end;

 lCdash := ComputeCdash();
 lMdk := List([1..b-1], e->List([1..e+1], ee->[]));
 lzero := List([1..slenf], e->0);
 for sd in [1..b-1] do
 lheqs := [Concatenation(f, [0]), Concatenation(g, [-sd])];
 for sk in [0..sd] do
 lheqs[1][slenf+1] := -sk;
 lMdk[sd][sk+1] := Filtered(List(
 Filtered(
 HilbertBasisOfSystemOfHomogeneousEquations(lheqs, [b]),
 r->r[slenf+1]=1),
 e->e{[1..slenf]}),
 ee->ee<>lzero);
 UniteSet(lCdash, lMdk[sd][sk+1]);
 od;
 od;
 sd := 1;
 while sd <= Length(lCdash) do
 le := lCdash[sd];
 sd := sd+1;
 lee := Filtered(lCdash, e->ForAll(le-e, v->v>=0) and e<>le);
 for ls in lee do
 lr := le - ls;
 if f*lr mod b <= g*lr then
 Unbind(lCdash[sd-1]);
 break;
 fi;
 od;
 od;
 return Compacted(lCdash);
 fi;
 end;

 # Setter #######################################
 SetMinimalGenerators(M, ComputeForGGreaterLowerZero());
 ################################################
 fi;
 return MinimalGenerators(M);
end;

MinimalGensFromInequalityN2:=function(f, b, g)
 local lutilde, lu, lu2, lw, lw2, lchLatt, lS, si,
 pmsgb, latt_tria, latt_trap;

 pmsgb:=function(e, f, b, g)
 return ForAll(e, v->v>=0) and f*e mod b <= g*e;
 end;

 latt_tria:=function(ax, by)
 local xp, xv, ix, iy, result;

 # if not(IsInt(ax) or IsRat(ax)) or not(IsInt(by) or IsRat(by)) then
 # Error("Invalid input values");
 # fi;

 if ax <= 0 or by < 0 then
 return [];
 fi;
 xp := -by/ax; xv := by;
 if IsRat(by) then
 by := Int(Floor(Float(by)));
 fi;
 result := List([0..by], e->[0, e]);
 ix := 1;
 while ix<=ax do
 iy := xp * ix + xv;
 if IsRat(iy) then
 iy := Int(Floor(Float(iy)));
 fi;
 Append(result, List([0..iy], e->[ix, e]));
 ix := ix + 1;
 od;
 return result;
 end;

 latt_trap:=function(p)
 local l, er, r1, r2, minvx, minvy, maxvx, maxvy, e1, e2, x, y, latt,
 ecurec;

 ecurec:=function(a, b)
 return [b[2]-a[2], a[1]-b[1], -a[1]*(b[2]-a[2]) + a[2]*(b[1]-a[1])];
 end;

 # if Length(p)<>3 then
 # Error("latt_trap: incorrect number of elements in argument");
 # fi;

 l:=First([1..3], i->p[i,1]=0);
 if l<>fail then
 maxvy:=p[l][2];
 if not IsInt(maxvy) then
 maxvy:=Int(Floor(Float(maxvy)));
 fi;
 latt:=List([0..maxvy], i->[0, i]);
 minvx:=Minimum(p{[1..3]}[1]);
 maxvx:=Maximum(p{[1..3]}[1]);
 minvy:=Minimum(List(Filtered(p, i->i[1]<>0), i->i[2]));
 maxvy:=Maximum(p{[1..3]}[2]);
 er:=[p[l], ];
 l:=First([1..3], i->p[i,2]=maxvy);
 er[2]:=p[l];
 r2:=ecurec(er[1], er[2]);
 l:=First([1..3], i->p[i,2]=minvy);
 er:=[p[l], [0,0]];
 r1:=ecurec(er[1], er[2]);

 x:=1;
 if not IsInt(maxvx) then
 maxvx:=Int(Floor(Float(maxvx)));
 fi;
 while x<=maxvx do
 if r1[2]=0 then
 e1:=0;
 else
 e1:=-(r1[1]*x+r1[3])/r1[2];
 fi;
 if not IsInt(e1) then
 e1:=Int(Ceil(Float(e1)));
 fi;
 if r2[2]=0 then
 e2:=0;
 else
 e2:=-(r2[1]*x+r2[3])/r2[2];
 fi;
 if not IsInt(e2) then
 e2:=Int(Floor(Float(e2)));
 fi;

 Append(latt, List([e1..e2], i->[x, i]));
 x:=x+1;
 od;
 else
 l:=First([1..3], i->p[i,2]=0);
 # if l=fail then
 # Error("latt_trap: incorrect list elements");
 # fi;
 maxvx:=p[l][1];
 if not IsInt(maxvx) then
 maxvx:=Int(Floor(Float(maxvx)));
 fi;
 latt:=List([0..maxvx], i->[i, 0]);
 minvx:=Minimum(List(Filtered(p, i->i[2]<>0), i->i[1]));
 maxvx:=Maximum(p{[1..3]}[1]);
 minvy:=Minimum(p{[1..3]}[2]);
 maxvy:=Maximum(p{[1..3]}[2]);
 er:=[p[l],];
 l:=First([1..3], i->p[i,1]=maxvx);
 er[2]:= p[l];
 r2:=ecurec(er[1], er[2]);
 l:=First([1..3], i->p[i,1]=minvx);
 er:=[p[l], [0, 0]];
 r1:=ecurec(er[1], er[2]);

 y:=1;
 if not IsInt(maxvy) then
 maxvy:=Int(Floor(Float(maxvy)));
 fi;
 while y<=maxvy do
 if r1[1]=0 then
 e1:=0;
 else
 e1:=(-r1[3]-r1[2]*y)/r1[1];
 fi;
 if not IsInt(e1) then
 e1:=Int(Ceil(Float(e1)));
 fi;
 if r2[1]=0 then
 e2:=0;
 else
 e2:=(-r2[3]-r2[2]*y)/r2[1];
 fi;
 if not IsInt(e2) then
 e2:=Int(Floor(Float(e2)));
 fi;
 Append(latt, List([e1..e2], i->[i, y]));
 y:=y+1;
 od;
 fi;
 return latt;
 end;

 # if Length(f)<>2 or Length(g)<>2 then
 # Error("n2gmpi: f and g should have lenght equal o 2.");
 # fi;
 if ForAll(g, v->v<=0) then
 # Setter #######################
 SetMinimalGenerators(M, []);
 ################################
 else
 if ForAll(g, v->v>0) then
 if f[1] mod b = 0 then
 lu := [1, 0];
 else
 lu:=[Minimum(MinimalGeneratingSystemOfNumericalSemigroup(
 ProportionallyModularNumericalSemigroup(f[1] mod b, b, g[1]))), 0];
 fi;
 if f[2] mod b = 0 then
 lu2 := [0, 1];
 else
 lu2:=[0, Minimum(MinimalGeneratingSystemOfNumericalSemigroup(
 ProportionallyModularNumericalSemigroup(f[2] mod b, b, g[2])))];
 fi;

 lw := [b/g[1], 0]; lw2 := [0, b/g[2]];
 lchLatt := latt_tria(lw[1]+lu[1], lw2[2]+lu2[2]);
 else
 lu := Filtered(List(HilbertBasisOfSystemOfHomogeneousEquations([f, g], [b]),
 u->u{[1,2]}), e->e<>[0,0])[1];
 if g[1]>= 0 then
 if f[1] mod b = 0 then
 lutilde := [1, 0];
 else

 lutilde := [Minimum(MinimalGeneratingSystemOfNumericalSemigroup(
 ProportionallyModularNumericalSemigroup(f[1] mod b, b, g[1]))), 0];
 fi;
 lw := [b/g[1], 0];
 else
 if f[2] mod b = 0 then
 lutilde := [0, 1];
 else
 lutilde := [0, Minimum(MinimalGeneratingSystemOfNumericalSemigroup(
 ProportionallyModularNumericalSemigroup(f[2] mod b, b, g[2])))];
 fi;
 lw := [0, b/g[2]];
 fi;
 lchLatt :=latt_trap([lu, lu+lw+lutilde, lw+lutilde]);
 fi;
 lS := Filtered(lchLatt{[1..Length(lchLatt)]}{[1,2]}, e->e<>[0, 0] and f*e mod b <= g*e);
 si := 1;
 while si <= Length(lS) do
 if ForAny(lS{[1..si-1]}, e->pmsgb(lS[si]-e, f, b, g)) or
 (si+1<Length(lS) and ForAny(lS{[si+1, Length(lS)]}, e->pmsgb(lS[si]-e, f, b, g))) then
 Remove(lS, si);
 else
 si:=si+1;
 fi;
 od;

 # Setter #######################################
 SetMinimalGenerators(M, lS);
 ################################################
 fi;
 return MinimalGenerators(M);
end;

 ineq := PMInequality(M);
 if Length(ineq[1])=2 then
 return MinimalGensFromInequalityN2(ineq[1], ineq[2], ineq[3]);
 else
 return MinimalGensAndMaybeGapsFromInequality(ineq[1], ineq[2], ineq[3]);
 fi;
end);

#############################################################################
##
#O MinimalGenerators(S)
##
## Computes the set of minimal generators of the affine semigroup S.
## If a set of generators has already been computed, this
## is the set returned.
############################################################################
InstallMethod(MinimalGenerators,
 "Computes the set of minimal generators of the affine semigroup",
 [IsAffineSemigroup],1,
 function(S)
 local basis, eq, gen;

 if HasMinimalGenerators(S) then
 return MinimalGenerators(S);
 fi;

 if HasEquations(S) then
 eq:=Equations(S);
 basis := HilbertBasisOfSystemOfHomogeneousEquations(eq[1],eq[2]);
 SetMinimalGenerators(S,basis);
 return MinimalGenerators(S);
 elif HasInequalities(S) then
 basis := HilbertBasisOfSystemOfHomogeneousInequalities(AffineSemigroupInequalities(S));
 SetMinimalGenerators(S,basis);
 return MinimalGenerators(S);
 elif HasPMInequality(S) then
 SetMinimalGenerators(S, Generators(S));
 return MinimalGenerators(S);
 fi;
 gen:=Generators(S);
 basis:=Filtered(gen, y->ForAll(Difference(gen,[y]),x->not((y-x) in S)));
 SetMinimalGenerators(S,basis);
 return MinimalGenerators(S);

end);

#############################################################################
##
#F AffineSemigroupByGaps(arg)
##
## Returns the affine semigroup determined by the gaps arg.
## If the given set is not a set of gaps, then an error is raised.
##
#############################################################################
InstallGlobalFunction(AffineSemigroupByGaps,

function(arg)
local P,E,h,H,e,M;

if Length(arg) = 1 then
 H := Set(arg[1]);
else
 H := Set(arg);
fi;

if H=[] then
 Error("The dimension is ambiguous");
fi;

if not IsRectangularTable(H) then
 Error("The arguments must be lists of non negative integers with the same length, or a list of such lists");
elif not ForAll(H, l -> ForAll(l,x -> (IsPosInt(x) or x = 0))) then
 Error("The arguments must be lists of non negative integers with the same length, or a list of such lists");
fi;

if (Zero(H[1]) in H) then
 return Error("the given set is not a set of gaps");
fi;
for h in H do
 P:=Cartesian(List(h,i->[0..i]));
 E:=Difference(P,H);
 for e in E do
 if (h<>e and not((h-e) in H)) then
 return Error("the given set is not a set of gaps");
 fi;
 od;
od;
M:=Objectify(AffineSemigroupsType,rec());
SetGaps(M,H);
SetDimension(M,Length(H[1]));
return M;
end);

InstallMethod(Gaps,
 "for an affine semigroups",
 [IsAffineSemigroup],
 function( M )
 local i,j,k,d,sum,S,NS,N,V,vec,F,P,G,A,E,minA,ge,m,
 f, b, g, lH, si, lsH, se;

 if HasGaps(M) then
 return Gaps(M);
 fi;
 if HasPMInequality(M) then
 g := PMInequality(M)[3];
 if ForAll(g, v->v<0) then
 SetGaps(M, []);
 return [];
 elif ForAll(g, v->v>0) then
 f := PMInequality(M)[1];
 b := PMInequality(M)[2];
 lH := [];
 for si in [1..b-1] do
 lsH := FactorizationsIntegerWRTList(si, g);
 for se in lsH do
 if ((f*se) mod b) > g*se then
 Add(lH, se);
 fi;
 od;
 od;
 SetGaps(M, lH);
 return Gaps(M);
 else
 Info(InfoWarning,1,"The given affine semigroup has infinitely many gaps");
 return fail;
 fi;
 fi;

 A:=List(Generators(M)); #A will be modified
 S:=[];
 NS:=[];
 d:=Length(A[1]);
 if M=AffineSemigroup(IdentityMat(d)) then
 return []; # The semigroup N^d has no gaps
 fi;
 #Let i in {1,..d}, I have to find in A the elements in which all coordinates
 #different from i is zero, I need the nonzero coordinates of these elements and such
 #coordinates must generate a numerical semigroup
 for i in [1..d] do
 S[i]:=Filtered(A,j->ForAll([1..d],k->(j[k]=0 or k=i)));
 NS[i]:=List(S[i],j->j[i]);
 A:=Difference(A,S[i]); #now A is no more the set of minimal generators (it is not needed)
 if NS[i]=[] or (Gcd(NS[i])<>1) then
 Info(InfoWarning,1,"The given affine semigroup has infinitely many gaps");
 return fail;
 fi;
 od;

 #I have to find in A all elements e(i)+n(i,k)e(k), since e(i) is the i-th standard basis
 #vector in N^d, with i different by k. Moreover I have to store the numbers n(i,k).
 #When i=k it is useless.
 N:=NullMat(d,d);
 for i in [1..d] do
 #If e(i) belong to S[i] then we can choose n(i,k)=0 for all k
 if IdentityMat(d)[i] in S[i] then
 N[i]:=NullMat(1,d)[1];
 else
 for k in [1..d] do
 if i<>k then
 V:=Filtered(Filtered(A,j->j[i]=1),r->ForAll([1..d],t->(r[t]=0 or (t=k or t=i))));
 if V=[] then
 Error("This affine semigroup has infinitely many gaps");
 fi;
 N[i,k]:=Minimum(List(V,j->j[k]));
 #Taking the minimum above, it would reduce the successive computations.
 fi;
 od;
 fi;
 od;
 #if this point is reached, then the semigroup has finitely many gaps
 #
 #next the set of gaps is computed
 #
#I have to build the vector V of the pseudocode;
#F is the list of Frobenius numbers of the semigroups in the axes.
#F:=List(NS,j->Maximum(FrobeniusNumber(NumericalSemigroup(j)),0);
F:=List(NS,j->FrobeniusNumber(NumericalSemigroup(j)));
for j in [1..d] do
 if F[j]=-1 then
 F[j]:=0;
 fi;
od;
vec:=[];
for j in [1..d] do
 sum:=F[j];
 for i in [1..d] do
 if i<>j then
 sum:=sum+F[i]*N[i,j];
 fi;
 od;
 vec[j]:=sum;
 od;
 #Now the gaps of the semiroup M are all contained in the set of all elements smaller
 #than the vector vec (with repsect to partial order). We check those not belonging to M.
 P:=Cartesian(List(vec,i->[0..i]));
 G:=[];
 #G is the set of gaps and G:=Filtered(P,i->not(BelongsToAffineSemigroup(i,M)));
 #Or we eliminate succesively from P, many elements of the Semigroup, stored in E.
 for i in [1..d] do
 S[i]:=NumericalSemigroup(NS[i]);
 G:=Union(G,List(Gaps(S[i]),g->IdentityMat(d)[i]*g));
 NS[i]:=ElementsUpTo(S[i],vec[i]);
 od;
 P:=Difference(P,Cartesian(List([1..d],i->[F[i]+1..vec[i]])));
 E:=Difference(Cartesian(NS),Cartesian(List([1..d],i->[F[i]+1..vec[i]])));
 A:=Filtered(A,i->i in P);
 A:=Union(A,Union(List(A,i->A+i)));
 E:=Union(E,Union(List(A,i->E+i)));
 m:=Cartesian(List([1..d],i->[0..Multiplicity(S[i])-1]));
 A:=Intersection(m,A);
 if IsEmpty(A) then
 G:=Union(G,Difference(m,NullMat(1,d)));
 else
 ge:=function(x,y)
 return ForAll([1..Length(x)], i->x[i]>=y[i]);
 end;;
 minA:=Filtered(A, a->not(ForAny(A, aa-> ge(a,aa) and a<>aa)));
 G:=Union(G,Union(List(minA,a->Difference(Cartesian(List(a,i->[0..i])),[a]))));
 G:=Difference(G,NullMat(1,d));
 fi;
 P:=Difference(P,Union(E,G));
 G:=Union(G,Filtered(P,i->not(BelongsToAffineSemigroup(i,M))));
 SetGaps(M,G);
 return G;
end);

#####################################################
##
#F GenusOfAffineSemigroup:=function(S)
## Returns the number of gaps of an affine semigroup if it has finitely many and infinite otherwise.
#####################################################
InstallMethod(Genus,
 "for affine semigroups",[IsAffineSemigroup],
 function(S)
 local gaps;

 if not(IsAffineSemigroup(S)) then
 Error("The argument must be an affine semigroup");
 fi;
 gaps := Gaps(S);
 if gaps = fail then
 return infinity;
 else
 return Length(gaps);
 fi;
end);

##############################################################
#A PseudoFrobenius
# Computes the set of PseudoFrobenius
# Works only if the affine semigroup has finitely many gaps
##############################################################
InstallMethod(PseudoFrobenius, [IsAffineSemigroup],
function(s)
 local gaps, gens;
 gens:=Generators(s);
 gaps:=Gaps(s);
 return Filtered(gaps, g->not ForAny(gens, n -> n+g in gaps));
end);

##############################################################
#A SpecialGaps
# Computes the set of special gaps
# Works only if the affine semigroup has finitely many gaps
##############################################################
InstallMethod(SpecialGaps, [IsAffineSemigroup],
function(s)
 return Filtered(PseudoFrobenius(s), g->2*g in s);
end);

###############################################################################
#
# RemoveMinimalGeneratorFromAffineSemigroup(x,s)
#
# Compute the affine semigroup obtained by removing the minimal generator x from
# the given affine semigroup s. If s has finite gaps, its set of gaps is setted
#
#################################################################################
InstallGlobalFunction(RemoveMinimalGeneratorFromAffineSemigroup, function(x,s)
 local H,t,gens;

 if not(ForAll(x,i -> (IsPosInt(i) or i = 0))) then
 Error("The first argument must be a list of non negative integers.\n");
 fi;

 if(not(IsAffineSemigroup(s))) then
 Error("The second argument must be an affine semigroup.\n");
 fi;

 gens:=MinimalGenerators(s);
 if x in gens then
 gens:=Difference(gens,[x]);
 gens:=Union(gens,gens+x);
 gens:=Union(gens,[2*x,3*x]);
 t:=AffineSemigroup(gens);
 if HasGaps(s) then
 H:=Gaps(s);
 H:=Union(H,[x]);
 SetGaps(t,H);
 fi;
 return t;
 else
 return Error(x," must be a minimal generator of ",s,".\n");
 fi;
end);

##############################################################################
#
# AddSpecialGapOfAffineSemigroup(x,s)
#
# Let a an affine semigroup with finite gaps and x be a special gap of a.
# We compute the unitary extension of a with x.
################################################################################
InstallGlobalFunction(AddSpecialGapOfAffineSemigroup, function( x, a )
 local H,s,gens;

 if not(ForAll(x,i -> (IsPosInt(i) or i = 0))) then
 Error("The first argument must be a list of non negative integers.\n");
 fi;

 if(not(IsAffineSemigroup(a))) then
 Error("The second argument must be an affine semigroup.\n");
 fi;

 H:=Set(Gaps(a));
 if x in SpecialGaps(a) then
 RemoveSet(H,x);
 gens:=Union(Generators(a),[x]);
 s:=AffineSemigroup(gens);
 SetGaps(s,H);
 return s;
 else
 Error(x," must be a special gap of ",a,".\n");
 fi;
end);

#############################################################################
##
#O Inequalities(S)
##
## If S is defined by inequalities, it returns them.
############################################################################
InstallMethod(Inequalities,
 "Computes the set of equations of S, if S is a affine semigroup",
 [IsAffineSemigroup and HasInequalities],1,
 function(S)
 return AffineSemigroupInequalities(S);
end);
#############################################################################
## Full affine semigroups
#############################################################################
##
#F AffineSemigroupByEquations(ls,md)
##
## Returns the (full) affine semigroup defined by the system A X=0 mod md, where the rows
## of A are the elements of ls.
##
#############################################################################
InstallGlobalFunction(AffineSemigroupByEquations, function(arg)
 local ls, md, M;

 if Length(arg) = 1 then
 ls := arg[1][1];
 md := arg[1][2];
 else
 ls := arg[1];
 md := arg[2];
 fi;

 if not(IsHomogeneousList(ls)) or not(IsHomogeneousList(md)) then
 Error("The arguments must be homogeneous lists.");
 fi;

 if not(ForAll(ls,IsListOfIntegersNS)) then
 Error("The first argument must be a list of lists of integers.");
 fi;

 if not(md = [] or IsListOfIntegersNS(md)) then
 Error("The second argument must be a lists of integers.");
 fi;

 if not(ForAll(md,x->x>0)) then
 Error("The second argument must be a list of positive integers");
 fi;

 if not(Length(Set(ls, Length))=1) then
 Error("The first argument must be a list of lists all with the same length.");
 fi;

 M:= Objectify( AffineSemigroupsType, rec());
 SetEquations(M,[ls,md]);
 SetDimension(M,Length(ls[1]));

# Setter(IsAffineSemigroupByEquations)(M,true);
# Setter(IsFullAffineSemigroup)(M,true);
 return M;
end);

#############################################################################
##
#F AffineSemigroupByInequalities(ls)
##
## Returns the (full) affine semigroup defined by the system ls*X>=0 over
## the nonnegative integers
##
#############################################################################
InstallGlobalFunction(AffineSemigroupByInequalities, function(arg)
 local ls, M;

 if Length(arg) = 1 then
 ls := Set(arg[1]);
 else
 ls := Set(arg);
 fi;

 if not IsRectangularTable(ls) then
 Error("The arguments must be lists of integers with the same length, or a list of such lists");
 fi;

 M:= Objectify( AffineSemigroupsType, rec());

 SetAffineSemigroupInequalities(M,ls);
 SetDimension(M,Length(ls[1]));
# Setter(IsAffineSemigroupByEquations)(M,true);
# Setter(IsFullAffineSemigroup)(M,true);
 return M;
end);

#############################################################################
##
#F AffineSemigroupByPMInequality(f, b, g)
##
## Returns the proportionally modular affine semigroup defined by the
## inequality f*x mod b <= g*x
##
#############################################################################
InstallGlobalFunction(AffineSemigroupByPMInequality, function(f, b, g)
 local M;

 if not (IsListOfIntegersNS(f) or IsListOfIntegersNS(g)) then
 Error("f and g must be lists\n");
 fi;
 if Length(f)<>Length(g) then
 Error("f and g must be equal length lists\n");
 fi;
 if b<=0 then
 Error("b should be greater than 0\n");
 fi;

 M:= Objectify( AffineSemigroupsType, rec());
 SetPMInequality(M, [f, b, g]);
 SetDimension(M, Length(g));
 return M;
end);

#############################################################################

#############################################################################
##
#F AffineSemigroup(arg)
##
## This function's first argument may be one of:
## "generators", "equations", "inequalities"...
##
## The following arguments must conform to the arguments of
## the corresponding function defined above.
## By default, the option "generators" is used, so,
## gap> AffineSemigroup([1,3],[7,2],[1,5]);
## <Affine semigroup in 3-dimensional space, with 3 generators>
##
##
#############################################################################
InstallGlobalFunction(AffineSemigroup, function(arg)

 if IsString(arg[1]) then
 if arg[1] = "generators" then
 return AffineSemigroupByGenerators(Filtered(arg, x -> not IsString(x))[1]);
 elif arg[1] = "equations" then
 return AffineSemigroupByEquations(Filtered(arg, x -> not IsString(x))[1]);
 elif arg[1] = "inequalities" then
 return AffineSemigroupByInequalities(Filtered(arg, x -> not IsString(x))[1]);
 elif arg[1] = "gaps" then
 return AffineSemigroupByGaps(Filtered(arg, x -> not IsString(x))[1]);
 elif arg[1] = "pminequality" then
 return AffineSemigroupByPMInequality(arg[2][1], arg[2][2], arg[2][3]);
 else
 Error("Invalid first argument, it should be one of: \"generators\", \"minimalgenerators\", \"gaps\" , \"pminequality\"");
 fi;
 elif Length(arg) = 1 and IsList(arg[1]) then
 return AffineSemigroupByGenerators(arg[1]);
 else
 return AffineSemigroupByGenerators(arg);
 fi;
 Error("Invalid argumets");
end);

#############################################################################
##
#P IsAffineSemigroupByGenerators(S)
##
## Tests if the affine semigroup S was given by generators.
##
#############################################################################
# InstallMethod(IsAffineSemigroupByGenerators,
# "Tests if the affine semigroup S was given by generators",
# [IsAffineSemigroup],
# function( S )
# return(HasGeneratorsAS( S ));
# end);
#############################################################################
##
#P IsAffineSemigroupByMinimalGenerators(S)
##
## Tests if the affine semigroup S was given by its minimal generators.
##
#############################################################################
# InstallMethod(IsAffineSemigroupByMinimalGenerators,
# "Tests if the affine semigroup S was given by its minimal generators",
# [IsAffineSemigroup],
# function( S )
# return(HasIsAffineSemigroupByMinimalGenerators( S ));
# end);
#############################################################################
##
#P IsAffineSemigroupByEquations(S)
##
## Tests if the affine semigroup S was given by equations or equations have already been computed.
##
#############################################################################
# InstallMethod(IsAffineSemigroupByEquations,
# "Tests if the affine semigroup S was given by equations",
# [IsAffineSemigroup],
# function( S )
# return(HasEquationsAS( S ));
# end);

#############################################################################
##
#P IsAffineSemigroupByInequalities(S)
##
## Tests if the affine semigroup S was given by inequalities or inequalities have already been computed.
##
# #############################################################################
# InstallMethod(IsAffineSemigroupByInequalities,
# "Tests if the affine semigroup S was given by inequalities",
# [IsAffineSemigroup],
# function( S )
# return(HasInequalitiesAS( S ));
# end);

#############################################################################
##
#P IsFullAffineSemigroup(S)
##
## Tests if the affine semigroup S has the property of being full.
##
# Detects if the affine semigroup is full: the nonnegative
# of the the group spanned by it coincides with the semigroup
# itself; or in other words, if a,b\in S and a-b\in \mathbb N^n,
# then a-b\in S
#############################################################################
InstallMethod(IsFullAffineSemigroup,
 "Tests if the affine semigroup S has the property of being full",
 [IsAffineSemigroup],1,
 function( S )
 local gens, eq, h, dim;

 if HasEquations(S) then
 return true;
 fi;

 gens := GeneratorsOfAffineSemigroup(S);
 if gens=[] then
 return true;
 fi;
 dim:=Length(gens[1]);
 eq:=EquationsOfGroupGeneratedBy(gens);
 if eq[1]=[] then
 h:=IdentityMat(dim);
 else
 h:=HilbertBasisOfSystemOfHomogeneousEquations(eq[1],eq[2]);
 fi;
 if ForAll(h, x->BelongsToAffineSemigroup(x,S)) then
 SetEquations(S,eq);
 #Setter(IsAffineSemigroupByEquations)(S,true);
 #Setter(IsFullAffineSemigroup)(S,true);
 return true;
 fi;
 return false;

end);

#############################################################################
##
#M PrintObj(S)
##
## This method for affine semigroups.
##
#############################################################################
InstallMethod( PrintObj,
 "Prints an Affine Semigroup",
 [ IsAffineSemigroup],
 function( S )
 if HasGenerators(S) then
 Print("AffineSemigroup( ", Generators(S), " )\n");
 elif HasEquations(S) then
 Print("AffineSemigroupByEquations( ", Equations(S), " )\n");
 elif HasInequalities(S) then
 Print("AffineSemigroupByInequalities( ", Inequalities(S), " )\n");
 else
 Print("AffineSemigroup( ", GeneratorsOfAffineSemigroup(S), " )\n");
 fi;
end);

#############################################################################
##
#M String(S)
##
## This method for affine semigroups.
##
#############################################################################
InstallMethod( String, "String for Affine Semigroup", [IsAffineSemigroup],
 function( S )
 local ed;
 if HasMinimalGenerators(S) then
 ed:= Length(MinimalGenerators(S));
 if ed>1 then
 return Concatenation("Affine semigroup in ", String(Length(MinimalGenerators(S)[1]))," dimensional space, with ", String(ed), " generators");
 else
 return Concatenation("Affine semigroup in ", String(Length(MinimalGenerators(S)[1]))," dimensional space, with ", String(ed), " generator");
 fi;
 elif HasGenerators(S) then
 ed:=Length(Generators(S));
 if ed>1 then
 return Concatenation("Affine semigroup in ", String(Length(Generators(S)[1]))," dimensional space, with ", String(ed), " generators");
 else
 return Concatenation("Affine semigroup in ", String(Length(MinimalGenerators(S)[1]))," dimensional space, with ", String(ed), " generator");
 fi;
 else
 return ("Affine semigroup");
 fi;
end);

#############################################################################
##
#M ViewString(S)
##
## This method for affine semigroups.
##
#############################################################################
InstallMethod(ViewString,[IsAffineSemigroup],String);

#############################################################################
##
#M ViewObj(S)
##
## This method for affine semigroups.
##
#############################################################################
InstallMethod( ViewObj, "Displays an Affine Semigroup", [IsAffineSemigroup],
 function( S )
 Print("<",ViewString(S),">");
end);

#############################################################################
##
#M Display(S)
##
## This method for affine semigroups. ## under construction... (= View)
##
#############################################################################
InstallMethod( Display, "Displays an Affine Semigroup", [IsAffineSemigroup], ViewObj);

####################################################
####################################################

############################################################################
##
#M Methods for the comparison of affine semigroups.
##
InstallMethod( \=,
 "for two affine semigroups",
 [IsAffineSemigroup and IsAffineSemigroupRep,
 IsAffineSemigroup and IsAffineSemigroupRep],
 function(x, y )
 local genx, geny;

 if Dimension(x) <> Dimension(y) then
 return false;
 fi;

 if HasEquations(x) and HasEquations(y) and
 Equations(x) = Equations(y) then
 return true;

 elif HasInequalities(x) and HasInequalities(y) and
 AffineSemigroupInequalities(x) = AffineSemigroupInequalities(y) then
 return true;

 elif HasGenerators(x) and HasGenerators(y) and
 Generators(x) = Generators(y) then
 return true;

 elif HasGaps(x) and HasGaps(y) and
 Gaps(x) = Gaps(y) then
 return true;

 elif HasGenerators(x) and HasGenerators(y) and not(EquationsOfGroupGeneratedBy(Generators(x))=EquationsOfGroupGeneratedBy(Generators(y))) then
 return false;
 fi;
 genx:=GeneratorsOfAffineSemigroup(x);
 geny:=GeneratorsOfAffineSemigroup(y);
 return ForAll(genx, g-> g in y) and
 ForAll(geny, g-> g in x);
end);

## x < y returns true if: (dimension(x)<dimension(y)) or (x is (strictly) contained in y) or (genx < geny), where genS is the *current* set of generators of S...
InstallMethod( \<,
 "for two affine semigroups",
 [IsAffineSemigroup,IsAffineSemigroup],
 function(x, y )
 local genx, geny;

 if Dimension(x) < Dimension(y) then
 return true;
 fi;

 genx:=GeneratorsOfAffineSemigroup(x);
 geny:=GeneratorsOfAffineSemigroup(y);
 if ForAll(genx, g-> g in y) and not ForAll(geny, g-> g in x) then
 return true;
 fi;

 return genx < geny;
end );

#############################################################################
##
#F AsAffineSemigroup(S)
##
## Takes a numerical semigroup as argument and returns it as affine semigroup
##
#############################################################################
InstallGlobalFunction(AsAffineSemigroup, function(s)
 local msg;

 if not(IsNumericalSemigroup(s)) then
 Error("The argument must be a numerical semigroup");
 fi;

 msg:=MinimalGeneratingSystem(s);
 return AffineSemigroup(List(msg, x->[x]));

end);

#############################################################################
##
#F FiniteComplementIdealExtension(l)
##
## The argument is a list of lists of non-negative integers, which represent
## elements in N^n. Returns affine semigroup {0} union (l+N^n) if this has
## finitely many gaps, and an error otherwise (in this setting there are
## infinitely many minimal generators and the monoid is not an affine
## semigroup)
##
#############################################################################
InstallGlobalFunction(FiniteComplementIdealExtension, function(arg)
 local a, h, gaps, support,d, b, g, box, gens;

 support:=function(l)
 return Filtered([1..Length(l)], i->l[i]<>0);
 end;

 box:=function(a,b)
 return a+Cartesian(List([1..Length(a)], i->[0..b[i]-a[i]]));
 end;

 if Length(arg) = 1 then
 gens := Set(arg[1]);
 else
 gens := Set(arg);
 fi;

 if not IsRectangularTable(gens) then
 Error("The arguments must be lists of non negative integers with the same length, or a list of such lists");
 elif not ForAll(gens, l -> ForAll(l,x -> (IsPosInt(x) or x = 0))) then
 Error("The arguments must be lists of non negative integers with the same length, or a list of such lists");
 fi;

 h:=Filtered(gens, g->Filtered(gens, gg->ForAll(g-gg,x->x>=0))=[g]);
 d:=Length(h[1]);
 if h=[ListWithIdenticalEntries(d,0)] then
 return AffineSemigroup(IdentityMat(d));
 fi;
 if not(ForAll([1..d], i->ForAny(h, g->support(g)=[i]))) then
 Error("These elements do not generate a zero dimensional ideal");
 fi;
 b:=List([1..d], i->Filtered(h, g->support(g)=[i])[1][i]);
 gaps:=Cartesian(List(b,i->[0..i-1]));
 for g in h do
 gaps:=Difference(gaps,box(g,b));
 od;
 gaps:=Difference(gaps,[Zero(h[1])]);
 #a:=AffineSemigroupByGaps(Difference(gaps,[Zero(h[1])]));
 a:=Objectify(AffineSemigroupsType,rec());
 SetGaps(a,gaps);
 SetDimension(a,d);
 return a;
end);

Quelle affine-def.gi Sprache: unbekannt

[ Dauer der Verarbeitung: 0.38 Sekunden (vorverarbeitet) ]