Changeset 4dcfc0f in git

Timestamp:

Feb 5, 2008, 11:44:30 PM (15 years ago)

Author:

Viktor Levandovskyy <levandov@…>

Branches:

(u'spielwiese', '91fdef05f09f54b8d58d92a472e9c4a43aa4656f')

Children:

a539ad11b73ebc8b93d14f33279ca7d7f3a5412c

Parents:

e671591d1d038c1f88b1a7d2d0e2ff5ad5775d32

Message:

*levandov: updates and fixes for libraries


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

Location:

Singular/LIB

Files:

• dmod.lib (modified) (4 diffs)
• dmodapp.lib (modified) (4 diffs)
• ratgb.lib (modified) (4 diffs)

Singular/LIB/dmod.lib

@@ -1 +1 @@
 //////////////////////////////////////////////////////////////////////////////
-version="$Id: dmod.lib,v 1.24 2008-01-17 21:05:31 levandov Exp $";
+version="$Id: dmod.lib,v 1.25 2008-02-05 22:44:28 levandov Exp $";
 category="Noncommutative";
 info="
@@ -2783 +2783 @@
   dbprint(ppl,"// -1-3- u,v are eliminated");
   dbprint(ppl-1, K);  // K is without u,v
-
-
   setring save;
   // ------------ new ring @R2 ------------------
@@ -3146 +3144 @@
 }
 
+// use a finer ordering
+
 proc SannfsLOT(poly F, list #)
+"USAGE:  SannfsLOT(f [,eng]);  f a poly, eng an optional int
+RETURN:  ring
+PURPOSE: compute the D-module structure of basering[1/f]*f^s, according to the Levandovskyy's modification of the algorithm by Oaku and Takayama in the ring D[s], where D is the Weyl algebra
+NOTE:    activate this ring with the @code{setring} command.
+@*       In the ring D[s], the ideal LD (which is NOT a Groebner basis) is the needed D-module structure.
+@*       If eng <>0, @code{std} is used for Groebner basis computations,
+@*       otherwise, and by default @code{slimgb} is used.
+@*       If printlevel=1, progress debug messages will be printed,
+@*       if printlevel>=2, all the debug messages will be printed.
+EXAMPLE: example SannfsLOT; shows examples
+"
+{
+  int eng = 0;
+  if ( size(#)>0 )
+  {
+    if ( typeof(#[1]) == "int" )
+    {
+      eng = int(#[1]);
+    }
+  }
+  // returns a list with a ring and an ideal LD in it
+  int ppl = printlevel-voice+2;
+  //  printf("plevel :%s, voice: %s",printlevel,voice);
+  def save = basering;
+  int N = nvars(basering);
+  //  int Nnew = 2*(N+2);
+  int Nnew = 2*(N+1)+1; //removed u,v; added s
+  int i,j;
+  string s;
+  list RL = ringlist(basering);
+  list L, Lord;
+  list tmp;
+  intvec iv;
+  L[1] = RL[1]; // char
+  L[4] = RL[4]; // char, minpoly
+  // check whether vars have admissible names
+  list Name  = RL[2];
+  list RName;
+//   RName[1] = "u";
+//   RName[2] = "v";
+  RName[1] = "t";
+  RName[2] = "Dt";
+  for(i=1;i<=N;i++)
+  {
+    for(j=1; j<=size(RName);j++)
+    {
+      if (Name[i] == RName[j])
+      {
+        ERROR("Variable names should not include t,Dt");
+      }
+    }
+  }
+  // now, create the names for new vars
+//   tmp[1]     = "u";
+//   tmp[2]     = "v";
+//   list UName = tmp;
+  list DName;
+  for(i=1;i<=N;i++)
+  {
+    DName[i] = "D"+Name[i]; // concat
+  }
+  tmp    =  0;
+  tmp[1] = "t";
+  tmp[2] = "Dt";
+  list SName ; SName[1] = "s";
+  //  list NName = tmp + Name + DName + SName;
+  list NName = tmp + SName + Name + DName;
+  L[2]   = NName;
+  tmp    = 0;
+  // Name, Dname will be used further
+  //  kill UName;
+  kill NName;
+  // block ord (a(1,1),dp);
+  tmp[1]  = "a"; // string
+  iv      = 1,1;
+  tmp[2]  = iv; //intvec
+  Lord[1] = tmp;
+  // continue with a(0,0,1)
+  tmp[1]  = "a"; // string
+  iv      = 0,0,1;
+  tmp[2]  = iv; //intvec
+  Lord[2] = tmp;
+  // continue with dp 1,1,1,1...
+  tmp[1]  = "dp"; // string
+  s       = "iv=";
+  for(i=1;i<=Nnew;i++)
+  {
+    s = s+"1,";
+  }
+  s[size(s)]= ";";
+  execute(s);
+  tmp[2]    = iv;
+  Lord[3]   = tmp;
+  tmp[1]    = "C";
+  iv        = 0;
+  tmp[2]    = iv;
+  Lord[4]   = tmp;
+  tmp       = 0;
+  L[3]      = Lord;
+  // we are done with the list
+  def @R@ = ring(L);
+  setring @R@;
+  matrix @D[Nnew][Nnew];
+  @D[1,2]=1;
+  for(i=1; i<=N; i++)
+  {
+    @D[3+i,N+3+i]=1;
+  }
+  // ADD [s,t]=-t, [s,Dt]=Dt
+  @D[1,3] = -var(1);
+  @D[2,3] = var(2);
+  //  @D[N+3,2*(N+2)]=1; old t,Dt stuff
+  //  L[5] = matrix(UpOneMatrix(Nnew));
+  //  L[6] = @D;
+  def @R = nc_algebra(1,@D);
+  setring @R;
+  kill @R@;
+  dbprint(ppl,"// -1-1- the ring @R(t,Dt,s,_x,_Dx) is ready");
+  dbprint(ppl-1, @R);
+  // create the ideal I
+  poly  F = imap(save,F);
+  //  ideal I = u*F-t,u*v-1;
+  ideal I = F-t;
+  poly p;
+  for(i=1; i<=N; i++)
+  {
+    //    p = u*Dt; // u*Dt
+    p = Dt;
+    p = diff(F,var(3+i))*p;
+    I = I, var(N+3+i) + p;
+  }
+  //  I = I, var(1)*var(2) + var(Nnew) +1; // reduce it with t-f!!!
+  // t*Dt + s +1 reduced with t-f gives f*Dt + s
+  I = I, F*var(2) + var(3);
+  // -------- the ideal I is ready ----------
+  dbprint(ppl,"// -1-2- starting the elimination of t,Dt in @R");
+  dbprint(ppl-1, I);
+  ideal J = engine(I,eng);
+  ideal K = nselect(J,1,2);
+  dbprint(ppl,"// -1-3- t,Dt are eliminated");
+  dbprint(ppl-1, K);  // K is without t, Dt
+  K = engine(K,eng);  // std does the job too
+  // now, we must change the ordering
+  // and create a ring without t, Dt
+  setring save;
+  // ----------- the ring @R3 ------------
+  // _x, _Dx,s;  elim.ord for _x,_Dx.
+  // keep: N, i,j,s, tmp, RL
+  Nnew = 2*N+1;
+  kill Lord, tmp, iv, RName;
+  list Lord, tmp;
+  intvec iv;
+  L[1] = RL[1];
+  L[4] = RL[4];  // char, minpoly
+  // check whether vars hava admissible names -> done earlier
+  // now, create the names for new var
+  tmp[1] = "s";
+  // DName is defined earlier
+  list NName = Name + DName + tmp;
+  L[2] = NName;
+  tmp = 0;
+  // block ord (dp(N),dp);
+  // string s is already defined
+  s = "iv=";
+  for (i=1; i<=Nnew-1; i++)
+  {
+    s = s+"1,";
+  }
+  s[size(s)]=";";
+  execute(s);
+  tmp[1] = "dp";  // string
+  tmp[2] = iv;   // intvec
+  Lord[1] = tmp;
+  // continue with dp 1,1,1,1...
+  tmp[1] = "dp";  // string
+  s[size(s)] = ",";
+  s = s+"1;";
+  execute(s);
+  kill s;
+  kill NName;
+  tmp[2]      = iv;
+  Lord[2]     = tmp;
+  tmp[1]      = "C";  iv  = 0;  tmp[2]=iv;
+  Lord[3]     = tmp;  tmp = 0;
+  L[3]        = Lord;
+  // we are done with the list. Now add a Plural part
+  def @R2@ = ring(L);
+  setring @R2@;
+  matrix @D[Nnew][Nnew];
+  for (i=1; i<=N; i++)
+  {
+    @D[i,N+i]=1;
+  }
+  def @R2 = nc_algebra(1,@D);
+  setring @R2;
+  kill @R2@;
+  dbprint(ppl,"//  -2-1- the ring @R2(_x,_Dx,s) is ready");
+  dbprint(ppl-1, @R2);
+  ideal MM = maxideal(1);
+  //  MM = 0,s,MM;
+  MM = 0,0,s,MM[1..size(MM)-1];
+  map R01 = @R, MM;
+  ideal K = R01(K);
+  // total cleanup
+  ideal LD = K;
+  // make leadcoeffs positive
+  for (i=1; i<= ncols(LD); i++)
+  {
+    if (leadcoef(LD[i]) <0 )
+    {
+      LD[i] = -LD[i];
+    }
+  }
+  export LD;
+  kill @R;
+  return(@R2);
+}
+example
+{
+  "EXAMPLE:"; echo = 2;
+  ring r = 0,(x,y,z),Dp;
+  poly F = x^3+y^3+z^3;
+  printlevel = 0;
+  def A  = SannfsLOT(F);
+  setring A;
+  LD;
+}
+
+
+proc SannfsLOTold(poly F, list #)
 "USAGE:  SannfsLOT(f [,eng]);  f a poly, eng an optional int
 RETURN:  ring
@@ -3364 +3594 @@
   poly F = x^3+y^3+z^3;
   printlevel = 0;
-  def A  = SannfsLOT(F);
+  def A  = SannfsLOTold(F);
   setring A;
   LD;

Singular/LIB/dmodapp.lib

@@ -1 +1 @@
 //////////////////////////////////////////////////////////////////////////////
-version="$Id: dmodapp.lib,v 1.1 2007-12-11 12:00:01 levandov Exp $";
+version="$Id: dmodapp.lib,v 1.2 2008-02-05 22:44:29 levandov Exp $";
 category="Noncommutative";
 info="
@@ -38 +38 @@
 "USAGE:  charVariety(I);  I an ideal
 RETURN:  ring
-PURPOSE: compute the D-module structure of basering[1/f]*f^s with the algorithm given in S and with the Groebner basis engine given in 'eng'
+PURPOSE: compute the characteristic variety of a D-module D/I
 ASSUME: the ground ring is the Weyl algebra with x's before d's
 NOTE:    activate the output ring with the @code{setring} command.
@@ -73 +73 @@
   }
   L[3] = NEW;
+  list ncr =ncRelations(save);
+  matrix @C = ncr[1];
+  matrix @D = ncr[2];
   def @U = ring(L);
   // 2. create the commutative ring  
@@ -85 +88 @@
   // comm ring is ready
   setring @U;
+  // make @U noncommutative
+  //  matrix @C = imap(save,@C);
+  matrix @D = imap(save,@D);
+  def @@U = nc_algebra(@C,@D);
+  setring @@U; kill @U;
   // 2. compute Groebner basis
   ideal I = imap(save,I);
   //  I = groebner(I);
-  I = slimgb(I);
+  I = slimgb(I); // a bug?
   setring @CU;
-  ideal CV = imap(@U,I);
+  ideal CV = imap(@@U,I);
   //  CV = groebner(CV); // cosmetics
   CV = slimgb(CV);

Singular/LIB/ratgb.lib

@@ -1 +1 @@
 //////////////////////////////////////////////////////////////////////////////
-version="$Id: ratgb.lib,v 1.9 2008-01-17 21:05:04 levandov Exp $";
+version="$Id: ratgb.lib,v 1.10 2008-02-05 22:44:30 levandov Exp $";
 category="Noncommutative";
 info="
@@ -14 +14 @@
 LIB "poly.lib";
 
-static proc rm_content_id(ideal J)
+//static 
+proc rm_content_id(ideal J)
 "USAGE:  rm_content_id(I);  I an ideal
 RETURN:  ideal
@@ -170 +171 @@
   ideal CG = imap(save,G);
   CG = rm_content_id(CG);
-  CG = simplify(CG,2+32);
+  CG = simplify(CG,2);
+
+  // warning: a bugfarm! in this ring, the ordering might change!!! (see appelF4)
+  // so, simplify(32) should take place in the orig. ring! and NOT here
+  //  CG = simplify(CG,2+32);
 
   // 4b. create L(G) with X's as coeffs (for minimization)
-  int sG  = ncols(CG);
+  setring save;
+  G = imap(@RAT,CG);
+  int sG  = ncols(G);
   ideal LG;
   for (i=1; i<= sG; i++)
   {
-    LG[i] = lead(CG[i]);
-  }
-
-//   ideal SLG = simplify(LG,8+32); //contains zeros
-//   intvec islg;
-//   if (SLG[1] == 0)
-//   {  islg = 0;  }
-//   else
-//   {    islg = 1;  }
-//   for (i=2; i<= ncols(SLG); i++)
-//   {
-//     if (SLG[i] == 0)
-//     {
-//       islg = islg, 0;
-//     }
-//     else
-//     {
-//       islg = islg, 1;
-//     }
-//   }
-
-  // compute the D-dimension of the ideal
-
-  LG = groebner(LG); // cosmetics
-  int d = dim(LG);
+    LG[i] = lead(G[i]);
+  }
+  // compute the D-dimension of the ideal in the ring @RAT
+  setring @RAT;
+  ideal LG = imap(save,LG);
+  ideal LGG = groebner(LG); // cosmetics
+  int d = dim(LGG);
   int Ddim = d;
   printf("the D-dimension is %s",d);
   if (d==0)
   {
-    d = vdim(LG);
+    d = vdim(LGG);
     int Dvdim = d;
     printf("the K-dimension is %s",d);
   }
-  setring save;
-//   for (i=1; i<= ncols(LG); i++)
-//   {
-//     if (islg[i] == 0)
-//     {
-//       G[i] = 0;
-//     }
-//   }
-//   G = simplify(G,2); // ready!
-
-  G = imap(@RAT,CG);
+  ideal SLG = simplify(LG,8+32); //contains zeros
+  setring save;
+  ideal SLG = imap(@RAT,SLG);
+  // simplify(LG,8+32); //contains zeros
+  intvec islg;
+  if (SLG[1] == 0)
+  {  islg = 0;  }
+  else
+  {    islg = 1;  }
+  for (i=2; i<= ncols(SLG); i++)
+  {
+    if (SLG[i] == 0)
+    {
+      islg = islg, 0;
+    }
+    else
+    {
+      islg = islg, 1;
+    }
+  }
+  for (i=1; i<= ncols(LG); i++)
+  {
+    if (islg[i] == 0)
+    {
+      G[i] = 0;
+    }
+  }
+  G = simplify(G,2); // ready!
+  //  G = imap(@RAT,CG);
   // return the result
   ideal pGBid = G;
@@ -227 +234 @@
   //  export Dvdim;
   setring @RAT;
-  ideal rGBid = CG;
-  //imap(save,G);
+  ideal rGBid = imap(save,G);
+  // CG;
   export rGBid;
   setring save;