Merge pull request #25 from erich-9/groebner-alternative

Let the user choose what function to use for the computation of Groebner bases.
gap-packages · Oct 3, 2018 · dc73769 · dc73769
2 parents ca9d1b1 + 1afafbb
commit dc73769
Show file tree

Hide file tree

Showing 10 changed files with 204 additions and 17 deletions.
diff --git a/init.g b/init.g
@@ -23,6 +23,7 @@ ReadPackage("QPA", "lib/projpathalgmodule.gd");
 ReadPackage("QPA", "lib/moduledecomp.gd");
 ReadPackage("QPA", "lib/idempotent.gd");
 ReadPackage("QPA", "lib/gbnp.gd");
+ReadPackage("QPA", "lib/gbhighlevel.gd");
 ReadPackage("QPA", "lib/moduleprojres.gd");
 ReadPackage("QPA", "lib/pathalgtensor.gd");
 ReadPackage("QPA", "lib/pathalgpredef.gd");

diff --git a/lib/gbhighlevel.gd b/lib/gbhighlevel.gd
@@ -0,0 +1,6 @@
+DeclareOperation( "HighLevelGroebnerBasis", [ IsList, IsPathAlgebra ] );
+DeclareOperation( "RemainderOfDivision", [ IsElementOfMagmaRingModuloRelations, IsList, IsPathAlgebra ] );
+DeclareOperation( "ReducedList", [ IsList, IsPathAlgebra ] );
+DeclareOperation( "TipReducedList", [ IsList, IsPathAlgebra ] );
+DeclareOperation( "LeftmostOccurrence", [ IsList, IsList ] );
+DeclareSynonym( "TipWalk", x -> WalkOfPath(TipMonomial(x)) );
diff --git a/lib/gbhighlevel.gi b/lib/gbhighlevel.gi
@@ -0,0 +1,169 @@
+InstallMethod( HighLevelGroebnerBasis,
+  "compute the complete reduced Groebner Basis",
+  [ IsList, IsPathAlgebra ],
+  function(els, A)
+    local gb, el, el_tip,
+          n, i, j, x, y, k, l, r, b, c,
+          overlap, remainder;
+
+    if not QPA_InArrowIdeal(els, A) then
+      Error("elements do not belong to the arrow ideal of the path algebra");
+    fi;
+
+    els := ReducedList(MakeUniform(els), A);
+
+    gb := [];
+
+    while Length(els) > 0 do
+      for el in els do
+        el_tip := Tip(el);
+        Add(gb, el/TipCoefficient(el_tip));
+      od;
+
+      n := Length(gb);
+      els := [];
+
+      for i in [1..n] do
+        x := TipWalk(gb[i]);
+        k := Length(x);
+
+        for j in [1..n] do
+          y := TipWalk(gb[j]);
+          l := Length(y);
+
+          for r in [Maximum(0, k-l)..k-1] do
+            if x{[r+1..k]} = y{[1..k-r]} then
+              b := x{[1..r]};
+              c := y{[k-r+1..l]};
+
+              overlap := gb[i]*Product(c, One(A)) - Product(b, One(A))*gb[j];
+              remainder := RemainderOfDivision(overlap, gb, A);
+
+              if not IsZero(remainder) then
+                AddSet(els, remainder);
+              fi;
+            fi;
+          od;
+        od;
+      od;
+    od;
+
+    gb := TipReducedList(gb, A);
+    gb := ReducedList(gb, A);
+
+    return gb;
+  end
+);
+
+
+InstallMethod( ReducedList,
+  "for a list of path-algebra elements",
+  [ IsList, IsPathAlgebra ],
+  function(els, A)
+    local res, i, r;
+
+    res := Filtered(els, el -> not IsZero(el));
+
+    i := Length(res);
+    while i > 0 do
+      r := RemainderOfDivision(res[i], res{Concatenation([1..i-1], [i+1..Length(res)])}, A);
+
+      if IsZero(r) then
+        Remove(res, i);
+      else
+        res[i] := r;
+      fi;
+
+      i := i-1;
+    od;
+
+    return res;
+  end
+);
+
+
+InstallMethod( TipReducedList,
+  "for a list of path-algebra elements",
+  [ IsList, IsPathAlgebra ],
+  function(els, A)
+    local res, el, i;
+
+    res := [];
+
+    for el in els do
+      if not IsZero(el) then
+        AddSet(res, el);
+      fi;
+    od;
+
+    i := Length(res);
+    while i > 0 do
+      if ForAny([1..i-1], j -> LeftmostOccurrence(TipWalk(res[i]), TipWalk(res[j])) <> fail) then
+        Remove(res, i);
+      fi;
+      i := i-1;
+    od;
+
+    return res;
+  end
+);
+
+
+InstallMethod( RemainderOfDivision,
+  "for a path-algebra element and a list of path-algebra elements",
+  [ IsElementOfMagmaRingModuloRelations, IsList, IsPathAlgebra ],
+  function(y, X, A)
+    local r, n, y_tip, y_wtip, divided, i, p, u, v;
+
+    r := Zero(A);
+    n := Length(X);
+
+    while not IsZero(y) do
+      y_tip := Tip(y);
+      y_wtip := TipWalk(y_tip);
+
+      divided := false;
+
+      for i in [1..n] do
+        p := LeftmostOccurrence(y_wtip, TipWalk(X[i]));
+
+        if p <> fail then
+          u := Product(y_wtip{[1..p[1]-1]}, One(A));
+          v := Product(y_wtip{[p[2]+1..Length(y_wtip)]}, One(A));
+
+          y := y - TipCoefficient(y_tip)/TipCoefficient(X[i]) * u*X[i]*v;
+
+          divided := true;
+          break;
+        fi;
+      od;
+
+      if not divided then
+        r := r + y_tip;
+        y := y - y_tip;
+      fi;
+    od;
+
+    return r;
+  end
+);
+
+
+InstallMethod( LeftmostOccurrence,
+  "find second list as sublist of first list",
+  [ IsList, IsList ],
+  function(b, c)
+    local lb, lc, i;
+
+    lb := Length(b);
+    lc := Length(c);
+
+    for i in [1..lb-lc+1] do
+      if b{[i..i+lc-1]} = c then
+        return [i, i+lc-1];
+      fi;
+    od;
+
+    return fail;
+  end
+);
diff --git a/lib/modulehom.gi b/lib/modulehom.gi
@@ -3692,7 +3692,7 @@ InstallMethod( EndOfModuleAsQuiverAlgebra,
         f := [AA,EndM,gensofAA{[1..Length(gensofAA)]},images];
 
     else
-        gb := GBNPGroebnerBasis(Jtplus1,KQ);
+        gb := GroebnerBasisFunction(KQ)(Jtplus1,KQ);
         Jtplus1 := Ideal(KQ,Jtplus1); 
         gbb := GroebnerBasis(Jtplus1,gb);
         AA := KQ/Jtplus1;

diff --git a/lib/pathalg.gd b/lib/pathalg.gd
@@ -41,6 +41,7 @@ DeclareAttribute( "RelatorsOfFpAlgebra",
     IsQuotientOfPathAlgebra and IsFullFpPathAlgebra);
 DeclareAttribute( "RelationsOfAlgebra", IsQuiverAlgebra);
 DeclareAttribute( "IdealOfQuotient", IsQuiverAlgebra);
+DeclareAttribute( "GroebnerBasisFunction", IsQuiverAlgebra );
 DeclareAttribute( "NormalFormFunction", IsFamily );
 DeclareOperation( "ElementOfQuotientOfPathAlgebra", 
     [ IsElementOfQuotientOfPathAlgebraFamily, IsRingElement, IsBool ] );

diff --git a/lib/pathalg.gi b/lib/pathalg.gi
@@ -54,12 +54,17 @@ InstallGlobalFunction( PathRing,
 
 
 InstallGlobalFunction( PathAlgebra,
-  function(F, Q)
+  function(F, Q, arg...)
     if not IsDivisionRing(F) then
         Error( "<F> must be a division ring or field." );
     fi;
     F := PathRing( F, Q );
     SetOrderingOfAlgebra(F, OrderingOfQuiver(Q));
+    if Length(arg) > 0 then
+      SetGroebnerBasisFunction(F, arg[1]);
+    else
+      SetGroebnerBasisFunction(F, GBNPGroebnerBasis);
+    fi;
     if NumberOfArrows(Q) > 0 then 
         SetGlobalDimension(F, 1);
         SetFilterObj( F, IsHereditaryAlgebra ); 
@@ -873,22 +878,23 @@ InstallMethod( IsFiniteDimensional,
   true,
   [IsQuotientOfPathAlgebra and IsFullFpPathAlgebra], 0,
   function( A )
-    local gb, fam, I, rels;
+    local gb, fam, KQ, I, rels;
 
     fam := ElementsFamily(FamilyObj(A));
+    KQ := fam!.pathAlgebra;
     I := fam!.ideal;
 
     if HasGroebnerBasisOfIdeal(I) then
       gb := GroebnerBasisOfIdeal(I);
     else
       rels := GeneratorsOfIdeal(I);     
-      gb := GBNPGroebnerBasis(rels, fam!.pathAlgebra);
+      gb := GroebnerBasisFunction(KQ)(rels, KQ);
       gb := GroebnerBasis(I, gb);
     fi;
 
     if IsCompleteGroebnerBasis(gb) then
       return AdmitsFinitelyManyNontips(gb);
-    elif IsFiniteDimensional(fam!.pathAlgebra) then
+    elif IsFiniteDimensional(KQ) then
       return true;
     else
       TryNextMethod();
@@ -910,16 +916,17 @@ InstallMethod( Dimension,
   true,
   [IsQuotientOfPathAlgebra and IsFullFpPathAlgebra], 0,
   function( A )
-    local gb, fam, I, rels;
+    local gb, fam, KQ, I, rels;
 
     fam := ElementsFamily(FamilyObj(A));
+    KQ := fam!.pathAlgebra;
     I := fam!.ideal;
 
     if HasGroebnerBasisOfIdeal(I) then
       gb := GroebnerBasisOfIdeal(I);
     else
       rels := GeneratorsOfIdeal(I);     
-      gb := GBNPGroebnerBasis(rels, fam!.pathAlgebra);
+      gb := GroebnerBasisFunction(KQ)(rels, KQ);
       gb := GroebnerBasis(I, gb);
     fi;
 
@@ -1530,7 +1537,7 @@ InstallMethod( OppositePathAlgebra,
     rels  := RelatorsOfFpAlgebra( quot );
     rels_op := OppositeRelations( rels );
     I_op := Ideal( PA_op, rels_op );
-    gb   := GBNPGroebnerBasis(rels_op,PA_op);
+    gb   := GroebnerBasisFunction(PA_op)(rels_op,PA_op);
     gbb  := GroebnerBasis(I_op,gb);
     quot_op := PA_op / I_op;
 
@@ -2046,7 +2053,7 @@ InstallOtherMethod( \/,
     if not ForAll(relators, x -> ( x in KQ ) ) then
         Error("the entered list of elements should be in the path algebra!");
     fi;
-    gb := GBNPGroebnerBasis(relators, KQ);
+    gb := GroebnerBasisFunction(KQ)(relators, KQ);
     I := Ideal(KQ,gb);
     GroebnerBasis(I,gb);
     A := KQ/I; 

diff --git a/lib/pathalgideal.gi b/lib/pathalgideal.gi
@@ -65,7 +65,7 @@ InstallTrueMethod( IsIdealInPathAlgebra,
 #O  \in(<elt>, <I>)
 ##
 ##  This function performs a membership test for an ideal in path algebra using 
-##  GBNP Groebner Bases machinery.
+##  (by default GBNP) Groebner Bases machinery.
 ##  It returns true if <elt> is a member of an ideal <I>, false otherwise.
 ##  For the efficiency reasons, it computes Groebner basis
 ##  for <I> only if it has not been computed. Similarly, it performs
@@ -103,7 +103,7 @@ InstallMethod(\in,
       else
         TryNextMethod();
       fi;      
-      GB := GBNPGroebnerBasis(rels, A);
+      GB := GroebnerBasisFunction(A)(rels, A);
       GB := GroebnerBasis(I, GB);
     fi;
 
@@ -143,11 +143,13 @@ InstallMethod( IsAdmissibleIdeal,
       return IsFiniteDimensional(LeftActingRingOfIdeal(I)); # <=> (arrow ideal)^n \subset I, for some n
     fi;
 
+    A := LeftActingRingOfIdeal(I);
+
     if HasGroebnerBasisOfIdeal(I) then
       gb := GroebnerBasisOfIdeal(I);
     else
       rels := GeneratorsOfIdeal(I);     
-      gb := GBNPGroebnerBasis(rels, LeftActingRingOfIdeal(I));
+      gb := GroebnerBasisFunction(A)(rels, A);
       gb := GroebnerBasis(I, gb);
     fi;
 
@@ -169,7 +171,6 @@ InstallMethod( IsAdmissibleIdeal,
     # Dimension(J^{2n+2}).  If this dimension is different from zero, the ideal is not
     # admissible.  If this dimension is zero, then the ideal is admissible.
     # 
-    A := LeftActingRingOfIdeal(I);
     B := A/I;
     if IsFiniteDimensional(B) then
         arrows := List(ArrowsOfQuiver(QuiverOfPathAlgebra(B)), a -> One(B)*a);
@@ -226,7 +227,8 @@ InstallMethod( IsMonomialIdeal,
     if HasGroebnerBasisOfIdeal(I) then
       GB := GroebnerBasisOfIdeal(I);
     else
-      GB := GBNPGroebnerBasis(rels, LeftActingRingOfIdeal(I));
+      A := LeftActingRingOfIdeal(I);
+      GB := GroebnerBasisFunction(A)(rels, A);
       GB := GroebnerBasis(I, GB);
     fi;
 

diff --git a/lib/pathalgpredef.gi b/lib/pathalgpredef.gi
@@ -151,7 +151,7 @@ InstallMethod ( NakayamaAlgebra,
             return KQ;
         else
             I := Ideal(KQ,rels);
-            gb := GBNPGroebnerBasis(rels,KQ);
+            gb := GroebnerBasisFunction(KQ)(rels,KQ);
             gbb := GroebnerBasis(I,gb);
             A := KQ/I;
             SetFilterObj(A, IsNakayamaAlgebra and IsAdmissibleQuotientOfPathAlgebra );               
@@ -277,7 +277,7 @@ InstallMethod ( CanonicalAlgebra,
             Add(relations,arms[i] - arms[2] + relcoeff[i - 2]*arms[1]);
         od;
         I := Ideal(KQ,relations);
-        gb := GBNPGroebnerBasis(relations,KQ);
+        gb := GroebnerBasisFunction(KQ)(relations,KQ);
         gbb := GroebnerBasis(I,gb);
         A := KQ/I;
         SetFilterObj(A, IsCanonicalAlgebra and IsAdmissibleQuotientOfPathAlgebra );

diff --git a/lib/projpathalgmodule.gi b/lib/projpathalgmodule.gi
@@ -2252,7 +2252,7 @@ InstallMethod( ProjectivePathAlgebraPresentation,
     gens := GeneratorsOfTwoSidedIdeal(fam!.ideal);
     K := LeftActingDomain(A);
     I := Ideal(KQ,gens);
-    gb := GBNPGroebnerBasis(gens,KQ);
+    gb := GroebnerBasisFunction(KQ)(gens,KQ);
     gbb := GroebnerBasis(I,gb);
     rtgbofI := RightGroebnerBasis(I);
 

diff --git a/read.g b/read.g
@@ -23,6 +23,7 @@ ReadPackage("QPA", "lib/projpathalgmodule.gi");
 ReadPackage("QPA", "lib/moduledecomp.gi");
 ReadPackage("QPA", "lib/idempotent.gi");
 ReadPackage("QPA", "lib/gbnp.gi");
+ReadPackage("QPA", "lib/gbhighlevel.gi");
 ReadPackage("QPA", "lib/moduleprojres.gi");
 ReadPackage("QPA", "lib/pathalgtensor.gi");
 ReadPackage("QPA", "lib/pathalgpredef.gi");