=================================================================== RCS file: /home/cvs/OpenXM/src/kan96xx/Kan/kanExport1.c,v retrieving revision 1.1.1.1 retrieving revision 1.20 diff -u -p -r1.1.1.1 -r1.20 --- OpenXM/src/kan96xx/Kan/kanExport1.c 1999/10/08 02:12:02 1.1.1.1 +++ OpenXM/src/kan96xx/Kan/kanExport1.c 2005/06/16 08:40:04 1.20 @@ -1,3 +1,4 @@ +/* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport1.c,v 1.19 2005/06/16 06:54:55 takayama Exp $ */ #include #include "datatype.h" #include "stackm.h" @@ -11,15 +12,22 @@ static int Message = 1; 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 */ struct object Kreduction(f,set) -struct object f; -struct object set; + struct object f; + struct object set; { POLY r; struct gradedPolySet *grG; struct syz0 syz; - struct object rob; + struct object rob = OINIT; int flag; extern int ReduceLowerTerms; @@ -38,6 +46,7 @@ struct object set; }else{ r = (*reduction)(f.lc.poly,grG,1,&syz); } + /* outputGradedPolySet(grG,0); */ if (flag) { rob = newObjectArray(3); putoa(rob,0,KpoPOLY(r)); @@ -54,43 +63,47 @@ struct object set; } struct object Kgroebner(ob) -struct object ob; + struct object ob; { int needSyz = 0; int needBack = 0; int needInput = 0; int countDown = 0; int cdflag = 0; - struct object ob1,ob2,ob2c; + struct object ob1 = OINIT; + struct object ob2 = OINIT; + struct object ob2c = OINIT; int i; struct gradedPolySet *grG; struct pair *grP; struct arrayOfPOLY *a; - struct object rob; + struct object rob = OINIT; struct gradedPolySet *grBases; struct matrixOfPOLY *mp; struct matrixOfPOLY *backwardMat; - struct object ob1New; + struct object ob1New = OINIT; extern char *F_groebner; extern int CheckHomogenization; extern int StopDegree; int sdflag = 0; int forceReduction = 0; + int reduceOnly = 0; + int gbCheck = 0; /* see @s/2005/06/16-note.pdf */ int ob1Size, ob2Size, noZeroEntry; int *ob1ToOb2; int *ob1ZeroPos; int method; int j,k; - struct object rob2; - struct object rob3; - struct object rob4; + struct object rob2 = OINIT; + struct object rob3 = OINIT; + struct object rob4 = OINIT; struct ring *myring; POLY f; - struct object orgB; - struct object newB; - struct object orgC; - struct object newC; + struct object orgB = OINIT; + struct object newB = OINIT; + struct object orgC = OINIT; + struct object newC = OINIT; static struct object paddingVector(struct object ob, int table[], int m); static struct object unitVector(int pos, int size,struct ring *r); extern struct ring *CurrentRingp; @@ -109,48 +122,53 @@ struct object ob; if (ob2.tag != Sarray) { 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 0 */ ob2 = newObjectArray(ob2Size); - ob1ToOb2 = (int *)GC_malloc(sizeof(int)*ob1Size); - ob1ZeroPos = (int *)GC_malloc(sizeof(int)*(ob1Size-ob2Size+1)); + ob1ToOb2 = (int *)sGC_malloc(sizeof(int)*ob1Size); + ob1ZeroPos = (int *)sGC_malloc(sizeof(int)*(ob1Size-ob2Size+1)); if (ob1ToOb2 == NULL || ob1ZeroPos == NULL) errorKan1("%s\n","No more memory."); j = 0; k = 0; for (i=0; inext,&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)); @@ -286,6 +305,8 @@ struct object ob; } /* 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) { return(rob); } @@ -303,6 +324,7 @@ struct object ob; rob2 = newObjectArray(2); putoa(rob2,0,getoa(rob,0)); putoa(rob2,1,newB); + rob2=KsetAttribute(rob2,KpoString("gb"),KpoInteger(grG->gb)); return(rob2); break; case 3: @@ -323,6 +345,7 @@ struct object ob; putoa(rob2,0,getoa(rob,0)); putoa(rob2,1,newB); putoa(rob2,2,newC); + rob2=KsetAttribute(rob2,KpoString("gb"),KpoInteger(grG->gb)); return(rob2); break; default: @@ -332,7 +355,7 @@ struct object ob; static struct object paddingVector(struct object ob, int table[], int m) { - struct object rob; + struct object rob = OINIT; int i; rob = newObjectArray(m); for (i=0; imaxGrade +1); @@ -443,10 +467,11 @@ int keepRedundant; struct object gradedPolySetToArray(gps,keepRedundant) -struct gradedPolySet *gps; -int keepRedundant; + struct gradedPolySet *gps; + int keepRedundant; { - struct object ob,vec; + struct object ob = OINIT; + struct object vec = OINIT; struct polySet *ps; int k; int i,j; @@ -459,7 +484,7 @@ int keepRedundant; size += ps->size; }else{ for (j=0; jsize; j++) { - if (ps->del[j] == 0) ++size; + if (ps->del[j] == 0) ++size; } } } @@ -470,8 +495,8 @@ int keepRedundant; ps = gps->polys[i]; for (j=0; jsize; j++) { if (keepRedundant || (ps->del[j] == 0)) { - putoa(ob,k,KpoPOLY(ps->g[j])); - k++; + putoa(ob,k,KpoPOLY(ps->g[j])); + k++; } } } @@ -481,11 +506,11 @@ int keepRedundant; /* serial == -1 : It's not in the marix input. */ struct object syzPolyToArray(size,f,grG) -int size; -POLY f; -struct gradedPolySet *grG; + int size; + POLY f; + struct gradedPolySet *grG; { - struct object ob; + struct object ob = OINIT; int i,g0,i0,serial; ob = newObjectArray(size); @@ -495,7 +520,7 @@ struct gradedPolySet *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."); @@ -510,12 +535,12 @@ struct gradedPolySet *grG; } struct object getBackwardArray(grG) -struct gradedPolySet *grG; + struct gradedPolySet *grG; { /* use serial, del. cf. getBackwardTransformation(). */ int inputSize,outputSize; int i,j,k; - struct object ob; + struct object ob = OINIT; struct polySet *ps; inputSize = 0; outputSize = 0; @@ -533,8 +558,8 @@ struct gradedPolySet *grG; ps = grG->polys[i]; for (j=0; jsize; j++) { if (ps->del[j] == 0) { - putoa(ob,k,syzPolyToArray(inputSize,ps->syz[j]->syz,grG)); - k++; + putoa(ob,k,syzPolyToArray(inputSize,ps->syz[j]->syz,grG)); + k++; } } } @@ -543,10 +568,10 @@ struct gradedPolySet *grG; POLY arrayToPOLY(ob) -struct object ob; + struct object ob; { int size,i; - struct object f; + struct object f = OINIT; POLY r; static int nn,mm,ll,cc,n,m,l,c; static struct ring *cr = (struct ring *)NULL; @@ -563,15 +588,15 @@ struct object ob; if (ff != ZERO) { tf = ff->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; + 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 (n-nn >0) ee = cxx(1,n-1,i,tf->ringp); else if (m-mm >0) ee = cxx(1,m-1,i,tf->ringp); @@ -585,7 +610,7 @@ struct object ob; } struct object POLYToArray(ff) -POLY ff; + POLY ff; { static int nn,mm,ll,cc,n,m,l,c; @@ -595,7 +620,7 @@ POLY ff; int k,i,matn,size; struct matrixOfPOLY *mat; POLY ex,sizep; - struct object ob; + struct object ob = OINIT; if (ff != ZERO) { tf = ff->m; @@ -639,7 +664,7 @@ POLY ff; } static int isThereh(f) -POLY f; + POLY f; { POLY t; if (f == 0) return(0); @@ -652,10 +677,11 @@ POLY f; } struct object homogenizeObject(ob,gradep) -struct object ob; -int *gradep; + struct object ob; + int *gradep; { - struct object rob,ob1; + struct object rob = OINIT; + struct object ob1 = OINIT; int maxg; int gr,flag,i,d,size; struct ring *rp; @@ -683,6 +709,7 @@ int *gradep; rob = newObjectArray(size); flag = 0; ob1 = getoa(ob,0); + if (ob1.tag == Sdollar) return(homogenizeObject_go(ob,gradep)); ob1 = homogenizeObject(ob1,&gr); maxg = gr; getoa(rob,0) = ob1; @@ -690,7 +717,7 @@ int *gradep; ob1 = getoa(ob,i); ob1 = homogenizeObject(ob1,&gr); if (gr > maxg) { - maxg = gr; + maxg = gr; } getoa(rob,i) = ob1; } @@ -699,12 +726,12 @@ int *gradep; rp = oRingp(rob); if (rp == (struct ring *)NULL) rp = CurrentRingp; for (i=0; i gr) { - f = cdd(1,0,maxg-gr-i,rp); /* h^{maxg-gr-i} */ - getoa(rob,i) = KooMult(KpoPOLY(f),getoa(rob,i)); - } + gr = oGrade(getoa(rob,i)); + /**printf("maxg=%d, gr=%d(i=%d) ",maxg,gr,i); fflush(stdout);**/ + if (maxg > gr) { + f = cdd(1,0,maxg-gr-i,rp); /* h^{maxg-gr-i} */ + getoa(rob,i) = KooMult(KpoPOLY(f),getoa(rob,i)); + } } } *gradep = maxg; @@ -717,10 +744,11 @@ int *gradep; } struct object homogenizeObject_vec(ob,gradep) -struct object ob; -int *gradep; + struct object ob; + int *gradep; { - struct object rob,ob1; + struct object rob = OINIT; + struct object ob1 = OINIT; int maxg; int gr,i,size; POLY f; @@ -744,13 +772,14 @@ int *gradep; if (size == 0) { errorKan1("%s\n","homogenizeObject_vec() is called for the empty array."); } + if (getoa(ob,0).tag == Sdollar) return(homogenizeObject_go(ob,gradep)); rob = newObjectArray(size); for (i=0; i gr? maxg: gr); + maxg = (maxg > gr? maxg: gr); } putoa(rob,i,ob1); } @@ -763,8 +792,139 @@ int *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 = OINIT; + struct object ob1 = OINIT; + struct object ob2 = OINIT; + struct object rob = OINIT; + struct object tob = OINIT; + struct object ob1t = OINIT; + 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); + if (size == 0) errorKan1("%s\n","homogenizeObject_go(): the first argument must be a string."); + ob0 = getoa(ob,0); + if (ob0.tag != Sdollar) { + errorKan1("%s\n","homogenizeObject_go(): the first argument must be a string."); + } + 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.\nshift-vector=(0,1)-shift vector or [(0,1)-shift vector, (u,v)-shift vector]."); + ob1 = getoa(ob,1); + if (ob1.tag != Sarray) { + 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; + } + + 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; i0?dssize:1)); + if (ds == NULL) errorKan1("%s\n","no more memory."); + for (i=0; i0?dssize:1)); + if (ds == NULL) errorKan1("%s\n","no more memory."); + for (i=0; i= 2*N0) errorKan1("%s\n","oInitW(): the size of the second argument is invalid."); for (i=0; im->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; im->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= 2*N0) errorKan1("%s\n","ordWsAll(): the size of the second argument is invalid."); + for (i=0; im; + } + 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; inext; + } + 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; }