=================================================================== RCS file: /home/cvs/OpenXM/src/kan96xx/Kan/order.c,v retrieving revision 1.1.1.1 retrieving revision 1.14 diff -u -p -r1.1.1.1 -r1.14 --- OpenXM/src/kan96xx/Kan/order.c 1999/10/08 02:12:01 1.1.1.1 +++ OpenXM/src/kan96xx/Kan/order.c 2005/06/16 05:07:23 1.14 @@ -1,3 +1,4 @@ +/* $OpenXM: OpenXM/src/kan96xx/Kan/order.c,v 1.13 2004/09/13 11:24:11 takayama Exp $ */ #include #include "datatype.h" #include "stackm.h" @@ -20,15 +21,15 @@ static void warningOrder(char *s); static void errorOrder(char *s); void setOrderByMatrix(order,n,c,l,omsize) -int order[]; -int n,c,l,omsize; + int order[]; + int n,c,l,omsize; { int i,j; int *Order; extern struct ring *CurrentRingp; switch_mmLarger("default"); - /* q-case */ + /* q-case */ if ( l-c > 0) { switch_mmLarger("qmatrix"); } @@ -45,8 +46,8 @@ int n,c,l,omsize; } void showRing(level,ringp) -int level; -struct ring *ringp; + int level; + struct ring *ringp; { int i,j; FILE *fp; @@ -57,6 +58,10 @@ struct ring *ringp; int P; char *mtype; extern char *F_isSameComponent; + POLY f; + POLY fx; + POLY fd; + POLY rf; fp = stdout; N=ringp->n; M = ringp->m; L = ringp->l; C = ringp->c; @@ -79,8 +84,10 @@ struct ring *ringp; fprintf(fp,"\n"); fprintf(fp,"where "); for (i=M; imultiplication); + mtype,(unsigned int) ringp->multiplication); if (ringp->schreyer) { fprintf(fp,"schreyer=1, gbListTower="); printObjectList((struct object *)(ringp->gbListTower)); fprintf(fp,"\n"); } - + if (ringp->degreeShiftSize) { + fprintf(fp,"degreeShift vector (N=%d,Size=%d)= \n[\n",ringp->degreeShiftN,ringp->degreeShiftSize); + { + int i,j; + for (i=0; idegreeShiftN; i++) { + fprintf(fp," ["); + for (j=0; j< ringp->degreeShiftSize; j++) { + fprintf(fp," %d ",ringp->degreeShift[i*(ringp->degreeShiftSize)+j]); + } + fprintf(fp,"]\n"); + } + } + fprintf(fp,"]\n"); + } + fprintf(fp,"--- weight vectors ---\n"); if (level) printOrder(ringp); + + if (ringp->partialEcart) { + fprintf(fp,"--- partialEcartGlobalVarX ---\n"); + for (i=0; ipartialEcart; i++) { + fprintf(fp," %4s ",TransX[ringp->partialEcartGlobalVarX[i]]); + } + fprintf(fp,"\n"); + } if (ringp->next != (struct ring *)NULL) { fprintf(fp,"\n\n-------- The next ring is .... --------------\n"); @@ -202,7 +233,7 @@ if (isD(i)) D_{itod(i)} */ void printOrder(ringp) -struct ring *ringp; + struct ring *ringp; { int i,j; FILE *fp; @@ -244,9 +275,9 @@ struct ring *ringp; fprintf(fp,"\n"); /* print D: differential DE: differential, should be eliminated - E: difference - Q: q-difference - C: commutative + E: difference + Q: q-difference + C: commutative */ if (strcmp(F_isSameComponent,"x")== 0 || strcmp(F_isSameComponent,"xd")==0) { for (i=0; in; @@ -315,7 +347,7 @@ struct object oGetOrderMatrix(struct ring *ringp) int mmLarger_matrix(ff,gg) -POLY ff; POLY gg; + POLY ff; POLY gg; { int exp[2*N0]; /* exponents */ int i,k; @@ -327,6 +359,9 @@ POLY ff; POLY gg; int in2; int *from, *to; int omsize; + int dssize; + int dsn; + int *degreeShiftVector; if (ff == POLYNULL ) { if (gg == POLYNULL) return( 2 ); @@ -344,6 +379,10 @@ POLY ff; POLY gg; from = rp->from; to = rp->to; omsize = rp->orderMatrixSize; + if (dssize = rp->degreeShiftSize) { + degreeShiftVector = rp->degreeShift; /* Note. 2003.06.26 */ + dsn = rp->degreeShiftN; + } flag = 1; for (i=N-1,k=0; i>=0; i--,k++) { @@ -360,6 +399,15 @@ POLY ff; POLY gg; sum = 0; in2 = i*2*N; /* for (k=0; k<2*N; k++) sum += exp[k]*Order[in2+k]; */ for (k=from[i]; ke[N-1].x < dssize) && (f->e[N-1].x >= 0) && + (g->e[N-1].x < dssize) && (g->e[N-1].x >= 0)) { + sum += degreeShiftVector[i*dssize+ (f->e[N-1].x)] + -degreeShiftVector[i*dssize+ (g->e[N-1].x)]; + }else{ + /*warningOrder("Size mismatch in the degree shift vector. It is ignored.");*/ + } + } if (sum > 0) return(1); if (sum < 0) return(0); } @@ -368,7 +416,7 @@ POLY ff; POLY gg; /* This should be used in case of q */ int mmLarger_qmatrix(ff,gg) -POLY ff; POLY gg; + POLY ff; POLY gg; { int exp[2*N0]; /* exponents */ int i,k; @@ -417,8 +465,8 @@ POLY ff; POLY gg; /* x(N-1)>x(N-2)>....>D(N-1)>....>D(0) */ mmLarger_pureLexicographic(f,g) -POLY f; -POLY g; + POLY f; + POLY g; { int i,r; int n; @@ -457,7 +505,7 @@ POLY g; void setFromTo(ringp) -struct ring *ringp; + struct ring *ringp; { int n; int i,j,oasize; @@ -473,14 +521,14 @@ struct ring *ringp; ringp->from[i] = 0; ringp->to[i] = n; for (j=0; jorder[i*n+j] != 0) { - ringp->from[i] = j; - break; + ringp->from[i] = j; + break; } } for (j=n-1; j>=0; j--) { if (ringp->order[i*n+j] != 0) { - ringp->to[i] = j+1; - break; + ringp->to[i] = j+1; + break; } } } @@ -489,7 +537,7 @@ struct ring *ringp; /* It ignores h and should be used with mmLarger_tower */ /* cf. mmLarger_matrix. h always must be checked at last. */ static int mmLarger_matrix_schreyer(ff,gg) -POLY ff; POLY gg; + POLY ff; POLY gg; { int exp[2*N0]; /* exponents */ int i,k; @@ -557,16 +605,16 @@ int mmLarger_tower(POLY f,POLY g) { } if (!(f->m->ringp->schreyer) || !(g->m->ringp->schreyer)) return(mmLarger_matrix(f,g)); - /* modifiable: mmLarger_qmatrix */ + /* modifiable: mmLarger_qmatrix */ gbList = (struct object *)(g->m->ringp->gbListTower); if (gbList == NULL) return(mmLarger_matrix(f,g)); - /* modifiable: mmLarger_qmatrix */ + /* modifiable: mmLarger_qmatrix */ if (gbList->tag != Slist) { warningOrder("mmLarger_tower(): gbList must be in Slist.\n"); return(1); } if (klength(gbList) ==0) return(mmLarger_matrix(f,g)); - /* modifiable: mmLarger_qmatrix */ + /* modifiable: mmLarger_qmatrix */ r = mmLarger_tower3(f,g,gbList); /* printf("mmLarger_tower3(%s,%s) --> %d\n",POLYToString(head(f),'*',1),POLYToString(head(g),'*',1),r); */ @@ -584,7 +632,7 @@ int mmLarger_tower3(POLY f,POLY g,struct object *gbLis int n,fv,gv,t,r,nn; POLY fm; POLY gm; - struct object gb; + struct object gb = OINIT; if (f == POLYNULL) { if (g == POLYNULL) return(2); @@ -597,7 +645,7 @@ int mmLarger_tower3(POLY f,POLY g,struct object *gbLis n = f->m->ringp->n; nn = f->m->ringp->nn; /* critical and modifiable */ /* m e_u > m e_v <==> m g_u > m g_v */ - /* or equal and u < v */ + /* or equal and u < v */ fv = f->m->e[nn].x ; /* extract component (vector) number of f! */ gv = g->m->e[nn].x ; if (fv == gv) { /* They have the same component number. */ @@ -605,13 +653,13 @@ int mmLarger_tower3(POLY f,POLY g,struct object *gbLis } if (gbList == NULL) return(mmLarger_matrix_schreyer(f,g)); - /* modifiable: mmLarger_qmatrix */ + /* modifiable: mmLarger_qmatrix */ if (gbList->tag != Slist) { warningOrder("mmLarger_tower(): gbList must be in Slist.\n"); return(1); } if (klength(gbList) ==0) return(mmLarger_matrix(f,g)); - /* modifiable: mmLarger_qmatrix */ + /* modifiable: mmLarger_qmatrix */ gb = car(gbList); /* each entry must be monomials */ if (gb.tag != Sarray) { warningOrder("mmLarger_tower3(): car(gbList) must be an array.\n"); @@ -625,7 +673,8 @@ int mmLarger_tower3(POLY f,POLY g,struct object *gbLis if (fv >= t || gv >= t) { warningOrder("mmLarger_tower3(): incompatible input and gbList.\n"); printf("Length of gb is %d, f is %s, g is %s\n",t,KPOLYToString(f), - KPOLYToString(g)); + KPOLYToString(g)); + KSexecuteString(" show_ring "); return(1); } /* mpMult_poly is too expensive to call. @@@*/ @@ -637,15 +686,237 @@ int mmLarger_tower3(POLY f,POLY g,struct object *gbLis else if (fv > gv) return(0); /* modifiable */ else if (fv < gv) return(1); /* modifiable */ } - + +static struct object auxPruneZeroRow(struct object ob) { + int i,m,size; + struct object obt = OINIT; + struct object rob = OINIT; + m = getoaSize(ob); + size=0; + for (i=0; in; + m = ringp->orderMatrixSize; + om = ringp->order; + TransX = ringp->x; TransD = ringp->D; + if (m<=0) m = 1; + /*test: (1). getRing /rr set rr (oxRingStructure) dc */ + obMat = newObjectArray(m); + for (i=0; idegreeShiftSize) { + /*test: + [(x) ring_of_differential_operators [[(x)]] weight_vector 0 + [(weightedHomogenization) 1 (degreeShift) [[1 2 1]]] ] define_ring ; + (1). getRing /rr set rr (oxRingStructure) dc message + */ + obShift = newObjectArray(ringp->degreeShiftN); + for (i=0; idegreeShiftN; i++) { + obt = newObjectArray(ringp->degreeShiftSize); + for (j=0; j< ringp->degreeShiftSize; j++) { + putoa(obt,j,KpoUniversalNumber(newUniversalNumber(ringp->degreeShift[i*(ringp->degreeShiftSize)+j]))); + } + putoa(obShift,i,obt); + } + /* printObject(obShift,0,stderr); */ + } + + p = 0; + if (ringp->degreeShiftSize) { + rob = newObjectArray(3); + obt = newObjectArray(2); + putoa(obt,0,KpoString("degreeShift")); + putoa(obt,1,obShift); + putoa(rob,p, obt); p++; + }else { + rob = newObjectArray(2); + } + + obt = newObjectArray(2); + putoa(obt,0,KpoString("v")); + putoa(obt,1,obV); + putoa(rob,p, obt); p++; + + obt = newObjectArray(2); + putoa(obt,0,KpoString("order")); + putoa(obt,1,obMat); + putoa(rob,p, obt); p++; + + return(rob); +} +static int auxEffectiveVar(int idx,int n) { + int x; + if (idx < n) x=1; else x=0; + if (x) { + if ((idx >= 1) && (idx < n-1)) return 1; + else return 0; + }else{ + if ( 1 <= idx-n ) return 1; + else return 0; + } +} +/*test: + [(x,y) ring_of_differential_operators [[(Dx) 1 (Dy) 1]] + weight_vector 0] define_ring + (x). getRing (oxRingStructure) dc :: + */ +static struct object oRingToOXringStructure_short(struct ring *ringp) +{ + struct object rob = OINIT; + struct object ob2 = OINIT; + struct object obMat = OINIT; + struct object obV = OINIT; + struct object obShift = OINIT; + struct object obt = OINIT; + char **TransX; char **TransD; + int n,i,j,m,p,nonzero; + int *om; + n = ringp->n; + m = ringp->orderMatrixSize; + om = ringp->order; + TransX = ringp->x; TransD = ringp->D; + if (m<=0) m = 1; + /*test: (1). getRing /rr set rr (oxRingStructure) dc */ + obMat = newObjectArray(m); + for (i=0; idegreeShiftSize) { + /*test: + [(x) ring_of_differential_operators [[(x)]] weight_vector 0 + [(weightedHomogenization) 1 (degreeShift) [[1 2 1]]] ] define_ring ; + (1). getRing /rr set rr (oxRingStructure) dc message + */ + obShift = newObjectArray(ringp->degreeShiftN); + for (i=0; idegreeShiftN; i++) { + obt = newObjectArray(ringp->degreeShiftSize); + for (j=0; j< ringp->degreeShiftSize; j++) { + putoa(obt,j,KpoUniversalNumber(newUniversalNumber(ringp->degreeShift[i*(ringp->degreeShiftSize)+j]))); + } + putoa(obShift,i,obt); + } + /* printObject(obShift,0,stderr); */ + } + + p = 0; + if (ringp->degreeShiftSize) { + rob = newObjectArray(3); + obt = newObjectArray(2); + putoa(obt,0,KpoString("degreeShift")); + putoa(obt,1,obShift); + putoa(rob,p, obt); p++; + }else { + rob = newObjectArray(2); + } + + obt = newObjectArray(2); + putoa(obt,0,KpoString("v")); + putoa(obt,1,obV); + putoa(rob,p, obt); p++; + + obt = newObjectArray(2); + putoa(obt,0,KpoString("order")); + putoa(obt,1,obMat); + putoa(rob,p, obt); p++; + + return(rob); +} +struct object oRingToOXringStructure(struct ring *ringp) +{ + struct object rob = OINIT; + struct object tob = OINIT; + rob = newObjectArray(2); + tob = oRingToOXringStructure_short(ringp); + putoa(rob,0,tob); + tob = oRingToOXringStructure_long(ringp); + putoa(rob,1,tob); + return(rob); +} + static void warningOrder(s) -char *s; + char *s; { fprintf(stderr,"Warning in order.c: %s\n",s); } static void errorOrder(s) -char *s; + char *s; { fprintf(stderr,"order.c: %s\n",s); exit(14);