=================================================================== RCS file: /home/cvs/OpenXM/src/kan96xx/Kan/kanExport1.c,v retrieving revision 1.5 retrieving revision 1.17 diff -u -p -r1.5 -r1.17 --- OpenXM/src/kan96xx/Kan/kanExport1.c 2003/07/17 07:33:03 1.5 +++ OpenXM/src/kan96xx/Kan/kanExport1.c 2005/06/09 04:09:22 1.17 @@ -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.16 2004/09/05 07:42:43 takayama Exp $ */ #include #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)); @@ -81,6 +85,7 @@ struct object Kgroebner(ob) extern int StopDegree; int sdflag = 0; int forceReduction = 0; + int reduceOnly = 0; int ob1Size, ob2Size, noZeroEntry; int *ob1ToOb2; @@ -126,6 +131,8 @@ struct object Kgroebner(ob) needSyz = needBack = 1; }else if (strcmp(ob2c.lc.str,"forceReduction")==0) { forceReduction = 1; + }else if (strcmp(ob2c.lc.str,"reduceOnly")==0) { + reduceOnly = 1; }else if (strcmp(ob2c.lc.str,"countDown")==0) { countDown = 1; cdflag = 1; if (needSyz) { @@ -230,8 +237,8 @@ struct object Kgroebner(ob) } /* Assume ob1Size , ob2Size > 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)); @@ -500,7 +508,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 +778,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 +797,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 +828,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; 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; 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; + 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; }