passagemath-singular 10.6.31rc3__cp314-cp314-musllinux_1_2_x86_64.whl

sage_wheels/share/singular/LIB/pointid.lib

@@ -0,0 +1,673 @@
+/////////////////////////////////////////////////////////////////////////////
+version="version pointid.lib 4.4.0.0 Nov_2023 "; // $Id: d17191607296ad59ae043cbf184b129098f2e3ce $
+category="Commutative Algebra";
+info="
+LIBRARY:  pointid.lib     Procedures for computing a factorized lex GB of
+                          the vanishing ideal of a set of points via the
+                          Axis-of-Evil Theorem (M.G. Marinari, T. Mora)
+
+AUTHOR:   Stefan Steidel, steidel@mathematik.uni-kl.de
+
+OVERVIEW:
+    The algorithm of Cerlienco-Mureddu [Marinari M.G., Mora T., A remark on a
+    remark by Macaulay or Enhancing Lazard Structural Theorem. Bull. of the
+    Iranian Math. Soc., 29 (2003), 103-145] associates to each ordered set of
+    points A:={a1,...,as} in K^n, ai:=(ai1,...,ain)@*
+          - a set of monomials N and@*
+          - a bijection phi: A --> N.
+    Here I(A):={f in K[x(1),...,x(n)] | f(ai)=0, for all 1<=i<=s} denotes the
+    vanishing ideal of A and N = Mon(x(1),...,x(n)) \ {LM(f)|f in I(A)} is the
+    set of monomials which do not lie in the leading ideal of I(A) (w.r.t. the
+    lexicographical ordering with x(n)>...>x(1)). N is also called the set of
+    non-monomials of I(A). NOTE: #A = #N and N is a monomial basis of
+    K[x(1..n)]/I(A). In particular, this allows to deduce the set of
+    corner-monomials, i.e. the minimal basis M:={m1,...,mr}, m1<...<mr, of its
+    associated monomial ideal M(I(A)), such that@*
+    M(I(A))= {k*mi | k in Mon(x(1),...,x(n)), mi in M},@*
+    and (by interpolation) the unique reduced lexicographical Groebner basis
+    G := {f1,...,fr} such that LM(fi)=mi for each i, that is, I(A)=<G>.
+    Moreover, a variation of this algorithm allows to deduce a canonical linear
+    factorization of each element of such a Groebner basis in the sense ot the
+    Axis-of-Evil Theorem by M.G. Marinari and T. Mora. More precisely, a
+    combinatorial algorithm and interpolation allow to deduce polynomials
+@*
+@*                y_mdi = x(m) - g_mdi(x(1),...,x(m-1)),
+@*
+    i=1,...,r; m=1,...,n; d in a finite index-set F, satisfying
+@*
+@*                 fi = (product of y_mdi) modulo (f1,...,f(i-1))
+@*
+    where the product runs over all m=1,...,n; and all d in F.
+
+PROCEDURES:
+ nonMonomials(id);   non-monomials of the vanishing ideal id of a set of points
+ cornerMonomials(N); corner-monomials of the set of non-monomials N
+ facGBIdeal(id);     GB G of id and linear factors of each element of G
+";
+
+LIB "polylib.lib";
+
+////////////////////////////////////////////////////////////////////////////////
+
+static proc subst1(def id, int m)
+{
+//id = poly/ideal/list, substitute the first m variables occurring in id by 1
+
+  int i,j;
+  def I = id;
+  if(typeof(I) == "list")
+  {
+    for(j = 1; j <= size(I); j++)
+    {
+      for(i = 1; i <= m; i++)
+      {
+        I[j] = subst(I[j],var(i),1);
+      }
+    }
+    return(I);
+  }
+  else
+  {
+    for(i = 1; i <= m; i++)
+    {
+      I = subst(I,var(i),1);
+    }
+    return(I);
+  }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+
+proc nonMonomials(def id)
+"USAGE:  nonMonomials(id); id = <list of vectors> or <list of lists> or <module>
+         or <matrix>.@*
+         Let A= {a1,...,as} be a set of points in K^n, ai:=(ai1,...,ain), then
+         A can be given as@*
+          - a list of vectors (the ai are vectors) or@*
+          - a list of lists (the ai are lists of numbers) or@*
+          - a module s.t. the ai are generators or@*
+          - a matrix s.t. the ai are columns
+ASSUME:  basering must have ordering ip, i.e., be of the form 0,x(1..n),ip;
+         (the first entry of a point belongs to the lex-smallest variable, etc.)
+RETURN:  ideal, the non-monomials of the vanishing ideal I(A) of A
+PURPOSE: compute the set of non-monomials Mon(x(1),...,x(n)) \ {LM(f)|f in I(A)}
+         of the vanishing ideal I(A) of the given set of points A in K^n, where
+         K[x(1),...,x(n)] is equipped with the lexicographical ordering induced
+         by x(1)<...<x(n) by using the algorithm of Cerlienco-Mureddu
+EXAMPLE: example nonMonomials; shows an example
+"
+{
+  list A;
+  int i,j;
+  if(typeof(id) == "list")
+  {
+    for(i = 1; i <= size(id); i++)
+    {
+      if(typeof(id[i]) == "list")
+      {
+        vector a;
+        for(j = 1; j <= size(id[i]); j++)
+        {
+          a = a+id[i][j]*gen(j);
+        }
+        A[size(A)+1] = a;
+        kill a;
+      }
+      if(typeof(id[i]) == "vector")
+      {
+        A[size(A)+1] = id[i];
+      }
+    }
+  }
+  else
+  {
+    if(typeof(id) == "module")
+    {
+      for(i = 1; i <= size(id); i++)
+      {
+        A[size(A)+1] = id[i];
+      }
+    }
+    else
+    {
+      if(typeof(id) == "matrix")
+      {
+        for(i = 1; i <= ncols(id); i++)
+        {
+          A[size(A)+1] = id[i];
+        }
+      }
+      else
+      {
+        ERROR("Wrong type of input!!");
+      }
+    }
+  }
+
+  int n = nvars(basering);
+  int s;
+  int m,d;
+  ideal N = 1;
+  ideal N1,N2;
+  list Y,D,W,Z;
+  poly my,t;
+  for(s = 2; s <= size(A); s++)
+  {
+
+//-- compute m = max{ j | ex. i<s: pr_j(a_i) = pr_j(a_s)} ---------------------
+//-- compute d = |{ a_i | i<s: pr_m(a_i) = pr_m(a_s), phi(a_i) in T[1,m+1]}| --
+    m = 0;
+    Y = A[1..s-1];
+    N2 = N[1..s-1];
+    while(size(Y) > 0)      //assume all points different (m <= size(basering))
+    {
+      D = Y;
+      N1 = N2;
+      Y = list();
+      N2 = ideal();
+      m++;
+      for(i = 1; i <= size(D); i++)
+      {
+        if(A[s][m] == D[i][m])
+        {
+          Y[size(Y)+1] = D[i];
+          N2[size(N2)+1] = N1[i];
+        }
+      }
+    }
+    m = m - 1;
+    d = size(D);
+    if(m < n-1)
+    {
+      for(i = 1; i <= size(N1); i++)
+      {
+        if(N1[i] >= var(m+2))
+        {
+          d = d - 1;
+        }
+      }
+    }
+
+//------- compute t = my * x(m+1)^d where my is obtained recursively --------
+    if(m == 0)
+    {
+      my = 1;
+    }
+    else
+    {
+      Z = list();
+      for(i = 2; i <= s-1; i++)
+      {
+        if((leadexp(N[i])[m+1] == d) && (coeffs(N[i],var(m+1))[nrows(coeffs(N[i],var(m+1))),1] < var(m+1)))
+        {
+          Z[size(Z)+1] = A[i][1..m];
+        }
+      }
+      Z[size(Z)+1] = A[s][1..m];
+
+      my = nonMonomials(Z)[size(Z)];
+    }
+
+    t = my * var(m+1)^d;
+
+//---------------------------- t is added to N --------------------------------
+    N[size(N)+1] = t;
+  }
+  return(N);
+}
+example
+{ "EXAMPLE:"; echo = 2;
+   ring R1 = 0,x(1..3),ip;
+   vector a1 = [4,0,0];
+   vector a2 = [2,1,4];
+   vector a3 = [2,4,0];
+   vector a4 = [3,0,1];
+   vector a5 = [2,1,3];
+   vector a6 = [1,3,4];
+   vector a7 = [2,4,3];
+   vector a8 = [2,4,2];
+   vector a9 = [1,0,2];
+   list A = a1,a2,a3,a4,a5,a6,a7,a8,a9;
+   nonMonomials(A);
+
+   matrix MAT[9][3] = 4,0,0,2,1,4,2,4,0,3,0,1,2,1,3,1,3,4,2,4,3,2,4,2,1,0,2;
+   MAT = transpose(MAT);
+   print(MAT);
+   nonMonomials(MAT);
+
+   module MOD = gen(3),gen(2)-2*gen(3),2*gen(1)+2*gen(3),2*gen(2)-2*gen(3),gen(1)+3*gen(3),gen(1)+gen(2)+3*gen(3),gen(1)+gen(2)+gen(3);
+   print(MOD);
+   nonMonomials(MOD);
+
+   ring R2 = 0,x(1..2),ip;
+   list l1 = 0,0;
+   list l2 = 0,1;
+   list l3 = 2,0;
+   list l4 = 0,2;
+   list l5 = 1,0;
+   list l6 = 1,1;
+   list L = l1,l2,l3,l4,l5,l6;
+   nonMonomials(L);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+
+proc cornerMonomials(ideal N)
+"USAGE:  cornerMonomials(N); N ideal
+ASSUME:  N is given by monomials satisfying the condition that if a monomial is
+         in N then any of its factors is in N (N is then called an order ideal)
+RETURN:  ideal, the corner-monomials of the order ideal N @*
+         The corner-monomials are the leading monomials of an ideal I s.t. N is
+         a basis of basering/I.
+NOTE:    In our applications, I is the vanishing ideal of a finte set of points.
+EXAMPLE: example cornerMonomials; shows an example
+"
+{
+  int n = nvars(basering);
+  int i,j,h;
+  list C;
+  poly m,p;
+  int Z;
+  int vars;
+  intvec v;
+  ideal M;
+
+//-------------------- Test: Is 1 in N ?, if no, return <1> ----------------------
+  for(i = 1; i <= size(N); i++)
+  {
+    if(1 == N[i])
+    {
+      h = 1;
+      break;
+    }
+  }
+  if(h == 0)
+  {
+    return(ideal(1));
+  }
+
+//----------------------------- compute the set M -----------------------------
+  for(i = 1; i <= n; i++)
+  {
+    C[size(C)+1] = list(var(i),1);
+  }
+  while(size(C) > 0)
+  {
+    m = C[1][1];
+    Z = C[1][2];
+    C = delete(C,1);
+    vars = 0;
+    v = leadexp(m);
+    for(i = 1; i <= n; i++)
+    {
+      vars = vars + (v[i] != 0);
+    }
+
+    if(vars == Z)
+    {
+      h = 0;
+      for(i = 1; i <= size(N); i++)
+      {
+        if(m == N[i])
+        {
+          h = 1;
+          break;
+        }
+      }
+
+      if(h == 0)
+      {
+        M[size(M)+1] = m;
+      }
+      else
+      {
+        for(i = 1; i <= n; i++)
+        {
+          p = m * var(i);
+          if(size(C) == 0)
+          {
+            C[1] = list(p,1);
+          }
+          else
+          {
+            for(j = 1; j <= size(C); j++)
+            {
+              if(p <= C[j][1] || j == size(C))
+              {
+                if(p == C[j][1])
+                {
+                  C[j][2] = C[j][2] + 1;
+                }
+                else
+                {
+                  if(p < C[j][1])
+                  {
+                    C = insert(C,list(p,1),j-1);
+                  }
+                  else
+                  {
+                    C[size(C)+1] = list(p,1);
+                  }
+                }
+                break;
+              }
+            }
+          }
+        }
+      }
+    }
+  }
+  return(M);
+}
+example
+{ "EXAMPLE:"; echo = 2;
+   ring R = 0,x(1..3),ip;
+   poly n1 = 1;
+   poly n2 = x(1);
+   poly n3 = x(2);
+   poly n4 = x(1)^2;
+   poly n5 = x(3);
+   poly n6 = x(1)^3;
+   poly n7 = x(2)*x(3);
+   poly n8 = x(3)^2;
+   poly n9 = x(1)*x(2);
+   ideal N = n1,n2,n3,n4,n5,n6,n7,n8,n9;
+   cornerMonomials(N);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+
+proc facGBIdeal(def id)
+"USAGE:  facGBIdeal(id); id = <list of vectors> or <list of lists> or <module>
+         or <matrix>.@*
+         Let A= {a1,...,as} be a set of points in K^n, ai:=(ai1,...,ain), then
+         A can be given as@*
+          - a list of vectors (the ai are vectors) or@*
+          - a list of lists (the ai are lists of numbers) or@*
+          - a module s.t. the ai are generators or@*
+          - a matrix s.t. the ai are columns
+ASSUME:  basering must have ordering ip, i.e., be of the form 0,x(1..n),ip;
+         (the first entry of a point belongs to the lex-smallest variable, etc.)
+RETURN:  a list where the first entry contains the Groebner basis G of I(A)
+         and the second entry contains the linear factors of each element of G
+NOTE:    combinatorial algorithm due to the Axis-of-Evil Theorem of M.G.
+         Marinari, T. Mora
+EXAMPLE: example facGBIdeal; shows an example
+"
+{
+  list A;
+  int i,j;
+  if(typeof(id) == "list")
+  {
+    for(i = 1; i <= size(id); i++)
+    {
+      if(typeof(id[i]) == "list")
+      {
+        vector a;
+        for(j = 1; j <= size(id[i]); j++)
+        {
+          a = a+id[i][j]*gen(j);
+        }
+        A[size(A)+1] = a;
+        kill a;
+      }
+      if(typeof(id[i]) == "vector")
+      {
+        A[size(A)+1] = id[i];
+      }
+    }
+  }
+  else
+  {
+    if(typeof(id) == "module")
+    {
+      for(i = 1; i <= size(id); i++)
+      {
+        A[size(A)+1] = id[i];
+      }
+    }
+    else
+    {
+      if(typeof(id) == "matrix")
+      {
+        for(i = 1; i <= ncols(id); i++)
+        {
+          A[size(A)+1] = id[i];
+        }
+      }
+      else
+      {
+        ERROR("Wrong type of input!!");
+      }
+    }
+  }
+
+  int n = nvars(basering);
+  def S = basering;
+  def R;
+
+  ideal N = nonMonomials(A);
+  ideal eN;
+  ideal M = cornerMonomials(N);
+  poly my, emy;
+
+  int d,k,l,m;
+
+  int d1;
+  poly y(1);
+
+  list N2,D,H;
+  poly z,h;
+
+  int dm;
+  list Am,Z;
+  ideal E;
+  list V,eV;
+  poly p;
+  poly y(2..n),y;
+  poly xi;
+
+  poly f;
+  ideal G1;          // stores the elements of G, i.e. G1 = G the GB of I(A)
+  ideal Y;           // stores the linear factors of GB-elements in each loop
+  list G2;           // contains the linear factors of each element of G
+
+  for(j = 1; j <= size(M); j++)
+  {
+    my = M[j];
+    emy = subst(my,var(1),1);         // auxiliary polynomial
+    eN = subst(N,var(1),1);           // auxiliary monomial ideal
+    Y = ideal();
+
+    d1 = leadexp(my)[1];
+    y(1) = 1;
+    i = 0;
+    k = 1;
+    while(i < d1)
+    {
+//---------- searching for phi^{-1}(x_1^i*x_2^d_2*...*x_n^d_n) ----------------
+      while(my*var(1)^i/var(1)^d1 != N[k])
+      {
+        k++;
+      }
+      y(1) = y(1)*(var(1)-A[k][1]);
+      Y[size(Y)+1] = cleardenom(var(1)-A[k][1]);
+      i++;
+    }
+    f = y(1);                             // gamma_1my
+
+//--------------- Recursion over number of variables --------------------------
+    z = 1;                                // zeta_mmy
+    for(m = 2; m <= n; m++)
+    {
+      z = z * y(m-1);
+
+      D = list();
+      H = list();
+      for(i = 1; i <= size(A); i++)
+      {
+        h = z;
+        for(k = 1; k <= n; k++)
+        {
+          h = subst(h,var(k),A[i][k]);
+        }
+        if(h != 0)
+        {
+          D[size(D)+1] = A[i];
+          H[size(H)+1] = i;
+        }
+      }
+
+      if(size(D) == 0)
+      {
+        break;
+      }
+
+      dm = leadexp(my)[m];
+      while(dm == 0)
+      {
+        m = m + 1;
+        dm = leadexp(my)[m];
+      }
+
+      N2 = list();                        // N2 = N_m
+      emy = subst(emy,var(m),1);
+      eN = subst(eN,var(m),1);
+      for(i = 1; i <= size(N); i++)
+      {
+        if((emy == eN[i]) && (my > N[i]))
+        {
+          N2[size(N2)+1] = N[i];
+        }
+      }
+
+      y(m) = 1;
+      xi = z;
+      for(d = 1; d <= dm; d++)
+      {
+        Am = list();
+        Z = list();                       // Z = pr_m(Am)
+
+//------- V contains all ny*x_m^{d_m-d}*x_m+1^d_m+1*...+x_n^d_n in N_m --------
+        eV = subst1(N2,m-1);
+        V = list();
+        for(i = 1; i <= size(eV); i++)
+        {
+          if(eV[i] == subst1(my,m-1)/var(m)^d)
+          {
+            V[size(V)+1] = eV[i];
+          }
+        }
+
+//------- A_m = phi^{-1}(V) intersect D_md-1 ----------------------------------
+        for(i = 1; i <= size(D); i++)
+        {
+          p = N[H[i]];
+          p = subst1(p,m-1);
+          for(l = 1; l <= size(V); l++)
+          {
+            if(p == V[l])
+            {
+              Am[size(Am)+1] = D[i];
+              Z[size(Z)+1] = D[i][1..m];
+              break;
+            }
+          }
+        }
+
+        E = nonMonomials(Z);
+
+        R = extendring(size(E), "c(", "lp");
+        setring R;
+        ideal E = imap(S,E);
+        list Am = imap(S,Am);
+        poly g = var(size(E)+m);
+        for(i = 1; i <= size(E); i++)
+        {
+          g = g + c(i)*E[i];
+        }
+
+        ideal I = ideal();
+        poly h;
+        for (i = 1; i <= size(Am); i++)
+        {
+          h = g;
+          for(k = 1; k <= n; k++)
+          {
+            h = subst(h,var(size(E)+k),Am[i][k]);
+          }
+          I[size(I)+1] = h;
+        }
+
+        ideal sI = std(I);
+        g = reduce(g,sI);
+
+        setring S;
+        y = imap(R,g);
+        Y[size(Y)+1] = cleardenom(y);
+        xi = xi * y;
+
+        D = list();
+        H = list();
+        for(i = 1; i <= size(A); i++)
+        {
+          h = xi;
+          for(k = 1; k <= n; k++)
+          {
+            h = subst(h,var(k),A[i][k]);
+          }
+          if(h != 0)
+          {
+            D[size(D)+1] = A[i];
+            H[size(H)+1] = i;
+          }
+        }
+
+        y(m) = y(m) * y;
+
+        if(size(D) == 0)
+        {
+          break;
+        }
+      }
+
+      f = f * y(m);
+    }
+    G1[size(G1)+1] = f;
+    G2[size(G2)+1] = Y;
+  }
+  return(list(G1,G2));
+}
+example
+{ "EXAMPLE:"; echo = 2;
+   ring R = 0,x(1..3),ip;
+   vector a1 = [4,0,0];
+   vector a2 = [2,1,4];
+   vector a3 = [2,4,0];
+   vector a4 = [3,0,1];
+   vector a5 = [2,1,3];
+   vector a6 = [1,3,4];
+   vector a7 = [2,4,3];
+   vector a8 = [2,4,2];
+   vector a9 = [1,0,2];
+   list A = a1,a2,a3,a4,a5,a6,a7,a8,a9;
+   facGBIdeal(A);
+
+   matrix MAT[9][3] = 4,0,0,2,1,4,2,4,0,3,0,1,2,1,3,1,3,4,2,4,3,2,4,2,1,0,2;
+   MAT = transpose(MAT);
+   print(MAT);
+   facGBIdeal(MAT);
+
+   module MOD = gen(3),gen(2)-2*gen(3),2*gen(1)+2*gen(3),2*gen(2)-2*gen(3),gen(1)+3*gen(3),gen(1)+gen(2)+3*gen(3),gen(1)+gen(2)+gen(3);
+   print(MOD);
+   facGBIdeal(MOD);
+
+   list l1 = 0,0,1;
+   list l2 = 0,1,-2;
+   list l3 = 2,0,2;
+   list l4 = 0,2,-2;
+   list l5 = 1,0,3;
+   list l6 = 1,1,3;
+   list L = l1,l2,l3,l4,l5,l6;
+   facGBIdeal(L);
+}