[BACK]Return to kanExport1.c CVS log [TXT][DIR] Up to [local] / OpenXM / src / kan96xx / Kan

Diff for /OpenXM/src/kan96xx/Kan/kanExport1.c between version 1.3 and 1.20

version 1.3, 2003/07/10 08:20:04 version 1.20, 2005/06/16 08:40:04
Line 1 
Line 1 
   /* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport1.c,v 1.19 2005/06/16 06:54:55 takayama Exp $ */
 #include <stdio.h>  #include <stdio.h>
 #include "datatype.h"  #include "datatype.h"
 #include "stackm.h"  #include "stackm.h"
Line 11 
Line 12 
 static int Message = 1;  static int Message = 1;
 extern int KanGBmessage;  extern int KanGBmessage;
   
   struct object DegreeShifto = OINIT;
   int DegreeShifto_size = 0;
   int *DegreeShifto_vec = NULL;
   struct object DegreeShiftD = OINIT;
   int DegreeShiftD_size = 0;
   int *DegreeShiftD_vec = NULL;
   
 /** :kan, :ring */  /** :kan, :ring */
 struct object Kreduction(f,set)  struct object Kreduction(f,set)
      struct object f;       struct object f;
Line 19  struct object Kreduction(f,set)
Line 27  struct object Kreduction(f,set)
   POLY r;    POLY r;
   struct gradedPolySet *grG;    struct gradedPolySet *grG;
   struct syz0 syz;    struct syz0 syz;
   struct object rob;    struct object rob = OINIT;
   int flag;    int flag;
   extern int ReduceLowerTerms;    extern int ReduceLowerTerms;
   
Line 38  struct object Kreduction(f,set)
Line 46  struct object Kreduction(f,set)
   }else{    }else{
     r = (*reduction)(f.lc.poly,grG,1,&syz);      r = (*reduction)(f.lc.poly,grG,1,&syz);
   }    }
     /* outputGradedPolySet(grG,0); */
   if (flag) {    if (flag) {
     rob = newObjectArray(3);      rob = newObjectArray(3);
     putoa(rob,0,KpoPOLY(r));      putoa(rob,0,KpoPOLY(r));
Line 61  struct object Kgroebner(ob)
Line 70  struct object Kgroebner(ob)
   int needInput = 0;    int needInput = 0;
   int countDown = 0;    int countDown = 0;
   int cdflag = 0;    int cdflag = 0;
   struct object ob1,ob2,ob2c;    struct object ob1 = OINIT;
     struct object ob2 = OINIT;
     struct object ob2c = OINIT;
   int i;    int i;
   struct gradedPolySet *grG;    struct gradedPolySet *grG;
   struct pair *grP;    struct pair *grP;
   struct arrayOfPOLY *a;    struct arrayOfPOLY *a;
   struct object rob;    struct object rob = OINIT;
   struct gradedPolySet *grBases;    struct gradedPolySet *grBases;
   struct matrixOfPOLY *mp;    struct matrixOfPOLY *mp;
   struct matrixOfPOLY *backwardMat;    struct matrixOfPOLY *backwardMat;
   struct object ob1New;    struct object ob1New = OINIT;
   extern char *F_groebner;    extern char *F_groebner;
   extern int CheckHomogenization;    extern int CheckHomogenization;
   extern int StopDegree;    extern int StopDegree;
   int sdflag = 0;    int sdflag = 0;
   int forceReduction = 0;    int forceReduction = 0;
     int reduceOnly = 0;
     int gbCheck = 0;  /* see @s/2005/06/16-note.pdf */
   
   int ob1Size, ob2Size, noZeroEntry;    int ob1Size, ob2Size, noZeroEntry;
   int *ob1ToOb2;    int *ob1ToOb2;
   int *ob1ZeroPos;    int *ob1ZeroPos;
   int method;    int method;
   int j,k;    int j,k;
   struct object rob2;    struct object rob2 = OINIT;
   struct object rob3;    struct object rob3 = OINIT;
   struct object rob4;    struct object rob4 = OINIT;
   struct ring *myring;    struct ring *myring;
   POLY f;    POLY f;
   struct object orgB;    struct object orgB = OINIT;
   struct object newB;    struct object newB = OINIT;
   struct object orgC;    struct object orgC = OINIT;
   struct object newC;    struct object newC = OINIT;
   static struct object paddingVector(struct object ob, int table[], int m);    static struct object paddingVector(struct object ob, int table[], int m);
   static struct object unitVector(int pos, int size,struct ring *r);    static struct object unitVector(int pos, int size,struct ring *r);
   extern struct ring *CurrentRingp;    extern struct ring *CurrentRingp;
Line 109  struct object Kgroebner(ob)
Line 122  struct object Kgroebner(ob)
     if (ob2.tag != Sarray) {      if (ob2.tag != Sarray) {
       errorKan1("%s\n","Kgroebner(): The options must be given by an array.");        errorKan1("%s\n","Kgroebner(): The options must be given by an array.");
     }      }
       /* Note: If you add a new option, change /configureGroebnerOption, too */
     for (i=0; i<getoaSize(ob2); i++) {      for (i=0; i<getoaSize(ob2); i++) {
       ob2c = getoa(ob2,i);        ob2c = getoa(ob2,i);
       if (ob2c.tag == Sdollar) {        if (ob2c.tag == Sdollar) {
Line 121  struct object Kgroebner(ob)
Line 135  struct object Kgroebner(ob)
           needSyz = needBack = 1;            needSyz = needBack = 1;
         }else if (strcmp(ob2c.lc.str,"forceReduction")==0) {          }else if (strcmp(ob2c.lc.str,"forceReduction")==0) {
           forceReduction = 1;            forceReduction = 1;
           }else if (strcmp(ob2c.lc.str,"reduceOnly")==0) {
             reduceOnly = 1;
           }else if (strcmp(ob2c.lc.str,"gbCheck")==0) {
             gbCheck = 1;
         }else if (strcmp(ob2c.lc.str,"countDown")==0) {          }else if (strcmp(ob2c.lc.str,"countDown")==0) {
           countDown = 1; cdflag = 1;            countDown = 1; cdflag = 1;
           if (needSyz) {            if (needSyz) {
Line 225  struct object Kgroebner(ob)
Line 243  struct object Kgroebner(ob)
   }    }
   /* Assume ob1Size , ob2Size > 0 */    /* Assume ob1Size , ob2Size > 0 */
   ob2 = newObjectArray(ob2Size);    ob2 = newObjectArray(ob2Size);
   ob1ToOb2 =   (int *)GC_malloc(sizeof(int)*ob1Size);    ob1ToOb2 =   (int *)sGC_malloc(sizeof(int)*ob1Size);
   ob1ZeroPos = (int *)GC_malloc(sizeof(int)*(ob1Size-ob2Size+1));    ob1ZeroPos = (int *)sGC_malloc(sizeof(int)*(ob1Size-ob2Size+1));
   if (ob1ToOb2 == NULL || ob1ZeroPos == NULL) errorKan1("%s\n","No more memory.");    if (ob1ToOb2 == NULL || ob1ZeroPos == NULL) errorKan1("%s\n","No more memory.");
   j = 0; k = 0;    j = 0; k = 0;
   for (i=0; i<ob1Size; i++) {    for (i=0; i<ob1Size; i++) {
Line 242  struct object Kgroebner(ob)
Line 260  struct object Kgroebner(ob)
   }    }
   
   a = arrayToArrayOfPOLY(ob2);    a = arrayToArrayOfPOLY(ob2);
   grG = (*groebner)(a,needBack,needSyz,&grP,countDown,forceReduction);    grG = (*groebner)(a,needBack,needSyz,&grP,countDown,forceReduction,reduceOnly,gbCheck);
   
   if (strcmp(F_groebner,"gm") == 0 && (needBack || needSyz)) {    if (strcmp(F_groebner,"gm") == 0 && (needBack || needSyz)) {
     warningKan("The options needBack and needSyz are ignored.");      warningKan("The options needBack and needSyz are ignored.");
Line 265  struct object Kgroebner(ob)
Line 283  struct object Kgroebner(ob)
       fflush(stdout);        fflush(stdout);
     }      }
     mp = getSyzygy(grG,grP->next,&grBases,&backwardMat);      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");      if (KanGBmessage) printf("Done.\n");
   
     putoa(rob,0,gradedPolySetToArray(grG,0));      putoa(rob,0,gradedPolySetToArray(grG,0));
Line 286  struct object Kgroebner(ob)
Line 305  struct object Kgroebner(ob)
   }    }
   
   /* To handle zero entries in the input. */    /* To handle zero entries in the input. */
     rob=KsetAttribute(rob,KpoString("gb"),KpoInteger(grG->gb));
     putoa(rob,0,KsetAttribute(getoa(rob,0),KpoString("gb"),KpoInteger(grG->gb)));
   if (noZeroEntry) {    if (noZeroEntry) {
     return(rob);      return(rob);
   }    }
Line 303  struct object Kgroebner(ob)
Line 324  struct object Kgroebner(ob)
     rob2 = newObjectArray(2);      rob2 = newObjectArray(2);
     putoa(rob2,0,getoa(rob,0));      putoa(rob2,0,getoa(rob,0));
     putoa(rob2,1,newB);      putoa(rob2,1,newB);
       rob2=KsetAttribute(rob2,KpoString("gb"),KpoInteger(grG->gb));
     return(rob2);      return(rob2);
     break;      break;
   case 3:    case 3:
Line 323  struct object Kgroebner(ob)
Line 345  struct object Kgroebner(ob)
     putoa(rob2,0,getoa(rob,0));      putoa(rob2,0,getoa(rob,0));
     putoa(rob2,1,newB);      putoa(rob2,1,newB);
     putoa(rob2,2,newC);      putoa(rob2,2,newC);
       rob2=KsetAttribute(rob2,KpoString("gb"),KpoInteger(grG->gb));
     return(rob2);      return(rob2);
     break;      break;
   default:    default:
Line 332  struct object Kgroebner(ob)
Line 355  struct object Kgroebner(ob)
   
 static struct object paddingVector(struct object ob, int table[], int m)  static struct object paddingVector(struct object ob, int table[], int m)
 {  {
   struct object rob;    struct object rob = OINIT;
   int i;    int i;
   rob = newObjectArray(m);    rob = newObjectArray(m);
   for (i=0; i<m; i++) {    for (i=0; i<m; i++) {
Line 347  static struct object paddingVector(struct object ob, i
Line 370  static struct object paddingVector(struct object ob, i
   
 static struct object unitVector(int pos, int size,struct ring *r)  static struct object unitVector(int pos, int size,struct ring *r)
 {  {
   struct object rob;    struct object rob = OINIT;
   int i;    int i;
   POLY one;    POLY one;
   rob = newObjectArray(size);    rob = newObjectArray(size);
Line 402  struct object polySetToArray(ps,keepRedundant)
Line 425  struct object polySetToArray(ps,keepRedundant)
      int keepRedundant;       int keepRedundant;
 {  {
   int n,i,j;    int n,i,j;
   struct object ob;    struct object ob = OINIT;
   if (ps == (struct polySet *)NULL) return(newObjectArray(0));    if (ps == (struct polySet *)NULL) return(newObjectArray(0));
   n = 0;    n = 0;
   if (keepRedundant) {    if (keepRedundant) {
Line 428  struct object gradedPolySetToGradedArray(gps,keepRedun
Line 451  struct object gradedPolySetToGradedArray(gps,keepRedun
      struct gradedPolySet *gps;       struct gradedPolySet *gps;
      int keepRedundant;       int keepRedundant;
 {  {
   struct object ob,vec;    struct object ob = OINIT;
     struct object vec = OINIT;
   int i;    int i;
   if (gps == (struct gradedPolySet *)NULL) return(NullObject);    if (gps == (struct gradedPolySet *)NULL) return(NullObject);
   ob = newObjectArray(gps->maxGrade +1);    ob = newObjectArray(gps->maxGrade +1);
Line 446  struct object gradedPolySetToArray(gps,keepRedundant)
Line 470  struct object gradedPolySetToArray(gps,keepRedundant)
      struct gradedPolySet *gps;       struct gradedPolySet *gps;
      int keepRedundant;       int keepRedundant;
 {  {
   struct object ob,vec;    struct object ob = OINIT;
     struct object vec = OINIT;
   struct polySet *ps;    struct polySet *ps;
   int k;    int k;
   int i,j;    int i,j;
Line 485  struct object syzPolyToArray(size,f,grG)
Line 510  struct object syzPolyToArray(size,f,grG)
      POLY f;       POLY f;
      struct gradedPolySet *grG;       struct gradedPolySet *grG;
 {  {
   struct object ob;    struct object ob = OINIT;
   int i,g0,i0,serial;    int i,g0,i0,serial;
   
   ob = newObjectArray(size);    ob = newObjectArray(size);
Line 495  struct object syzPolyToArray(size,f,grG)
Line 520  struct object syzPolyToArray(size,f,grG)
   
   while (f != POLYNULL) {    while (f != POLYNULL) {
     g0 = srGrade(f);      g0 = srGrade(f);
     i0 = srIndex(f);      i0 = srIndex(f);
     serial = grG->polys[g0]->serial[i0];      serial = grG->polys[g0]->serial[i0];
     if (serial < 0) {      if (serial < 0) {
       errorKan1("%s\n","syzPolyToArray(): invalid serial[i] of grG.");        errorKan1("%s\n","syzPolyToArray(): invalid serial[i] of grG.");
Line 515  struct object getBackwardArray(grG)
Line 540  struct object getBackwardArray(grG)
   /* use serial, del.  cf. getBackwardTransformation(). */    /* use serial, del.  cf. getBackwardTransformation(). */
   int inputSize,outputSize;    int inputSize,outputSize;
   int i,j,k;    int i,j,k;
   struct object ob;    struct object ob = OINIT;
   struct polySet *ps;    struct polySet *ps;
   
   inputSize = 0; outputSize = 0;    inputSize = 0; outputSize = 0;
Line 546  POLY arrayToPOLY(ob)
Line 571  POLY arrayToPOLY(ob)
      struct object ob;       struct object ob;
 {  {
   int size,i;    int size,i;
   struct object f;    struct object f = OINIT;
   POLY r;    POLY r;
   static int nn,mm,ll,cc,n,m,l,c;    static int nn,mm,ll,cc,n,m,l,c;
   static struct ring *cr = (struct ring *)NULL;    static struct ring *cr = (struct ring *)NULL;
Line 595  struct object POLYToArray(ff)
Line 620  struct object POLYToArray(ff)
   int k,i,matn,size;    int k,i,matn,size;
   struct matrixOfPOLY *mat;    struct matrixOfPOLY *mat;
   POLY ex,sizep;    POLY ex,sizep;
   struct object ob;    struct object ob = OINIT;
   
   if (ff != ZERO) {    if (ff != ZERO) {
     tf = ff->m;      tf = ff->m;
Line 655  struct object homogenizeObject(ob,gradep)
Line 680  struct object homogenizeObject(ob,gradep)
      struct object ob;       struct object ob;
      int *gradep;       int *gradep;
 {  {
   struct object rob,ob1;    struct object rob = OINIT;
     struct object ob1 = OINIT;
   int maxg;    int maxg;
   int gr,flag,i,d,size;    int gr,flag,i,d,size;
   struct ring *rp;    struct ring *rp;
Line 683  struct object homogenizeObject(ob,gradep)
Line 709  struct object homogenizeObject(ob,gradep)
     rob = newObjectArray(size);      rob = newObjectArray(size);
     flag = 0;      flag = 0;
     ob1 = getoa(ob,0);      ob1 = getoa(ob,0);
         if (ob1.tag == Sdollar) return(homogenizeObject_go(ob,gradep));      if (ob1.tag == Sdollar) return(homogenizeObject_go(ob,gradep));
     ob1 = homogenizeObject(ob1,&gr);      ob1 = homogenizeObject(ob1,&gr);
     maxg = gr;      maxg = gr;
     getoa(rob,0) = ob1;      getoa(rob,0) = ob1;
Line 721  struct object homogenizeObject_vec(ob,gradep)
Line 747  struct object homogenizeObject_vec(ob,gradep)
      struct object ob;       struct object ob;
      int *gradep;       int *gradep;
 {  {
   struct object rob,ob1;    struct object rob = OINIT;
     struct object ob1 = OINIT;
   int maxg;    int maxg;
   int gr,i,size;    int gr,i,size;
   POLY f;    POLY f;
Line 745  struct object homogenizeObject_vec(ob,gradep)
Line 772  struct object homogenizeObject_vec(ob,gradep)
     if (size == 0) {      if (size == 0) {
       errorKan1("%s\n","homogenizeObject_vec() is called for the empty array.");        errorKan1("%s\n","homogenizeObject_vec() is called for the empty array.");
     }      }
         if (getoa(ob,0).tag == Sdollar) return(homogenizeObject_go(ob,gradep));      if (getoa(ob,0).tag == Sdollar) return(homogenizeObject_go(ob,gradep));
     rob = newObjectArray(size);      rob = newObjectArray(size);
     for (i=0; i<size; i++) {      for (i=0; i<size; i++) {
       ob1 = getoa(ob,i);        ob1 = getoa(ob,i);
Line 765  struct object homogenizeObject_vec(ob,gradep)
Line 792  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) {  struct object homogenizeObject_go(struct object ob,int *gradep) {
   int size,i,dssize,j;    int size,i,dssize,j;
   struct object ob0;    struct object ob0 = OINIT;
   struct object ob1;    struct object ob1 = OINIT;
   struct object ob2;    struct object ob2 = OINIT;
   struct object rob;    struct object rob = OINIT;
   struct object tob;    struct object tob = OINIT;
   struct object ob1t;    struct object ob1t = OINIT;
   int *ds;    int *ds;
   POLY f;    POLY f;
     int onlyS;
   
     onlyS = 0;  /* default value */
   rob = NullObject;    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.");    if (ob.tag != Sarray) errorKan1("%s\n","homogenizeObject_go(): Invalid argument data type.");
   
   size = getoaSize(ob);    size = getoaSize(ob);
Line 785  struct object homogenizeObject_go(struct object ob,int
Line 841  struct object homogenizeObject_go(struct object ob,int
     errorKan1("%s\n","homogenizeObject_go(): the first argument must be a string.");      errorKan1("%s\n","homogenizeObject_go(): the first argument must be a string.");
   }    }
   if (strcmp(KopString(ob0),"degreeShift") == 0) {    if (strcmp(KopString(ob0),"degreeShift") == 0) {
         if (size != 3)      if (size < 2)
           errorKan1("%s\n","homogenizeObject_go(): [(degreeShift) shift-vector obj]");        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); ob2 = getoa(ob,2);      ob1 = getoa(ob,1);
         dssize = getoaSize(ob1);          if (ob1.tag != Sarray) {
         ds = (int *)sGC_malloc(sizeof(int)*(dssize>0?dssize:1));            if ((ob1.tag == Sdollar) && (strcmp(KopString(ob1),"value")==0)) {
         for (i=0; i<dssize; i++) {          /* Reporting the value. It is done below. */
           ds[i] = objToInteger(getoa(ob1,i));            }else if ((ob1.tag == Sdollar) && (strcmp(KopString(ob1),"reset")==0)) {
                   KresetDegreeShift();
             }
             rob = newObjectArray(2);
             putoa(rob,0,DegreeShiftD);
             putoa(rob,1,DegreeShifto);
             return rob;
         }          }
         if (ob2.tag == Spoly) {  
           f = goHomogenize11(KopPOLY(ob2),ds,dssize,-1);          if (getoaSize(ob1) == 2) {
           rob = KpoPOLY(f);            /* [(degreeShift) [ [1 2]   [3 4] ]  ...] homogenize */
         }else if (ob2.tag == SuniversalNumber) {        /*                  (0,1)-h (u,v)-s                  */
           rob = ob2;            DegreeShiftD = getoa(ob1,0);
         }else if (ob2.tag == Sarray) {            dssize = getoaSize(DegreeShiftD);
           rob = newObjectArray(getoaSize(ob2));            ds = (int *)sGC_malloc(sizeof(int)*(dssize>0?dssize:1));
           for (i=0; i<getoaSize(ob2); i++) {            if (ds == NULL) errorKan1("%s\n","no more memory.");
                 tob = newObjectArray(3);            for (i=0; i<dssize; i++) {
                 ob1t = newObjectArray(dssize);                  ds[i] = objToInteger(getoa(DegreeShiftD,i));
                 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);  
           }            }
         }else{        DegreeShiftD_size = dssize;
           errorKan1("%s\n","homogenizeObject_go(): invalid object for the third element.");            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;
           }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,onlyS);
           rob = KpoPOLY(f);
         }else if (ob2.tag == SuniversalNumber) {
           rob = ob2;
         }else if (ob2.tag == Sarray) {
                   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.");
         }
       }
   }else{    }else{
           errorKan1("%s\n","homogenizeObject_go(): unknown key word.");        errorKan1("%s\n","homogenizeObject_go(): unknown key word.");
   }    }
   return( rob );    return( rob );
 }  }
   
   
Line 881  struct object oPrincipalPart(ob)
Line 982  struct object oPrincipalPart(ob)
      struct object ob;       struct object ob;
 {  {
   POLY f;    POLY f;
   struct object rob;    struct object rob = OINIT;
   
   switch(ob.tag) {    switch(ob.tag) {
   case Spoly:    case Spoly:
Line 898  struct object oInitW(ob,oWeight)
Line 999  struct object oInitW(ob,oWeight)
      struct object oWeight;       struct object oWeight;
 {  {
   POLY f;    POLY f;
   struct object rob;    struct object rob = OINIT;
   int w[2*N0];    int w[2*N0];
   int n,i;    int n,i;
   struct object ow;    struct object ow = OINIT;
     int shiftvec;
     struct object oShift = OINIT;
     int *s;
     int ssize,m;
   
     shiftvec = 0;
     s = NULL;
   
   if (oWeight.tag != Sarray) {    if (oWeight.tag != Sarray) {
     errorKan1("%s\n","oInitW(): the second argument must be array.");      errorKan1("%s\n","oInitW(): the second argument must be array.");
   }    }
     oWeight = Kto_int32(oWeight);
   n = getoaSize(oWeight);    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.");    if (n >= 2*N0) errorKan1("%s\n","oInitW(): the size of the second argument is invalid.");
   for (i=0; i<n; i++) {    for (i=0; i<n; i++) {
     ow = getoa(oWeight,i);      ow = getoa(oWeight,i);
           if (ow.tag == SuniversalNumber) {
             ow = KpoInteger(coeffToInt(ow.lc.universalNumber));
           }
     if (ow.tag != Sinteger) {      if (ow.tag != Sinteger) {
       errorKan1("%s\n","oInitW(): the entries of the second argument must be integers.");        errorKan1("%s\n","oInitW(): the entries of the second argument must be integers.");
     }      }
     w[i] = KopInteger(ow);      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) {    switch(ob.tag) {
   case Spoly:    case Spoly:
     f = KopPOLY(ob);      f = KopPOLY(ob);
     return( KpoPOLY(POLYToInitW(f,w)));          if (shiftvec) {
             return( KpoPOLY(POLYToInitWS(f,w,s)));
           }else{
             return( KpoPOLY(POLYToInitW(f,w)));
           }
     break;      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:    default:
     errorKan1("%s\n","oInitW(): Argument must be polynomial.");      errorKan1("%s\n","oInitW(): Argument must be polynomial or a vector of polynomials");
     break;      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 = OINIT;
     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 = OINIT;
     int w[2*N0];
     int n,i;
     struct object ow = OINIT;
     int shiftvec;
     struct object oShift = OINIT;
     int *s;
     int ssize,m;
   
     shiftvec = 0;
     s = NULL;
   
     if (oWeight.tag != Sarray) {
       errorKan1("%s\n","ordWsAll(): the second argument must be array.");
     }
     oWeight = Kto_int32(oWeight);
     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;
     }
   }
   
 int KpolyLength(POLY f) {  int KpolyLength(POLY f) {
   int size;    int size;
   if (f == POLYNULL) return(1);    if (f == POLYNULL) return(1);
Line 952  int validOutputOrder(int ord[],int n) {
Line 1269  int validOutputOrder(int ord[],int n) {
 struct object KsetOutputOrder(struct object ob, struct ring *rp)  struct object KsetOutputOrder(struct object ob, struct ring *rp)
 {  {
   int n,i;    int n,i;
   struct object ox;    struct object ox = OINIT;
   struct object otmp;    struct object otmp = OINIT;
   int *xxx;    int *xxx;
   int *ddd;    int *ddd;
   if (ob.tag  != Sarray) {    if (ob.tag  != Sarray) {
Line 984  struct object KsetOutputOrder(struct object ob, struct
Line 1301  struct object KsetOutputOrder(struct object ob, struct
   
 struct object KschreyerSkelton(struct object g)  struct object KschreyerSkelton(struct object g)
 {  {
   struct object rob;    struct object rob = OINIT;
   struct object ij;    struct object ij = OINIT;
   struct object ab;    struct object ab = OINIT;
   struct object tt;    struct object tt = OINIT;
   struct arrayOfPOLY *ap;    struct arrayOfPOLY *ap;
   struct arrayOfMonomialSyz ans;    struct arrayOfMonomialSyz ans;
   int k;    int k;
Line 1033  struct object KvectorToSchreyer_es(struct object obarr
Line 1350  struct object KvectorToSchreyer_es(struct object obarr
   int nn;    int nn;
   POLY f;    POLY f;
   POLY g;    POLY g;
   struct object ob;    struct object ob = OINIT;
   struct ring *rp;    struct ring *rp;
   if (obarray.tag != Sarray) {    if (obarray.tag != Sarray) {
     errorKan1("%s\n","KvectorToSchreyer_es(): argument must be an array of polynomials.");      errorKan1("%s\n","KvectorToSchreyer_es(): argument must be an array of polynomials.");
Line 1062  struct object KvectorToSchreyer_es(struct object obarr
Line 1379  struct object KvectorToSchreyer_es(struct object obarr
   
 int objToInteger(struct object ob) {  int objToInteger(struct object ob) {
   if (ob.tag == Sinteger) {    if (ob.tag == Sinteger) {
         return KopInteger(ob);      return KopInteger(ob);
   }else if (ob.tag == SuniversalNumber) {    }else if (ob.tag == SuniversalNumber) {
         return(coeffToInt(KopUniversalNumber(ob)));      return(coeffToInt(KopUniversalNumber(ob)));
   }else {    }else {
         errorKan1("%s\n","objToInteger(): invalid argument.");      errorKan1("%s\n","objToInteger(): invalid argument.");
   }    }
   }
   
   struct object KgetExponents(struct object obPoly,struct object otype) {
     int type,asize,i;
     POLY f;
     POLY ff;
     MONOMIAL tf;
     struct object rob = OINIT;
     struct object tob = OINIT;
     static int nn,mm,ll,cc,n,m,l,c;
     static struct ring *cr = (struct ring *)NULL;
     extern struct ring *CurrentRingp;
     int size,hsize,fsize,p,r;
   
     if (otype.tag == Sinteger) {
       type = KopInteger(otype);
     }else if (otype.tag == SuniversalNumber) {
       type = coeffToInt(KopUniversalNumber(otype));
     }else {
       errorKan1("%s\n","KgetExponents(): invalid translation type.");
     }
   
     if (obPoly.tag == Spoly) {
       f = KopPOLY(obPoly);
     }else if (obPoly.tag == Sarray) {
       asize = getoaSize(obPoly);
       rob = newObjectArray(asize);
       for (i=0; i<asize; i++) {
         tob = KgetExponents(getoa(obPoly,i),otype);
         putoa(rob,i,tob);
       }
           return rob;
     }else{
       errorKan1("%s\n","KgetExponents(): argument must be a polynomial.");
     }
   
     /* type == 0    x,y,Dx,Dy     (no commutative, no vector)
        type == 1    x,y,Dx,Dy,h,H (commutative & no vector)
        type == 2    x,y,Dx,Dy,h   (commutative & no vector)
     */
     if (f ISZERO) {
       cr = CurrentRingp;
     }else{
       tf = f->m;
     }
     if (tf->ringp != cr) {
       n = tf->ringp->n;
       m = tf->ringp->m;
       l = tf->ringp->l;
       c = tf->ringp->c;
       nn = tf->ringp->nn;
       mm = tf->ringp->mm;
       ll = tf->ringp->ll;
       cc = tf->ringp->cc;
       cr = tf->ringp;
     }
     if (type == 0) {
       size = 0;
       for (i=c; i<ll; i++) size += 2;
       for (i=l; i<mm; i++) size += 2;
       for (i=m; i<nn; i++) size += 2;
     }else if (type == 1) {
       size = 0;
       for (i=0; i<cc; i++) size += 2;
       for (i=c; i<ll; i++) size += 2;
       for (i=l; i<mm; i++) size += 2;
       for (i=m; i<nn; i++) size += 2;
     }else if (type == 2) {
       size = 0;
       for (i=0; i<cc; i++) size += 1;
       for (i=c; i<ll; i++) size += 2;
       for (i=l; i<mm; i++) size += 2;
       for (i=m; i<nn; i++) size += 2;
     }else{
       errorKan1("%s\n","KgetExponent, unknown type.");
     }
     if (type == 1 || type == 2) {
       hsize = (size-cc)/2;
     }else{
       hsize = size/2;
     }
     if (f ISZERO) {
       tob = newObjectArray(size);
       for (i=0; i<size; i++) {
         putoa(tob,i,KpoInteger(0));
       }
       rob = newObjectArray(1);
       putoa(rob,0,tob);
       return rob;
     }
     fsize = 0;
     ff = f;
     while (ff != POLYNULL) {
       fsize++;
       ff = ff->next;
     }
     rob = newObjectArray(fsize);
   
     ff = f;
     p = 0;
     while (ff != POLYNULL) {
       r = 0;
       tob = newObjectArray(size);
           tf = ff->m;
       for (i=ll-1; i>=c; i--) {
         putoa(tob,r,KpoInteger(tf->e[i].x));
         putoa(tob,hsize+r,KpoInteger(tf->e[i].D));
         r++;
       }
       for (i=mm-1; i>=l; i--) {
         putoa(tob,r,KpoInteger(tf->e[i].x));
         putoa(tob,hsize+r,KpoInteger(tf->e[i].D));
         r++;
       }
       for (i=nn-1; i>=m; i--) {
         putoa(tob,r,KpoInteger(tf->e[i].x));
         putoa(tob,hsize+r,KpoInteger(tf->e[i].D));
         r++;
       }
       if (type == 1) {
         for (i=cc-1; i>=0; i--) {
           putoa(tob,hsize+r,KpoInteger(tf->e[i].D));
           r++;
           putoa(tob,hsize+r,KpoInteger(tf->e[i].x));
           r++;
         }
       }else if (type == 2) {
         for (i=cc-1; i>=0; i--) {
           putoa(tob,hsize+r,KpoInteger(tf->e[i].D));
           r++;
         }
           }
   
       putoa(rob,p,tob);
       p++;
       ff = ff->next;
     }
     return rob;
 }  }
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.20
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>