[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.8 and 1.16

version 1.8, 2003/08/23 02:28:38 version 1.16, 2004/09/05 07:42:43
Line 1 
Line 1 
 /* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport1.c,v 1.7 2003/08/22 11:47:03 takayama Exp $ */  /* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport1.c,v 1.15 2004/08/31 05:30:20 takayama Exp $ */
 #include <stdio.h>  #include <stdio.h>
 #include "datatype.h"  #include "datatype.h"
 #include "stackm.h"  #include "stackm.h"
Line 15  extern int KanGBmessage;
Line 15  extern int KanGBmessage;
 struct object DegreeShifto;  struct object DegreeShifto;
 int DegreeShifto_size = 0;  int DegreeShifto_size = 0;
 int *DegreeShifto_vec = NULL;  int *DegreeShifto_vec = NULL;
   struct object DegreeShiftD;
   int DegreeShiftD_size = 0;
   int *DegreeShiftD_vec = NULL;
   
 /** :kan, :ring */  /** :kan, :ring */
 struct object Kreduction(f,set)  struct object Kreduction(f,set)
Line 231  struct object Kgroebner(ob)
Line 234  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 271  struct object Kgroebner(ob)
Line 274  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 771  struct object homogenizeObject_vec(ob,gradep)
Line 775  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;
Line 781  struct object homogenizeObject_go(struct object ob,int
Line 794  struct object homogenizeObject_go(struct object ob,int
   struct object ob1t;    struct object ob1t;
   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 792  struct object homogenizeObject_go(struct object ob,int
Line 825  struct object homogenizeObject_go(struct object ob,int
   }    }
   if (strcmp(KopString(ob0),"degreeShift") == 0) {    if (strcmp(KopString(ob0),"degreeShift") == 0) {
     if (size < 2)      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);      ob1 = getoa(ob,1);
         if (ob1.tag != Sarray) {          if (ob1.tag != Sarray) {
           if (DegreeShifto_size != 0) {            if ((ob1.tag == Sdollar) && (strcmp(KopString(ob1),"value")==0)) {
                 return DegreeShifto;          /* Reporting the value. It is done below. */
           }else{            }else if ((ob1.tag == Sdollar) && (strcmp(KopString(ob1),"reset")==0)) {
         rob = NullObject;                  KresetDegreeShift();
         return rob;  
           }            }
             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));          if (getoaSize(ob1) == 2) {
     for (i=0; i<dssize; i++) {            /* [(degreeShift) [ [1 2]   [3 4] ]  ...] homogenize */
       ds[i] = objToInteger(getoa(ob1,i));        /*                  (0,1)-h (u,v)-s                  */
     }            DegreeShiftD = getoa(ob1,0);
     if (size == 2) {            dssize = getoaSize(DegreeShiftD);
       DegreeShifto = ob1;            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_size = dssize;
       DegreeShifto_vec = ds;            DegreeShifto_vec = ds;
       rob = ob1;          }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{      }else{
       ob2 = getoa(ob,2);        ob2 = getoa(ob,2);
       if (ob2.tag == Spoly) {        if (ob2.tag == Spoly) {
         f = goHomogenize11(KopPOLY(ob2),ds,dssize,-1,0);          f = goHomogenize11(KopPOLY(ob2),ds,dssize,-1,onlyS);
         rob = KpoPOLY(f);          rob = KpoPOLY(f);
       }else if (ob2.tag == SuniversalNumber) {        }else if (ob2.tag == SuniversalNumber) {
         rob = ob2;          rob = ob2;
       }else if (ob2.tag == Sarray) {        }else if (ob2.tag == Sarray) {
         rob = newObjectArray(getoaSize(ob2));                  int mm;
         for (i=0; i<getoaSize(ob2); i++) {                  mm = getoaSize(ob2);
           tob = newObjectArray(3);                  f = objArrayToPOLY(ob2);
           ob1t = newObjectArray(dssize);          f = goHomogenize11(f,ds,dssize,-1,onlyS);
           if (getoa(ob2,i).tag == Spoly) {          rob = POLYtoObjArray(f,mm);
             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{        }else{
         errorKan1("%s\n","homogenizeObject_go(): invalid object for the third element.");          errorKan1("%s\n","homogenizeObject_go(): invalid object for the third element.");
       }        }
Line 935  struct object oInitW(ob,oWeight)
Line 997  struct object oInitW(ob,oWeight)
   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) {    if (n == 0) {
         m = getoaSize(ob);          m = getoaSize(ob);
Line 1089  struct object KordWsAll(ob,oWeight)
Line 1152  struct object KordWsAll(ob,oWeight)
   if (oWeight.tag != Sarray) {    if (oWeight.tag != Sarray) {
     errorKan1("%s\n","ordWsAll(): the second argument must be array.");      errorKan1("%s\n","ordWsAll(): the second argument must be array.");
   }    }
     oWeight = Kto_int32(oWeight);
   n = getoaSize(oWeight);    n = getoaSize(oWeight);
   if (n == 0) {    if (n == 0) {
         m = getoaSize(ob);          m = getoaSize(ob);
Line 1304  int objToInteger(struct object ob) {
Line 1368  int objToInteger(struct object 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;
     struct object tob;
     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.8  
changed lines
  Added in v.1.16
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>