passagemath-singular 10.6.31rc3__cp314-cp314-manylinux_2_27_aarch64.manylinux_2_28_aarch64.whl

sage_wheels/share/singular/LIB/sresext.lib

@@ -0,0 +1,757 @@
+//////////////////////////////////////////////////////////////////////////////
+version="version sresext.lib 4.4.1.0 Feb_2025 "; // $Id: e8f0c7051c2bcd098ad8bcf4406d807bb292d9e4 $
+category="Noncommutative";
+info="
+LIBRARY: sresforext.lib        Schreyer's algorithm for modules over the exterior algebra
+AUTHORS: Ramesh, L.,           ramesh@mathematik.uni-kl.de
+
+OVERVIEW:
+Procedures for and involving computing Schreyer resolution of modules over the exterior algebra
+
+PROCEDURES:
+schreyerSyzExt(m);            (refined) Schreyer syzygy of a module over the exterior algebra
+sresExt(m,p);                 free resolution of module m over the exterior algebra using refined Schreyer alg
+mresExt(m,p);                 minimal free resolution of module m over the exterior algebra using refined Schreyer alg
+sheafCohBGGsres(M,l,h)        cohomology of twists of the coherent sheaf F on P^n
+                              associated to coker(M). The range of twists is determined by l,h.
+";
+
+LIB "nctools.lib"; // for ncalg
+LIB "matrix.lib"; // for submat
+LIB "sheafcoh.lib"; // for displayCohom
+//LIB "tst.lib"; tst_init(); tst_ignore("// ** loaded "); tst_ignore("// ** _ is no standard basis");
+
+///////////////////////////////////////////////////////////////////////////////
+
+static proc leadmonomial_nc(def s)
+{
+  int e;
+  poly m;
+
+  if(typeof(s) == "vector"){
+    e=leadexp(s)[nvars(basering)+1];
+    m=leadmonom(s)[e,1];
+  }
+  if(typeof(s) == "poly"){
+    m=leadmonom(s);
+   }
+  return(m);
+}
+example
+{
+  "EXAMPLE:";echo=2;
+  ring r = 0,(x,y,z),dp;
+  vector v = [x2+y,0,z];
+  leadmonomial_nc(v);
+}
+
+static proc leadterm(def s)
+{
+  int e;
+  poly m;
+
+  if(typeof(s) == "vector"){
+    e=leadexp(s)[nvars(basering)+1];
+    m=lead(s)[e,1];
+  }
+  if(typeof(s) == "poly"){
+    m=lead(s);
+   }
+  return(m);
+}
+example
+{
+  "EXAMPLE:";echo=2;
+  ring r = 0,(x,y,z),dp;
+  vector v = [x2+y,0,z];
+  leadterm(v);
+}
+
+/*to compute the least common divisor of two monomials that came from the lifting of a module over the exterior algebra.
+That is, each monomial may either be a square of a variable, or a monomial where the power of each variable is 0 or 1.
+This function is used to compute the lead syzygy module of a module over the exterior algebra and may not be appropriate for other purposes. */
+static proc lcm_(poly v, poly w)
+{
+    string strv = string(v);
+    string strw = string(w);
+    int sizev = size(strv);
+    int sizew = size(strw);
+    int n = nvars(basering);
+    int i;
+    intvec expv, expw;
+    poly ans = 1;
+    if (strv[sizev] == "2" && strw[sizew] == "2"){
+      ans = 0;
+      return(ans); // not sure about type
+    }
+    else{
+      if (strv[sizev] != "2" && strw[sizew] != "2"){
+        expv = leadexp(v);
+        expw = leadexp(w);
+        for (i=1; i<=n; i++){
+          if (expv[i]==1 || expw[i]==1){
+            ans = ans*var(i);
+          }
+        }
+        return(ans);
+      }
+      else {
+        if (strv[sizev] == "2"){
+          expw = leadexp(w);
+          expv = leadexp(v);
+          for (i=1; i<=n; i++){
+            if (expv[i] == 2){
+              ans = ans*(var(i))^2;
+            }
+            else{
+              if (expw[i] == 1){
+                ans = ans*var(i);
+              }
+            }
+          }
+        }
+        else{
+          expw = leadexp(w);
+          expv = leadexp(v);
+          for (i=1; i<=n; i++){
+            if (expw[i] == 2){
+              ans = ans*(var(i))^2;
+            }
+            else{
+              if (expv[i] == 1){
+                ans = ans*var(i);
+              }
+            }
+          }
+        }
+        return(ans);
+      }
+    }
+}
+
+static proc schreyers_syz_(module m)
+{
+  module lead_mod = lead_syz_(m);
+  module ans;
+  vector s;
+  int i;
+  for (i=1;i<=size(lead_mod); i++){
+    s = lift_tree_(lead_mod[i], m);
+    ans[size(ans)+1] = s;
+  }
+  return(ans);
+}
+
+static proc lead_syz_(module m)
+{
+  int r = size(m);
+  int n = nvars(basering);
+  module M = std(freemodule(r));
+  vector pi, pj, t, s;
+  poly Li, Lj, mji;
+  int i, j, k, expi, expj;
+  module temp_mod_1, temp_mod_2;
+  module lead_mod; //this is what we will return
+
+  for(i=2; i<=r; i++){
+    pi = m[i];
+    for(j=1; j<i; j++){
+      pj = m[j];
+      expi = leadexp(pi)[n+1];
+      expj = leadexp(pj)[n+1];
+      if(expi == expj){
+        Li = leadmonomial_nc(pi);
+        Lj = leadmonomial_nc(pj);
+        mji = lcm_(Lj,Li)/leadterm(pi);
+        t = mji*M[i];
+        for (k=1;k<=size(lead_mod);k++){
+          temp_mod_1 = lead_mod[k];
+          attrib(temp_mod_1, "isSB", 1);
+          if (NF(t, temp_mod_1)==0){
+            t = 0;
+            break;
+          }
+          else{
+            temp_mod_2 = t;
+            attrib(temp_mod_2, "isSB", 1);
+            if(NF(lead_mod[k], temp_mod_2)==0){
+              lead_mod = delete(lead_mod, k);
+              k = k-1;
+            }
+          }
+        }
+        if(t != 0){
+          lead_mod[size(lead_mod)+1] = t;
+        }
+      }
+    }
+  }
+  return(lead_mod);
+}
+
+static proc lift_tree_(vector s, module M)
+{
+  vector g = phi_(s, M);
+  vector T = remove_LOT_(g, M);
+  vector L;
+  vector ans = s;
+  int i;
+  poly m;
+  module temp_I;
+
+
+  while (T != 0){
+    L = lead(T);
+    for(i=1; i<=size(M); i++){
+      temp_I = leadmonom(M[i]);
+      attrib(temp_I, "isSB", 1);
+      if(NF(L, temp_I)==0){
+        m = leadmonomial_nc(L)/leadterm(M[i]);
+        //check sign:
+        if (m*leadterm(M[i]) != leadterm(L)){
+          m = -m;
+        }
+        if (greater_than_(s, m*gen(i), M)){
+          ans = ans - lift_subtree_(m*gen(i),M);
+          break;
+        }
+      }
+    }
+    T = T - L;
+  }
+  return(ans);
+}
+
+static proc lift_subtree_(vector s, module M)
+{
+  vector g = phi_(s, M);
+  g = g - lead(g);
+  vector T = remove_LOT_(g, M);
+  vector ans = s;
+  poly m;
+  int i;
+  vector L;
+  module temp_I;
+
+  while (T != 0){
+    if (leadexp(T)[nvars(basering)+1] > 15){
+    }
+    L = lead(T);
+    for(i=1; i<=size(M); i++){
+      temp_I = leadmonom(M[i]);
+      attrib(temp_I, "isSB", 1);
+      if(NF(L, temp_I)==0){
+        m = leadmonomial_nc(L)/leadmonomial_nc(M[i]); //TODO check sign!
+
+        //check sign:
+        if (m*leadterm(M[i]) != leadterm(L)){
+          m = -m;
+        }
+        ans = ans - lift_subtree_(m*gen(i),M);
+        break;
+      }
+    }
+    T = T - L;
+  }
+  return(ans);
+}
+
+static proc phi_(vector s, module m)
+{
+  int n = nvars(basering);
+  int i = leadexp(s)[n+1];
+  //s is a term
+  poly t = leadterm(s);
+  return(t*m[i]);
+}
+
+static proc remove_LOT_(vector g, module m)
+{
+  vector L;
+  int i;
+  vector LOT;
+  module temp_I;
+  while(g != 0){
+    for(i=1; i<=size(m); i++){
+      L = lead(g);
+      temp_I = leadmonom(m[i]);
+      attrib(temp_I, "isSB", 1);
+      if(NF(L, temp_I) == 0){
+        LOT = LOT+L;
+        break;
+      }
+    }
+    g = g - L;
+  }
+  return(LOT);
+}
+
+static proc greater_than_(vector s, vector v, module M)
+{
+  int n = nvars(basering);
+  int i = leadexp(s)[n+1];
+  int j = leadexp(v)[n+1];
+  poly mi = leadterm(s);
+  poly mj = leadterm(v);
+  if (lead(mi*M[i]) > lead(mj*M[j])){
+    return(1);
+  }
+  else{
+    if(lead(mi*M[i]) == lead(mj*M[j]) && i>j){
+      return(1);
+    }
+    return(0);
+  }
+}
+
+static proc add_ideal_gens_(module m)
+{
+  int n = nvars(basering);
+  int i,j;
+  for (i = 1; i<= n; i++){
+    for (j = 1; j<= rank(m); j++){
+      m[size(m)+1] = var(i)^2 * gen(j);
+    }
+  }
+  return(m);
+}
+
+static proc ext_elimination_(module m, module syz_mod)
+{
+  //note m is NOT lifted.
+  int r = size(m);
+  int n = nvars(basering);
+  module ans_mod, temp_I;
+
+  matrix needed_mat = submat(matrix(syz_mod), 1..r, 1..size(syz_mod));
+  ans_mod = module(needed_mat);
+  int i,j,k;
+
+  for(i=1;i<=size(ans_mod);i++){
+    for(j=1;j<=nrows(matrix(ans_mod[i]));j++){
+      for(k=1;k<=n;k++){
+        temp_I = var(k)^2;
+        attrib(temp_I, "isSB", 1);
+        if ((NF(ans_mod[i][j], temp_I) == 0) && ans_mod[i][j] != 0){
+          ans_mod[i] = ans_mod[i] - ans_mod[i][j]*gen(j);
+          break;
+        }
+      }
+    }
+    if(ans_mod[i] == 0){
+        ans_mod = delete(ans_mod, i);
+        i = i-1;
+    }
+  }
+  return(ans_mod);
+}
+
+
+///////////////////////////////////////////////////////////////////////////////
+
+//THIS IS THE MAIN USER CALLABLE PROCEDURE.
+proc schreyerSyzExt(module m)
+"USAGE:   schreyerSyzExt(m); m a module over the exterior algebra.
+RETURN:   module
+PURPOSE:  computes the syzygy module of a m over the exterior algebra.
+THEORY:
+SEE ALSO: sresExt, mresExt
+EXAMPLE: example schreyerSyzExt; shows an example
+"
+{
+  int i,j;
+
+  //create ring
+  ring r = basering;
+  int N = nvars(r);
+  ring R = create_ring(ring_list(basering)[1], ringlist(basering)[2], "("+ordstr(basering)+")", "no_minpoly");
+  matrix E = UpOneMatrix(N);
+  E = -1*(E);
+  def RR = nc_algebra(E,0); setring RR;
+
+  //imap m to new ring
+  module M = imap(r, m);
+
+  module lift_m = add_ideal_gens_(M);
+  module syz_mod = schreyers_syz_(lift_m);
+  module ans_mod_ = ext_elimination_(M,syz_mod);
+
+  //setring original ring
+  setring r;
+
+  //fetch ans_mod
+  module ans_mod = imap(RR,ans_mod_);
+
+  return(ans_mod);
+}
+example
+{
+  "EXAMPLE:";echo=2;
+  ring r = (0,q),(x,y,z),dp;
+  def e = Exterior(); setring e;
+  vector f1 = [x,y,0,z,0,0];
+  vector f2 = [0,x,y,0,z,0];
+  vector f3 = [0,0,0,x,y,z];
+  module m = f1,f2,f3;
+  m = std(m);
+  schreyerSyzExt(m);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+
+static proc sres_ext_(module m, int p)
+{
+  int i,j;
+  list res_list, lead_terms_list;
+  lead_terms_list[1] = m;
+
+  res_list[1] = m;
+  for (i = 1; i<p; i++){
+    res_list[i+1] = total_syz_alg(res_list[i], lead_terms_list);
+    lead_terms_list[i+1] = lead(res_list[i+1]);
+  }
+  resolution ans_res = res_list;
+  //can't return something in a different ring!!!
+  return(ans_res);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+
+proc sresExt(module m, int p)
+"USAGE:   srexExt(m,p); m a module over the polynomial ring.
+RETURN:   resolution
+PURPOSE:  to compute the minimal free resolution of m, where m represents a module over the exterior algebra, up to pth cohomological degree.
+THEORY:
+SEE ALSO: mresExt, schreyerSyzExt
+EXAMPLE: example sresExt; shows an example
+"
+{
+  //assume basering is the exterior algebra
+  ring ext_ring = basering;
+  int n = nvars(basering);
+  intmat E = UpOneMatrix(n);
+  E = -1*(E);
+  //N is the anti-commutative polynomial ring
+  ring R = create_ring(ring_list(basering)[1], ringlist(basering)[2], "("+ordstr(basering)+")", "no_minpoly");
+  def N = nc_algebra(E,0); setring N;
+  list L; int i;
+
+  module M = imap(ext_ring, m);
+  resolution res1 = sres_ext_(M,p);
+  for (i=1; i<=size(res1); i++){
+    L[i] = res1[i];
+  }
+  setring ext_ring;
+  list LL = imap(N, L);
+  resolution ans_res = LL;
+  return(ans_res);
+}
+example
+{"EXAMPLE:";echo=2;
+  ring r = 0,(x,y,z),dp;
+  def e = Exterior(); setring e;
+  vector f1 = [x,y,0,z,0,0];
+  vector f2 = [0,x,y,0,z,0];
+  vector f3 = [0,0,0,x,y,z];
+  module m = f1,f2,f3;
+  m = std(m);
+  sresExt(m,4);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+
+static proc total_syz_alg(module mod_, list L)
+{
+  module lift_m = add_ideal_gens_(mod_);
+  L[size(L)] = lead(lift_m);
+  module syz_mod = schreyers_syz_with_order(lift_m, L);
+
+  module ans_mod = ext_elimination_(mod_,syz_mod);
+  L[size(L)] = lead(mod_);
+  //we are not sorting here!
+  int i,j;
+  for (i = 1; i<size(ans_mod); i++){
+    for (j = i+1; j<=size(ans_mod); j++){
+      if (ans_mod[i] == ans_mod[j]){
+        ans_mod = delete(ans_mod,j);
+        j--;
+      }
+    }
+  }
+  return(ans_mod);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+
+static proc schreyers_syz_with_order(module m, list L)
+{
+  module lead_mod = lead_syz_(m);
+  module ans;
+  vector s;
+  int i,j;
+  for (i=1;i<=size(lead_mod); i++){
+    s = lift_tree_with_order(lead_mod[i], m, L);
+    ans[size(ans)+1] = s;
+  }
+  return(ans);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+
+static proc lift_tree_with_order(vector s, module M, list LL)
+{
+  vector g = phi_(s, M);
+  vector T = remove_LOT_(g, M);
+  vector L;
+  vector ans = s;
+  int i;
+  poly m;
+  module temp_I;
+
+  ideal im, iF_, imif, iL;
+  while (T != 0){
+    L = lead(T);
+    for(i=1; i<=size(M); i++){
+      temp_I = leadmonom(M[i]);
+      attrib(temp_I, "isSB", 1);
+      if(NF(L, temp_I)==0){
+        m = leadmonomial_nc(L)/leadterm(M[i]);
+
+        //check sign:
+        if (m*leadterm(M[i])!= leadterm(L)){
+          m = -m;
+        }
+        //schreyer order algorithm should be called here
+        if (gr_than_for_res(s,m*gen(i),LL)){
+          ans = ans - lift_subtree_(m*gen(i),M);
+          break;
+        }
+      }
+    }
+    T = T - L;
+  }
+  return(ans);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+
+static proc gr_than_for_res(vector s, vector v, list L)
+{
+  if (size(L) == 1){
+    return(greater_than_(s,v,L[1]));
+  }
+  int n = nvars(basering);
+  poly m1 = leadterm(s); poly m2 = leadterm(v);
+  int e1 = leadexp(s)[n+1]; int e2 = leadexp(v)[n+1];
+  if(e1 == e2){
+    return(m1>m2);
+  }
+  s = m1*L[size(L)][e1]; v = m2*L[size(L)][e2];
+  if (s == v || s == -v){
+    if(e1 > e2){
+      return(1);
+    }
+    else{
+      return(0);
+    }
+  }
+  L = delete(L, size(L));
+  return(gr_than_for_res(s,v,L));
+}
+
+///////////////////////////////////////////////////////////////////////////
+
+proc mresExt(module m, int p)
+"USAGE:   mresExt(m,p); m a module over the polynomial ring.
+RETURN:   resolution
+PURPOSE:  to compute the minimal free resolution of m, where m represents a module over the exterior algebra, up to pth cohomological degree.
+THEORY:
+SEE ALSO: sresExt, schreyerSyzExt
+EXAMPLE: example mresExt; shows an example
+"
+{ //first compute groebner basis
+  m = std(m);
+  //first we build our required non-commutative ring.
+  ring r = basering;
+  int i;
+  int n = nvars(basering);
+  intmat E = UpOneMatrix(n);
+  E = -1*(E);
+  ring R = create_ring(ring_list(basering)[1], ringlist(basering)[2], "("+ordstr(basering)+")", "no_minpoly");
+  //N is the anti-commutative polynomial ring
+  def N = nc_algebra(E,0); setring N;
+
+  //now we fetch the given module.
+  module M = imap(r, m);
+  module temp_mod;
+
+  //create the non-minimal resolution over the non-commutative ring.
+  resolution res_ = sres_ext_(M,p);
+  int s = size(res_);
+
+  //fetch the resolution to the quotient ring over the symmetric algebra.
+  list ans_L;
+  for (i=1; i<=s; i++){
+    setring N;
+    temp_mod = res_[i];
+    setring r;
+    ans_L[i] = fetch(N, temp_mod);
+  }
+
+  //minimise the resolution over the quotient algebra.
+  resolution quo_res = ans_L;
+  quo_res = minres(quo_res);
+  return(quo_res);
+}
+example
+{"EXAMPLE:";echo=2;
+  ring r = 0,(x,y,z),dp;
+  def E = Exterior();
+  vector f1 = [x,y,0,z,0,0];
+  vector f2 = [0,x,y,0,z,0];
+  vector f3 = [0,0,0,x,y,z];
+  module m = f1,f2,f3;
+  mresExt(m,4);
+}
+
+///////////////////////////////////////////////////////////////////////////
+
+proc sheafCohBGGsres(module M,int l,int h)
+"USAGE:   sheafCohBGGsres(M,l,h);    M module, l,h int
+ASSUME:  M is graded, and it comes assigned with an admissible degree
+         vector as an attribute, h>=l, and the basering has n+1
+         variables.
+RETURN:  intmat, cohomology of twists of the coherent sheaf F on P^n
+         associated to coker(M). The range of twists is determined by l, h.
+DISPLAY: The intmat is displayed in a diagram of the following form:
+         with displayCohom(A,l,h,nvars(r)-1);
+  @format
+                l            l+1                      h
+  ----------------------------------------------------------
+      n:     h^n(F(l))    h^n(F(l+1))   ......    h^n(F(h))
+           ...............................................
+      1:     h^1(F(l))    h^1(F(l+1))   ......    h^1(F(h))
+      0:     h^0(F(l))    h^0(F(l+1))   ......    h^0(F(h))
+  ----------------------------------------------------------
+    chi:     chi(F(l))    chi(F(l+1))   ......    chi(F(h))
+  @end format
+         A @code{'-'} in the diagram refers to a zero entry; a @code{'*'}
+         refers to a negative entry (= dimension not yet determined).
+         refers to a not computed dimension.
+NOTE:    This procedure is based on the Bernstein-Gel'fand-Gel'fand
+         correspondence and on Tate resolution ( see [Eisenbud, Floystad,
+         Schreyer: Sheaf cohomology and free resolutions over exterior
+         algebras, Trans AMS 355 (2003)] ).
+         sheafCohBGG(M,l,h) does not compute all values in the above
+         table. To determine all values of h^i(F(d)), d=l..h,
+         use sheafCohBGG(M,l-n,h+n).
+SEE ALSO: sheafCoh, dimH, displayCohom
+EXAMPLE: example sheafCohBGG; shows an example
+"
+{
+  int i,j,k,row,col,p;
+  if( typeof(attrib(M,"isHomog"))!="intvec" )
+  {
+     if (size(M)==0) { attrib(M,"isHomog",0); }
+     else { ERROR("No admissible degree vector assigned"); }
+  }
+  int n=nvars(basering)-1;
+  int ell=l+n;
+  def R=basering;
+  int reg = CM_regularity(M);
+  int bound=max(reg+1,h-1);
+  module MT=truncate(M,bound);
+  int m=nrows(MT);
+  MT=transpose(jacobM(MT));
+  MT=syz(MT);
+  matrix ML[n+1][1]=maxideal(1);
+  matrix S=transpose(outer(ML,unitmat(m)));
+  matrix SS=transpose(S*MT);
+  //--- to the exterior algebra
+  def AR = Exterior();
+  setring AR;
+  intvec saveopt=option(get);
+  option(redSB);
+  option(redTail);
+  module EM=imap(R,SS);
+  intvec w;
+  //--- here we are with our matrix
+  int bound1=max(1,bound-ell+1);
+  for (i=1; i<=nrows(EM); i++)
+  {
+     w[i]=-bound-1;
+  }
+  attrib(EM,"isHomog",w);
+  resolution temp_res = mresExt(EM,bound1+1);
+  list L;
+  for (i = 1; i <= bound1; i++){
+    L[i] = temp_res[i];
+  }
+  resolution RE = L;
+  intmat Betti = betti(RE);
+  k=ncols(Betti);
+  row=nrows(Betti);
+  int shift = 0;
+  intmat newBetti[n+1][h-l+1];
+  for (j=1; j<=row; j++)
+  {
+    for (i=l; i<=h; i++)
+    {
+      if (((n+2-shift-j)>0)&&((n+2-shift-j)<=(n+1))
+      && ((i-l+1)>0)&&((i-l+1)<=(h-l+1)))
+      {
+        if ((k+1-j-i+ell-shift>0) and (j+i-ell+shift>=1))
+        {
+          newBetti[n+2-shift-j,i-l+1]=Betti[j,k+1-j-i+ell-shift];
+        }
+        else
+        {
+          newBetti[n+2-shift-j,i-l+1]=-1;
+        }
+      }
+    }
+  }
+  for (j=2; j<=n+1; j++)
+  {
+    for (i=1; i<j; i++)
+    {
+      newBetti[j,i]=-1;
+    }
+  }
+  int d=k-h+ell-1;
+  for (j=1; j<=n; j++)
+  {
+    for (i=h-l+1; i>=k+j; i--)
+    {
+      newBetti[j,i]=-1;
+    }
+  }
+  option(set,saveopt);
+  setring R;
+  return(newBetti);
+}
+example
+{"EXAMPLE:";
+  echo = 2;
+  // cohomology of structure sheaf on P^4:
+  //-------------------------------------------
+  ring r=0,x(1..3),dp;
+  module M=0;
+  intmat A=sheafCohBGGsres(M,-4,1);
+  A;
+  displayCohom(A,-4,1,nvars(r)-1);
+}
+
+///////////////////////////////////////////////////////////////////////////
+
+static proc jacobM(matrix M) //kopiert aus sheafcoh.lib
+{
+   int n=nvars(basering);
+   matrix B=transpose(diff(M,var(1)));
+   int i;
+   for(i=2;i<=n;i++)
+   {
+     B=concat(B,transpose(diff(M,var(i))));
+   }
+   return(transpose(B));
+}