Changeset 39a4a17 in git for Singular/LIB/freegb.lib

Timestamp:

Jun 24, 2007, 9:13:20 PM (17 years ago)

Author:

Viktor Levandovskyy <levandov@…>

Branches:

(u'spielwiese', '2a584933abf2a2d3082034c7586d38bb6de1a30a')

Children:

fc4d399ad22f1d122a780e118a353cd26e5313e4

Parents:

502966ccc93312cccaa355b8008b73f25689ad2a

Message:

*levandov: new function crs and examples


git-svn-id: file:///usr/local/Singular/svn/trunk@10148 2c84dea3-7e68-4137-9b89-c4e89433aadc

File:

• Singular/LIB/freegb.lib (modified) (2 diffs)

Singular/LIB/freegb.lib

@@ -1 +1 @@
 //////////////////////////////////////////////////////////////////////////////
-version="$Id: freegb.lib,v 1.2 2007-06-20 15:39:45 Singular Exp $";
+version="$Id: freegb.lib,v 1.3 2007-06-24 19:13:20 levandov Exp $";
 category="Noncommutative";
 info="
@@ -551 +551 @@
 }
 
+proc crs(list LM, int d)
+"USAGE:  crs(L, d);  L a list of modules, d an integer
+RETURN:  ring
+PURPOSE: create a ring and shift the ideal
+EXAMPLE: example crs; shows examples
+"
+{
+  // d = up to degree, will be shifted to d+1
+  if (d<1) {"bad d"; return(0);}
+
+  int ppl = printlevel-voice+2;
+  string err = "";
+
+  int i,j,s;
+  def save = basering;
+  // determine max no of places in the input
+  int slm = size(LM); // numbers of polys in the ideal
+  int sm;
+  intvec iv;
+  module M;
+  for (i=1; i<=slm; i++)
+  {
+    // modules, e.g. free polynomials
+    M  = LM[i];
+    sm = ncols(M);
+    for (j=1; j<=sm; j++)
+    {
+      //vectors, e.g. free monomials
+      iv = iv, size(M[j])-1; // 1 place is reserved by the coeff
+    }
+  }
+  int D = Max(iv); // max size of input words
+  if (d<D) {"bad d"; return(LM);}
+  D = D + d-1;
+  //  D = d;
+  list LR  = ringlist(save);
+  list L, tmp;
+  L[1] = LR[1]; // ground field
+  L[4] = LR[4]; // quotient ideal
+  tmp  = LR[2]; // varnames
+  s = size(LR[2]);
+  for (i=1; i<=D; i++)
+  {
+    for (j=1; j<=s; j++)
+    {
+      tmp[i*s+j] = string(tmp[j])+"("+string(i)+")";
+    }
+  }
+  for (i=1; i<=s; i++)
+  {
+    tmp[i] = string(tmp[i])+"("+string(0)+")";
+  }
+  L[2] = tmp;
+  list OrigNames = LR[2];
+  // ordering: d blocks of the ord on r
+  // try to get whether the ord on r is blockord itself
+  s = size(LR[3]);
+  if (s==2)
+  {
+    // not a blockord, 1 block + module ord
+    tmp = LR[3][s]; // module ord
+    for (i=1; i<=D; i++)
+    {
+      LR[3][s-1+i] = LR[3][1];
+    }
+    LR[3][s+D] = tmp;
+  }
+  if (s>2)
+  {
+    // there are s-1 blocks
+    int nb = s-1;
+    tmp = LR[3][s]; // module ord
+    for (i=1; i<=D; i++)
+    {
+      for (j=1; j<=nb; j++)
+      {
+        LR[3][i*nb+j] = LR[3][j];
+      }
+    }
+    //    size(LR[3]);
+    LR[3][nb*(D+1)+1] = tmp;
+  }
+  L[3] = LR[3];
+  def @R = ring(L);
+  setring @R;
+  ideal I;
+  poly @p;
+  s = size(OrigNames);
+  //  "s:";s;
+  // convert LM to canonical vectors (no powers)
+  setring save;
+  kill M; // M was defined earlier
+  module M;
+  slm = size(LM); // numbers of polys in the ideal
+  int sv,k,l;
+  vector v;
+  //  poly p;
+  string sp;
+  setring @R;
+  poly @@p=0;
+  setring save;
+  for (l=1; l<=slm; l++)
+  {
+    // modules, e.g. free polynomials
+    M  = LM[l];
+    sm = ncols(M); // in intvec iv the sizes are stored
+    for (i=0; i<=d-iv[l]; i++)
+    {
+      // modules, e.g. free polynomials
+      for (j=1; j<=sm; j++)
+      {
+        //vectors, e.g. free monomials
+        v  = M[j];
+        sv = size(v);
+        //      "sv:";sv;
+        sp = "@@p = @@p + ";
+        for (k=2; k<=sv; k++)
+        {
+          sp = sp + string(v[k])+"("+string(k-2+i)+")*";
+        }
+        sp = sp + string(v[1])+";"; // coef;
+        setring @R;
+        execute(sp);
+        setring save;
+      }
+      setring @R;
+      //      "@@p:"; @@p;
+      I = I,@@p;
+      @@p = 0;
+      setring save;
+    }
+  }
+  setring @R;
+  export I;
+  return(@R);
+}
+example
+{
+  "EXAMPLE:"; echo = 2;
+  ring r = 0,(x,y,z),(dp(1),dp(2));
+  module M = [-1,x,y],[-7,y,y],[3,x,x];
+  module N = [1,x,y,x],[-1,y,x,y];
+  list L; L[1] = M; L[2] = N;
+  lst2str(L);
+  def U = crs(L,5);
+  setring U; U;
+  I;
+}
+
+proc ex_shift()
+{
+  LIB "freegb.lib";
+  ring r = 0,(x,y,z),(dp(1),dp(2));
+  module M = [-1,x,y],[-7,y,y],[3,x,x];
+  module N = [1,x,y,x],[-1,y,x,y];
+  list L; L[1] = M; L[2] = N;
+  lst2str(L);
+  def U = crs(L,5);
+  setring U; U;
+  I;
+  poly p = I[2]; // I[8];
+  p;
+  system("stest",p,7,7,3); // error
+  poly q1 = system("stest",p,1,7,3); //ok
+  poly q6 = system("stest",p,6,7,3); //ok
+  system("btest",p,3);
+  system("btest",q1,3);
+  system("btest",q6,3);
+}
+
 proc ex2()
 {