===================================================================
RCS file: /home/cvs/OpenXM/src/k097/lib/minimal/minimal.k,v
retrieving revision 1.1
retrieving revision 1.5
diff -u -p -r1.1 -r1.5
--- OpenXM/src/k097/lib/minimal/minimal.k	2000/05/03 06:42:07	1.1
+++ OpenXM/src/k097/lib/minimal/minimal.k	2000/05/05 08:13:49	1.5
@@ -1,6 +1,10 @@
-/* $OpenXM$ */
+/* $OpenXM: OpenXM/src/k097/lib/minimal/minimal.k,v 1.4 2000/05/04 11:05:20 takayama Exp $ */
 #define DEBUG 1 
 /* #define ORDINARY 1 */
+/* If you run this program on openxm version 1.1.2 (FreeBSD),
+   make a symbolic link by the command
+   ln -s /usr/bin/cpp /lib/cpp
+*/
 /* Test sequences. 
    Use load["minimal.k"];;
 
@@ -333,6 +337,7 @@ def test_SinitOfArray() {
 /* f is assumed to be a monomial with toes. */
 def Sdegree(f,tower,level) {
   local i;
+  f = Init(f);
   if (level <= 1) return(StotalDegree(f));
   i = Degree(f,es);
   return(StotalDegree(f)+Sdegree(tower[level-2,i],tower,level-1));
@@ -367,6 +372,15 @@ def SnewArrayOfFormat(p) {
      return(null);
   }
 }
+def ScopyArray(a) {
+  local n, i,ans;
+  n = Length(a);
+  ans = NewArray(n);
+  for (i=0; i<n; i++) {
+    ans[i] = a[i];
+  }
+  return(ans);
+}
 def SminOfStrategy(a) {
   local n,i,ans,tt;
   ans = 100000; /* very big number */
@@ -409,7 +423,8 @@ def SlaScala(g) {
   local rf, tower, reductionTable, skel, redundantTable, bases,
         strategy, maxOfStrategy, height, level, n, i,
         freeRes,place, f, reducer,pos, redundant_seq,bettiTable,freeResV,ww,
-        redundantTable_ordinary, redundant_seq_ordinary;
+        redundantTable_ordinary, redundant_seq_ordinary,
+        reductionTable_tmp;
   /* extern WeightOfSweyl; */
   ww = WeightOfSweyl;
   Print("WeghtOfSweyl="); Println(WeightOfSweyl);
@@ -430,7 +445,12 @@ def SlaScala(g) {
   while (strategy <= maxOfStrategy) {
     for (level = 0; level < height; level++) {
       n = Length(reductionTable[level]);
-      for (i=0; i<n; i++) {
+      reductionTable_tmp = ScopyArray(reductionTable[level]); 
+      while (SthereIs(reductionTable_tmp,strategy)) {
+        i = SnextI(reductionTable_tmp,strategy,redundantTable,
+                   skel,level,freeRes);
+        Println([level,i]);
+        reductionTable_tmp[i] = -200000;
         if (reductionTable[level,i] == strategy) {
            Print("Processing "); Print([level,i]);
            Print("   Strategy = "); Println(strategy);
@@ -503,6 +523,51 @@ def SlaScala(g) {
   return([freeResV, redundantTable,reducer,bettiTable,redundantTable_ordinary]);
 }
 
+def SthereIs(reductionTable_tmp,strategy) {
+  local n,i;
+  n = Length(reductionTable_tmp);
+  for (i=0; i<n; i++) {
+    if (reductionTable_tmp[i] == strategy) {
+      return(true);
+    }
+  }
+  return(false);
+}
+
+def SnextI(reductionTable_tmp,strategy,redundantTable,
+                                  skel,level,freeRes)
+{
+   local ii,n,p,myindex,i,j,bases;
+   n = Length(reductionTable_tmp);
+   if (level == 0) {
+     for (ii=0; ii<n; ii++) {
+       if (reductionTable_tmp[ii] == strategy) {
+          return(ii);
+        }
+      }
+   }else{
+     for (ii=0; ii<n; ii++) {
+       if (reductionTable_tmp[ii] == strategy) {
+         p = skel[level,ii];
+         myindex = p[0];
+         i = myindex[0]; j = myindex[1];
+         bases = freeRes[level-1];
+         if (IsNull(bases[i]) || IsNull(bases[j])) {
+            
+         }else{
+           return(ii);
+         }
+       }
+     }
+   }
+   Print("reductionTable_tmp=");
+   Println(reductionTable_tmp);
+   Println("See also reductionTable, strategy, level,i");
+   Error("SnextI: bases[i] or bases[j] is null for all combinations.");
+}
+
+
+
 def SsetBettiTable(freeRes,g) {
   local level,i, n,bases,ans;
   ans = NewArray(Length(freeRes)+1);
@@ -638,7 +703,9 @@ def SpairAndReduction(skel,level,ii,freeRes,tower,ww) 
 
   Print("result is "); Println(tmp);
 
-  vdeg = SvDegree(si*gi+sj*gj,tower,level-1,ww);
+  /* This is essential part for V-minimal resolution. */
+  /* vdeg = SvDegree(si*gi+sj*gj,tower,level-1,ww); */
+  vdeg = SvDegree(si*gi,tower,level-1,ww); 
   vdeg_reduced = SvDegree(tmp[0],tower,level-1,ww);  
   Print("vdegree of the original = "); Println(vdeg);
   Print("vdegree of the remainder = "); Println(vdeg_reduced);
@@ -823,8 +890,9 @@ def Sminimal(g) {
     }
    }
    return([Stetris(minRes,redundantTable),
-          [ minRes, redundantTable, reducer,r[3],r[4]]]);
+          [ minRes, redundantTable, reducer,r[3],r[4]],r[0]]);
   /* r[4] is the redundantTable_ordinary */
+  /* r[0] is the freeResolution */
 }  
 
 
@@ -933,6 +1001,7 @@ In(20)=SvDegree(x,tt,2,ww):
 def SvDegree(f,tower,level,w) {
   local i,ans;
   if (IsZero(f)) return(null);
+  f = Init(f);
   if (level <= 0) {
     return(Sord_w(f,w));
   }
@@ -942,3 +1011,222 @@ def SvDegree(f,tower,level,w) {
   return(ans);
 }
 
+def Sannfs(f,v) {
+  local f2;
+  f2 = ToString(f);
+  if (IsArray(v)) {
+     v = Map(v,"ToString");
+  }
+  sm1(" [f2 v] annfs /FunctionValue set ");
+}
+
+/* Sannfs2("x^3-y^2"); */
+def Sannfs2(f) {
+  local p,pp;
+  p = Sannfs(f,"x,y");
+/*
+  Sweyl("x,y",[["x",1,"y",1,"Dx",1,"Dy",1,"h",1],
+               ["x",-1,"y",-1,"Dx",1,"Dy",1]]); */
+  Sweyl("x,y",[["x",-1,"y",-1,"Dx",1,"Dy",1]]);
+  pp = Map(p[0],"Spoly");
+  return(Sminimal(pp));
+}
+
+def Sannfs3(f) {
+  local p,pp;
+  p = Sannfs(f,"x,y,z");
+  Sweyl("x,y,z",[["x",-1,"y",-1,"z",-1,"Dx",1,"Dy",1,"Dz",1]]);
+  pp = Map(p[0],"Spoly");
+  return(Sminimal(pp));
+}
+
+/*
+  The betti numbers of most examples are 2,1. (0-th and 1-th).
+  a=Sannfs2("x*y*(x+y-1)"); ==> The betti numbers are 3, 2. 
+  a=Sannfs2("x^3-y^2-x");    : it causes an error. It should be fixed.
+  a=Sannfs2("x*y*(x-y)");    : it causes an error. It should be fixed.
+
+*/
+     
+
+
+/*  The below is under construction. */
+def Sschreyer(g) {
+  local rf, tower, reductionTable, skel, redundantTable, bases,
+        strategy, maxOfStrategy, height, level, n, i,
+        freeRes,place, f, reducer,pos, redundant_seq,bettiTable,freeResV,ww,
+        redundantTable_ordinary, redundant_seq_ordinary,
+        reductionTable_tmp,c2,ii,nn;
+  /* extern WeightOfSweyl; */
+  ww = WeightOfSweyl;
+  Print("WeghtOfSweyl="); Println(WeightOfSweyl);
+  rf = SresolutionFrameWithTower(g);
+  redundant_seq = 1;   redundant_seq_ordinary = 1;
+  tower = rf[1];
+  reductionTable = SgenerateTable(tower);
+  skel = rf[2];
+  redundantTable = SnewArrayOfFormat(rf[1]);
+  redundantTable_ordinary = SnewArrayOfFormat(rf[1]);
+  reducer = SnewArrayOfFormat(rf[1]);
+  freeRes = SnewArrayOfFormat(rf[1]);
+  bettiTable = SsetBettiTable(rf[1],g);
+
+  height = Length(reductionTable);
+  for (level = 0; level < height; level++) {
+      n = Length(reductionTable[level]);
+      for (i=0; i<n; i++) {
+           Println([level,i]);
+           Print("Processing "); Print([level,i]);
+           if (level == 0) {
+             if (IsNull(redundantTable[level,i])) {
+               bases = freeRes[level];
+               /* Println(["At floor : GB=",i,bases,tower[0,i]]); */
+               pos = SwhereInGB(tower[0,i],rf[3,0]);
+               bases[i] = rf[3,0,pos];
+               /* redundantTable[level,i] = 0;
+               redundantTable_ordinary[level,i] = 0; */
+               freeRes[level] = bases;
+               /* Println(["GB=",i,bases,tower[0,i]]); */
+             }
+           }else{ /* level >= 1 */
+             if (IsNull(redundantTable[level,i])) {
+               bases = freeRes[level];
+               f = SpairAndReduction2(skel,level,i,freeRes,tower,
+                                      ww,redundantTable);
+               if (f[0] != Poly("0")) {
+                  place = f[3];
+                  /* (level-1, place) is the place for f[0], 
+                     which is a newly obtained  GB. */
+#ifdef ORDINARY
+                  redundantTable[level-1,place] = redundant_seq;
+                  redundant_seq++;
+#else
+                  if (f[4] > f[5]) {
+                    /* Zero in the gr-module */
+                    Print("v-degree of [org,remainder] = ");
+                    Println([f[4],f[5]]);
+                    Print("[level,i] = "); Println([level,i]);
+                    redundantTable[level-1,place] = 0;
+                  }else{
+                    redundantTable[level-1,place] = redundant_seq;
+                    redundant_seq++;
+                  }
+#endif
+                  redundantTable_ordinary[level-1,place]
+                     =redundant_seq_ordinary;
+                  redundant_seq_ordinary++;
+                  bases[i] = SunitOfFormat(place,f[1])-f[1];  /* syzygy */
+                  /* redundantTable[level,i] = 0;
+                  redundantTable_ordinary[level,i] = 0; */
+                  /* i must be equal to f[2], I think. Double check. */
+
+                  /* Correction Of Constant */
+                  c2 = f[6];
+                  nn = Length(bases);
+                  for (ii=0; ii<nn;ii++) {
+                     if (ii != place) {
+                       bases[ii] = bases[ii]*c2;
+                     }
+                  }
+
+                  freeRes[level] = bases;
+                  /* bases = freeRes[level-1];
+                     bases[place] = f[0];
+                     freeRes[level-1] = bases;  It is already set. */
+                  reducer[level-1,place] = f[1];
+               }else{
+                  /* redundantTable[level,i] = 0; */
+                  bases = freeRes[level];
+                  bases[i] = f[1];  /* Put the syzygy. */
+                  freeRes[level] = bases;
+               }
+             }  /* end of level >= 1 */
+          }
+    } /* i loop */
+  } /* level loop */
+  n = Length(freeRes);
+  freeResV = SnewArrayOfFormat(freeRes);
+  for (i=0; i<n; i++) {
+    bases = freeRes[i];
+    bases = Sbases_to_vec(bases,bettiTable[i]);
+    freeResV[i] = bases;
+  }
+  return([freeResV, redundantTable,reducer,bettiTable,redundantTable_ordinary]);
+}
+
+def SpairAndReduction2(skel,level,ii,freeRes,tower,ww,redundantTable) {
+  local i, j, myindex, p, bases, tower2, gi, gj,
+       si, sj, tmp, t_syz, pos, ans, ssp, syzHead,pos2,
+       vdeg,vdeg_reduced,n,c2;
+  Println("SpairAndReduction2:");
+
+  if (level < 1) Error("level should be >= 1 in SpairAndReduction.");
+  p = skel[level,ii];
+  myindex = p[0];  
+  i = myindex[0]; j = myindex[1];
+  bases = freeRes[level-1];
+  Println(["p and bases ",p,bases]);
+  if (IsNull(bases[i]) || IsNull(bases[j])) {
+    Println([level,i,j,bases[i],bases[j]]);
+    Error("level, i, j : bases[i], bases[j]  must not be NULL.");
+  }
+
+  tower2 = StowerOf(tower,level-1);
+  SsetTower(tower2);  
+  /** sm1(" show_ring ");   */
+
+  gi = Stoes_vec(bases[i]);
+  gj = Stoes_vec(bases[j]);
+
+  ssp = Sspolynomial(gi,gj); 
+  si = ssp[0,0];  
+  sj = ssp[0,1];
+  syzHead = si*es^i;
+  /* This will be the head term, I think. But, double check. */
+  Println([si*es^i,sj*es^j]);
+
+  Print("[gi, gj] = "); Println([gi,gj]);
+  sm1(" [(Homogenize)] system_variable message ");
+  Print("Reduce the element "); Println(si*gi+sj*gj);
+  Print("by  "); Println(bases);
+
+  tmp = Sreduction(si*gi+sj*gj, bases);
+
+  Print("result is "); Println(tmp);
+  t_syz = tmp[2];
+  si = si*tmp[1]+t_syz[i];
+  sj = sj*tmp[1]+t_syz[j];
+  t_syz[i] = si; 
+  t_syz[j] = sj;
+
+  c2 = null;
+  /* tmp[0] must be zero */
+  n = Length(t_syz);
+  for (i=0; i<n; i++) {
+     if (IsConstant(t_syz[i])) {
+       if (IsNull(redundantTable[level-1,i])) {
+         /* i must equal to pos2 below. */
+         c2 = -t_syz[i];
+         tmp[0] = freeRes[level-1,i];
+         t_syz[i] = 0;
+         /* break; does not work. Use */
+         i = n;
+       }
+     }
+  }
+
+  /* This is essential part for V-minimal resolution. */
+  /* vdeg = SvDegree(si*gi+sj*gj,tower,level-1,ww); */
+  vdeg = SvDegree(si*gi,tower,level-1,ww); 
+  vdeg_reduced = SvDegree(tmp[0],tower,level-1,ww);  
+  Print("vdegree of the original = "); Println(vdeg);
+  Print("vdegree of the remainder = "); Println(vdeg_reduced);
+
+  pos = SwhereInTower(syzHead,tower[level]);
+  pos2 = SwhereInTower(tmp[0],tower[level-1]);
+  ans = [tmp[0],t_syz,pos,pos2,vdeg,vdeg_reduced,c2];
+  /* pos is the place to put syzygy at level. */
+  /* pos2 is the place to put a new GB at level-1. */   
+  Println(ans);
+  return(ans);
+}