===================================================================
RCS file: /home/cvs/OpenXM/src/kan96xx/Kan/kanExport1.c,v
retrieving revision 1.5
retrieving revision 1.10
diff -u -p -r1.5 -r1.10
--- OpenXM/src/kan96xx/Kan/kanExport1.c	2003/07/17 07:33:03	1.5
+++ OpenXM/src/kan96xx/Kan/kanExport1.c	2003/08/27 03:11:12	1.10
@@ -1,4 +1,4 @@
-/* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport1.c,v 1.4 2003/07/13 07:53:17 takayama Exp $ */
+/* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport1.c,v 1.9 2003/08/24 05:19:42 takayama Exp $ */
 #include <stdio.h>
 #include "datatype.h"
 #include "stackm.h"
@@ -15,6 +15,9 @@ extern int KanGBmessage;
 struct object DegreeShifto;
 int DegreeShifto_size = 0;
 int *DegreeShifto_vec = NULL;
+struct object DegreeShiftD;
+int DegreeShiftD_size = 0;
+int *DegreeShiftD_vec = NULL;
 
 /** :kan, :ring */
 struct object Kreduction(f,set)
@@ -43,6 +46,7 @@ struct object Kreduction(f,set)
   }else{
     r = (*reduction)(f.lc.poly,grG,1,&syz);
   }
+  /* outputGradedPolySet(grG,0); */
   if (flag) {
     rob = newObjectArray(3);
     putoa(rob,0,KpoPOLY(r));
@@ -270,6 +274,7 @@ struct object Kgroebner(ob)
       fflush(stdout);
     }
     mp = getSyzygy(grG,grP->next,&grBases,&backwardMat);
+	if (mp == NULL) errorKan1("%s\n","Internal error in getSyzygy(). BUG of sm1.");
     if (KanGBmessage) printf("Done.\n");
 
     putoa(rob,0,gradedPolySetToArray(grG,0));
@@ -500,7 +505,7 @@ struct object syzPolyToArray(size,f,grG)
 
   while (f != POLYNULL) {
     g0 = srGrade(f);
-    i0 = srIndex(f);
+    i0 = srIndex(f);  
     serial = grG->polys[g0]->serial[i0];
     if (serial < 0) {
       errorKan1("%s\n","syzPolyToArray(): invalid serial[i] of grG.");
@@ -770,6 +775,15 @@ struct object homogenizeObject_vec(ob,gradep)
   }
 }
 
+void KresetDegreeShift() {
+  DegreeShifto = NullObject;
+  DegreeShifto_vec = (int *)NULL;
+  DegreeShifto_size = 0;
+  DegreeShiftD = NullObject;
+  DegreeShiftD_vec = (int *)NULL;
+  DegreeShiftD_size = 0;
+}
+
 struct object homogenizeObject_go(struct object ob,int *gradep) {
   int size,i,dssize,j;
   struct object ob0;
@@ -780,7 +794,27 @@ struct object homogenizeObject_go(struct object ob,int
   struct object ob1t;
   int *ds;
   POLY f;
+  int onlyS; 
+
+  onlyS = 0;  /* default value */
   rob = NullObject;
+  /*printf("[%d,%d]\n",DegreeShiftD_size,DegreeShifto_size);*/
+  if (DegreeShifto_size == 0) DegreeShifto = NullObject;
+  if (DegreeShiftD_size == 0) DegreeShiftD = NullObject;
+  /*
+      DegreeShiftD : Degree shift vector for (0,1)-h-homogenization,
+                     which is {\vec n} in G-O paper.
+                     It is used in dGrade1()  redm.c
+      DegreeShifto : Degree shift vector for (u,v)-s-homogenization
+                     which is used only in ecart division and (u,v) is
+                     usually (-1,1).
+                     This shift vector is written {\vec v} in G-O paper.
+                     It may differ from the degree shift for the ring,
+                     which is used to get (minimal) Schreyer resolution.
+                     This shift vector is denoted by {\vec m} in G-O paper.  
+                     It is often used as an argument for uvGrade1 and
+                     goHomogenize*
+   */
   if (ob.tag != Sarray) errorKan1("%s\n","homogenizeObject_go(): Invalid argument data type.");
 
   size = getoaSize(ob);
@@ -791,47 +825,76 @@ struct object homogenizeObject_go(struct object ob,int
   }
   if (strcmp(KopString(ob0),"degreeShift") == 0) {
     if (size < 2)
-      errorKan1("%s\n","homogenizeObject_go(): [(degreeShift) shift-vector obj] or [(degreeShift) shift-vector] or [(degreeShift) (value)] homogenize");
+      errorKan1("%s\n","homogenizeObject_go(): [(degreeShift) shift-vector obj] or [(degreeShift) shift-vector] or [(degreeShift) (value)] homogenize.\nshift-vector=(0,1)-shift vector or [(0,1)-shift vector, (u,v)-shift vector].");
     ob1 = getoa(ob,1);
 	if (ob1.tag != Sarray) {
-	  if (DegreeShifto_size != 0) {
-		return DegreeShifto;
-	  }else{
-        rob = NullObject;
-        return rob;
+	  if ((ob1.tag == Sdollar) && (strcmp(KopString(ob1),"value")==0)) {
+        /* Reporting the value. It is done below. */
+	  }else if ((ob1.tag == Sdollar) && (strcmp(KopString(ob1),"reset")==0)) {
+		KresetDegreeShift();
 	  }
+	  rob = newObjectArray(2);
+	  putoa(rob,0,DegreeShiftD);
+	  putoa(rob,1,DegreeShifto);
+	  return rob;
 	}
-    dssize = getoaSize(ob1);
-    ds = (int *)sGC_malloc(sizeof(int)*(dssize>0?dssize:1));
-    for (i=0; i<dssize; i++) {
-      ds[i] = objToInteger(getoa(ob1,i));
-    }
-    if (size == 2) {
-      DegreeShifto = ob1;
+
+	if (getoaSize(ob1) == 2) {
+	  /* [(degreeShift) [ [1 2]   [3 4] ]  ...] homogenize */
+      /*                  (0,1)-h (u,v)-s                  */
+	  DegreeShiftD = getoa(ob1,0);
+	  dssize = getoaSize(DegreeShiftD);
+	  ds = (int *)sGC_malloc(sizeof(int)*(dssize>0?dssize:1));
+	  if (ds == NULL) errorKan1("%s\n","no more memory.");
+	  for (i=0; i<dssize; i++) {
+		ds[i] = objToInteger(getoa(DegreeShiftD,i));
+	  }
+      DegreeShiftD_size = dssize;
+	  DegreeShiftD_vec = ds;
+
+	  DegreeShifto = getoa(ob1,1);
+	  dssize = getoaSize(DegreeShifto);
+	  ds = (int *)sGC_malloc(sizeof(int)*(dssize>0?dssize:1));
+	  if (ds == NULL) errorKan1("%s\n","no more memory.");
+	  for (i=0; i<dssize; i++) {
+		ds[i] = objToInteger(getoa(DegreeShifto,i));
+	  }
       DegreeShifto_size = dssize;
-      DegreeShifto_vec = ds;
-      rob = ob1;
+	  DegreeShifto_vec = ds;
+	}else if (getoaSize(ob1) == 1) {
+	  /* Set only  for (0,1)-h */
+	  DegreeShiftD = getoa(ob1,0);
+	  dssize = getoaSize(DegreeShiftD);
+	  ds = (int *)sGC_malloc(sizeof(int)*(dssize>0?dssize:1));
+	  if (ds == NULL) errorKan1("%s\n","no more memory.");
+	  for (i=0; i<dssize; i++) {
+		ds[i] = objToInteger(getoa(DegreeShiftD,i));
+	  }
+      DegreeShiftD_size = dssize;
+	  DegreeShiftD_vec = ds;
+	}
+
+	ds = DegreeShifto_vec;
+	dssize = DegreeShifto_size;
+
+    if (size == 2) {
+	  rob = newObjectArray(2);
+	  putoa(rob,0,DegreeShiftD);
+	  putoa(rob,1,DegreeShifto);
+	  return rob;
     }else{
       ob2 = getoa(ob,2);
       if (ob2.tag == Spoly) {
-        f = goHomogenize11(KopPOLY(ob2),ds,dssize,-1,0);
+        f = goHomogenize11(KopPOLY(ob2),ds,dssize,-1,onlyS);
         rob = KpoPOLY(f);
       }else if (ob2.tag == SuniversalNumber) {
         rob = ob2;
       }else if (ob2.tag == Sarray) {
-        rob = newObjectArray(getoaSize(ob2));
-        for (i=0; i<getoaSize(ob2); i++) {
-          tob = newObjectArray(3);
-          ob1t = newObjectArray(dssize);
-          if (getoa(ob2,i).tag == Spoly) {
-            for (j=0; j<dssize; j++) getoa(ob1t,j) = KpoInteger(0);
-            for (j=0; j<dssize-i; j++) getoa(ob1t,j) = getoa(ob1,j+i);
-          }else{
-            ob1t = ob1;
-          }
-          getoa(tob,0) = ob0; getoa(tob,1) = ob1t; getoa(tob,2) = getoa(ob2,i);
-          getoa(rob,i) = homogenizeObject_go(tob,gradep);
-        }
+		int mm;
+		mm = getoaSize(ob2);
+		f = objArrayToPOLY(ob2);
+        f = goHomogenize11(f,ds,dssize,-1,onlyS);
+        rob = POLYtoObjArray(f,mm);
       }else{
         errorKan1("%s\n","homogenizeObject_go(): invalid object for the third element.");
       }
@@ -923,26 +986,240 @@ struct object oInitW(ob,oWeight)
   int w[2*N0];
   int n,i;
   struct object ow;
+  int shiftvec;
+  struct object oShift;
+  int *s;
+  int ssize,m;
 
+  shiftvec = 0;
+  s = NULL;
+  
   if (oWeight.tag != Sarray) {
     errorKan1("%s\n","oInitW(): the second argument must be array.");
   }
   n = getoaSize(oWeight);
+  if (n == 0) {
+	m = getoaSize(ob);
+	f = objArrayToPOLY(ob);
+	f = head(f);
+    return POLYtoObjArray(f,m);
+  }
+  if (getoa(oWeight,0).tag == Sarray) {
+	if (n != 2) errorKan1("%s\n","oInitW(): the size of the second argument should be 2.");
+	shiftvec = 1;
+	oShift = getoa(oWeight,1);
+	oWeight = getoa(oWeight,0);
+	if (oWeight.tag != Sarray) {
+	  errorKan1("%s\n","oInitW(): the weight vector must be array.");
+	}
+	n = getoaSize(oWeight);
+	if (oShift.tag != Sarray) {
+	  errorKan1("%s\n","oInitW(): the shift vector must be array.");
+	}
+  }
+  /* oWeight = Ksm1WeightExpressionToVec(oWeight); */
   if (n >= 2*N0) errorKan1("%s\n","oInitW(): the size of the second argument is invalid.");
   for (i=0; i<n; i++) {
     ow = getoa(oWeight,i);
+	if (ow.tag == SuniversalNumber) {
+	  ow = KpoInteger(coeffToInt(ow.lc.universalNumber));
+	}
     if (ow.tag != Sinteger) {
       errorKan1("%s\n","oInitW(): the entries of the second argument must be integers.");
     }
     w[i] = KopInteger(ow);
   }
+  if (shiftvec) {
+    ssize = getoaSize(oShift);
+	s = (int *)sGC_malloc(sizeof(int)*(ssize+1));
+	if (s == NULL) errorKan1("%s\n","oInitW() no more memory.");
+	for (i=0; i<ssize; i++) {
+	  ow = getoa(oShift,i);
+	  if (ow.tag == SuniversalNumber) {
+		ow = KpoInteger(coeffToInt(ow.lc.universalNumber));
+	  }
+	  if (ow.tag != Sinteger) {
+		errorKan1("%s\n","oInitW(): the entries of shift vector must be integers.");
+	  }
+	  s[i] = KopInteger(ow);
+	}
+  }
+
   switch(ob.tag) {
   case Spoly:
     f = KopPOLY(ob);
-    return( KpoPOLY(POLYToInitW(f,w)));
+	if (shiftvec) {
+	  return( KpoPOLY(POLYToInitWS(f,w,s)));
+	}else{
+	  return( KpoPOLY(POLYToInitW(f,w)));
+	}
     break;
+  case Sarray:
+	m = getoaSize(ob);
+	f = objArrayToPOLY(ob);
+    /* printf("1.%s\n",POLYToString(f,'*',1)); */
+	if (shiftvec) {
+	  f =  POLYToInitWS(f,w,s);
+	}else{
+	  f =  POLYToInitW(f,w);
+	}
+    /* printf("2.%s\n",POLYToString(f,'*',1)); */
+
+	return POLYtoObjArray(f,m);
   default:
-    errorKan1("%s\n","oInitW(): Argument must be polynomial.");
+    errorKan1("%s\n","oInitW(): Argument must be polynomial or a vector of polynomials");
+    break;
+  }
+}
+
+POLY objArrayToPOLY(struct object ob) {
+  int m;
+  POLY f;
+  POLY t;
+  int i,n;
+  struct ring *ringp;
+  if (ob.tag != Sarray) errorKan1("%s\n", "objArrayToPOLY() the argument must be an array.");
+  m = getoaSize(ob);
+  ringp = NULL;
+  f = POLYNULL;
+  for (i=0; i<m; i++) {
+    if (getoa(ob,i).tag != Spoly) errorKan1("%s\n","objArrayToPOLY() elements must be a polynomial.");
+    t = KopPOLY(getoa(ob,i));
+    if (t ISZERO) {
+    }else{
+      if (ringp == NULL) {
+        ringp = t->m->ringp;
+        n = ringp->n;
+		if (n - ringp->nn <= 0) errorKan1("%s\n","Graduation variable in D is not given.");
+      }
+      t = (*mpMult)(cxx(1,n-1,i,ringp),t);
+      f = ppAddv(f,t);
+    }
+  }
+  return f;
+}
+
+struct object POLYtoObjArray(POLY f,int size) {
+  struct object rob;
+  POLY *pa;
+  int d,n,i;
+  POLY t;
+  if (size < 0) errorKan1("%s\n","POLYtoObjArray() invalid size.");
+  rob = newObjectArray(size);
+  pa = (POLY *) sGC_malloc(sizeof(POLY)*(size+1));
+  if (pa == NULL) errorKan1("%s\n","POLYtoObjArray() no more memory.");
+  for (i=0; i<size; i++) {
+    pa[i] = POLYNULL;
+    putoa(rob,i,KpoPOLY(pa[i]));
+  }
+  if (f == POLYNULL) {
+    return rob;
+  }
+  n = f->m->ringp->n;
+  while (f != POLYNULL) {
+    d = f->m->e[n-1].x;
+    if (d >= size) errorKan1("%s\n","POLYtoObjArray() size is too small.");
+    t = newCell(coeffCopy(f->coeffp),monomialCopy(f->m));
+	i = t->m->e[n-1].x;
+    t->m->e[n-1].x = 0;
+    pa[i] = ppAddv(pa[i],t); /* slow to add from the top. */
+    f = f->next;
+  }
+  for (i=0; i<size; i++) {
+    putoa(rob,i,KpoPOLY(pa[i]));
+  }
+  return rob;
+}
+
+struct object KordWsAll(ob,oWeight)
+     struct object ob;
+     struct object oWeight;
+{
+  POLY f;
+  struct object rob;
+  int w[2*N0];
+  int n,i;
+  struct object ow;
+  int shiftvec;
+  struct object oShift;
+  int *s;
+  int ssize,m;
+
+  shiftvec = 0;
+  s = NULL;
+  
+  if (oWeight.tag != Sarray) {
+    errorKan1("%s\n","ordWsAll(): the second argument must be array.");
+  }
+  n = getoaSize(oWeight);
+  if (n == 0) {
+	m = getoaSize(ob);
+	f = objArrayToPOLY(ob);
+	f = head(f);
+    return POLYtoObjArray(f,m);
+  }
+  if (getoa(oWeight,0).tag == Sarray) {
+	if (n != 2) errorKan1("%s\n","ordWsAll(): the size of the second argument should be 2.");
+	shiftvec = 1;
+	oShift = getoa(oWeight,1);
+	oWeight = getoa(oWeight,0);
+	if (oWeight.tag != Sarray) {
+	  errorKan1("%s\n","ordWsAll(): the weight vector must be array.");
+	}
+	n = getoaSize(oWeight);
+	if (oShift.tag != Sarray) {
+	  errorKan1("%s\n","ordWsAll(): the shift vector must be array.");
+	}
+  }
+  /* oWeight = Ksm1WeightExpressionToVec(oWeight); */
+  if (n >= 2*N0) errorKan1("%s\n","ordWsAll(): the size of the second argument is invalid.");
+  for (i=0; i<n; i++) {
+    ow = getoa(oWeight,i);
+	if (ow.tag == SuniversalNumber) {
+	  ow = KpoInteger(coeffToInt(ow.lc.universalNumber));
+	}
+    if (ow.tag != Sinteger) {
+      errorKan1("%s\n","ordWsAll(): the entries of the second argument must be integers.");
+    }
+    w[i] = KopInteger(ow);
+  }
+  if (shiftvec) {
+    ssize = getoaSize(oShift);
+	s = (int *)sGC_malloc(sizeof(int)*(ssize+1));
+	if (s == NULL) errorKan1("%s\n","ordWsAll() no more memory.");
+	for (i=0; i<ssize; i++) {
+	  ow = getoa(oShift,i);
+	  if (ow.tag == SuniversalNumber) {
+		ow = KpoInteger(coeffToInt(ow.lc.universalNumber));
+	  }
+	  if (ow.tag != Sinteger) {
+		errorKan1("%s\n","ordWsAll(): the entries of shift vector must be integers.");
+	  }
+	  s[i] = KopInteger(ow);
+	}
+  }
+
+  switch(ob.tag) {
+  case Spoly:
+    f = KopPOLY(ob);
+	if (f == POLYNULL) errorKan1("%s\n","ordWsAll(): the argument is 0");
+	if (shiftvec) {
+	  return( KpoInteger(ordWsAll(f,w,s)));
+	}else{
+	  return( KpoInteger(ordWsAll(f,w,(int *) NULL)));
+	}
+    break;
+  case Sarray:
+	m = getoaSize(ob);
+	f = objArrayToPOLY(ob);
+	if (f == POLYNULL) errorKan1("%s\n","ordWsAll(): the argument is 0");
+	if (shiftvec) {
+	  return KpoInteger(ordWsAll(f,w,s));
+	}else{
+	  return KpoInteger(ordWsAll(f,w,(int *)NULL));
+	}
+  default:
+    errorKan1("%s\n","ordWsAll(): Argument must be polynomial or a vector of polynomials");
     break;
   }
 }