Annotation of OpenXM/src/kan96xx/Kan/order.c, Revision 1.4
1.4 ! takayama 1: /* $OpenXM: OpenXM/src/kan96xx/Kan/order.c,v 1.3 2000/06/09 08:02:02 takayama Exp $ */
1.1 maekawa 2: #include <stdio.h>
3: #include "datatype.h"
4: #include "stackm.h"
5: #include "extern.h"
6: #include "extern2.h"
7:
8: /* The format of order.
9: Example: graded lexicographic order
10: x_{N-1} x_{N-2} ... x_0 D_{N-1} .... D_{0}
11: 1 1 1 1 1
12: 1 0 0 0 0
13: 0 1 0 0 0
14: ..............................................
15:
16: (ringp->order)[i][j] should be (ringp->order)[i*2*N+j].
17: All order matrix is generated by functions in smacro.sm1
18: */
19:
20: static void warningOrder(char *s);
21: static void errorOrder(char *s);
22:
23: void setOrderByMatrix(order,n,c,l,omsize)
1.4 ! takayama 24: int order[];
! 25: int n,c,l,omsize;
1.1 maekawa 26: {
27: int i,j;
28: int *Order;
29: extern struct ring *CurrentRingp;
30:
31: switch_mmLarger("default");
1.4 ! takayama 32: /* q-case */
1.1 maekawa 33: if ( l-c > 0) {
34: switch_mmLarger("qmatrix");
35: }
36:
37: Order = (int *)sGC_malloc(sizeof(int)*(2*n)*(omsize));
38: if (Order == (int *)NULL) errorOrder("No memory.");
39: CurrentRingp->order = Order;
40: CurrentRingp->orderMatrixSize = omsize;
41: for (i=0; i<omsize; i++) {
42: for (j=0; j<2*n; j++) {
43: Order[i*2*n+j] = order[i*2*n+j];
44: }
45: }
46: }
47:
48: void showRing(level,ringp)
1.4 ! takayama 49: int level;
! 50: struct ring *ringp;
1.1 maekawa 51: {
52: int i,j;
53: FILE *fp;
54: char tmp[100];
55: int N,M,L,C,NN,MM,LL,CC;
56: char **TransX,**TransD;
57: int *Order;
58: int P;
59: char *mtype;
60: extern char *F_isSameComponent;
61: fp = stdout;
62:
63: N=ringp->n; M = ringp->m; L = ringp->l; C = ringp->c;
64: NN=ringp->nn; MM = ringp->mm; LL = ringp->ll; CC = ringp->cc;
65: TransX = ringp->x; TransD = ringp->D;
66: Order = ringp->order;
67: P = ringp->p;
68:
69:
70: fprintf(fp,"\n---------- the current ring ---- name: %s------\n",ringp->name);
71: fprintf(fp,"Characteristic is %d. ",P);
72: fprintf(fp,"N0=%d N=%d NN=%d M=%d MM=%d L=%d LL=%d C=%d CC=%d omsize=%d\n",N0,N,NN,M,MM,L,LL,C,CC,ringp->orderMatrixSize);
73: fprintf(fp,"\n");
74:
75: /* print identifier names */
76: if (N-M >0) {
77: fprintf(fp,"Differential variables: ");
78: for (i=M; i<N; i++) fprintf(fp," %4s ",TransX[i]);
79: for (i=M; i<N; i++) fprintf(fp," %4s ",TransD[i]);
80: fprintf(fp,"\n");
81: fprintf(fp,"where ");
82: for (i=M; i<N; i++) {
83: fprintf(fp," %s %s - %s %s = 1, ",TransD[i],TransX[i],
1.4 ! takayama 84: TransX[i],TransD[i]);
1.1 maekawa 85: }
86: fprintf(fp,"\n\n");
87: }
88: if (M-L >0) {
89: fprintf(fp,"Difference variables: ");
90: for (i=L; i<M; i++) fprintf(fp," %4s ",TransX[i]);
91: for (i=L; i<M; i++) fprintf(fp," %4s ",TransD[i]);
92: fprintf(fp,"\n");
93: fprintf(fp,"where ");
94: for (i=L; i<M; i++) {
95: fprintf(fp," %s %s - %s %s = %s, ",TransD[i],TransX[i],
1.4 ! takayama 96: TransX[i],TransD[i],
! 97: TransD[i]);
1.1 maekawa 98: }
99: fprintf(fp,"\n\n");
100: }
101: if (L-C >0) {
102: fprintf(fp,"q-Difference variables: ");
103: for (i=C; i<L; i++) fprintf(fp," %4s ",TransX[i]);
104: for (i=C; i<L; i++) fprintf(fp," %4s ",TransD[i]);
105: fprintf(fp,"\n");
106: fprintf(fp,"where ");
107: for (i=C; i<L; i++) {
108: fprintf(fp," %s %s = %s %s %s, ",TransD[i],TransX[i],
1.4 ! takayama 109: TransX[0],
! 110: TransX[i],TransD[i]);
1.1 maekawa 111: }
112: fprintf(fp,"\n\n");
113: }
114: if (C>0) {
115: fprintf(fp,"Commutative variables: ");
116: for (i=0; i<C; i++) fprintf(fp," %4s ",TransX[i]);
117: for (i=0; i<C; i++) fprintf(fp," %4s ",TransD[i]);
118: fprintf(fp,"\n\n");
119: }
120:
121: if (strcmp(F_isSameComponent,"x") == 0) {
122: fprintf(fp,"Integral or summation or graduation variables are : ");
123: for (i=CC; i<C; i++) fprintf(fp," %4s ",TransX[i]);
124: for (i=LL; i<L; i++) fprintf(fp," %4s ",TransX[i]);
125: for (i=MM; i<M; i++) fprintf(fp," %4s ",TransX[i]);
126: for (i=NN; i<N; i++) fprintf(fp," %4s ",TransX[i]);
127: fprintf(fp,"\n");
128: }else if (strcmp(F_isSameComponent,"xd") == 0) {
129: fprintf(fp,"Graduation variables are : ");
130: for (i=CC; i<C; i++) fprintf(fp," %4s ",TransX[i]);
131: for (i=LL; i<L; i++) fprintf(fp," %4s ",TransX[i]);
132: for (i=MM; i<M; i++) fprintf(fp," %4s ",TransX[i]);
133: for (i=NN; i<N; i++) fprintf(fp," %4s ",TransX[i]);
134: for (i=CC; i<C; i++) fprintf(fp," %4s ",TransD[i]);
135: for (i=LL; i<L; i++) fprintf(fp," %4s ",TransD[i]);
136: for (i=MM; i<M; i++) fprintf(fp," %4s ",TransD[i]);
137: for (i=NN; i<N; i++) fprintf(fp," %4s ",TransD[i]);
138: fprintf(fp,"\n");
139: }else {
140: fprintf(fp,"Unknown graduation variable specification.\n\n");
141: }
142: fprintf(fp,"The homogenization variable is : ");
143: fprintf(fp," %4s ",TransD[0]);
144: fprintf(fp,"\n");
145:
146:
147:
148: fprintf(fp,"-------------------------------------------\n");
149: fprintf(fp,"Output order : ");
150: for (i=0; i<2*N; i++) {
151: if (ringp->outputOrder[i] < N) {
152: fprintf(fp,"%s ",TransX[ringp->outputOrder[i]]);
153: }else{
154: fprintf(fp,"%s ",TransD[(ringp->outputOrder[i])-N]);
155: }
156: }
157: fprintf(fp,"\n");
158:
159: if (ringp->multiplication == mpMult_poly) {
160: mtype = "poly";
161: }else if (ringp->multiplication == mpMult_diff) {
162: mtype = "diff";
163: }else if (ringp->multiplication == mpMult_difference) {
164: mtype = "difference";
165: }else {
166: mtype = "unknown";
167: }
168: fprintf(fp,"Multiplication function --%s(%xH).\n",
1.4 ! takayama 169: mtype,(unsigned int) ringp->multiplication);
1.1 maekawa 170: if (ringp->schreyer) {
171: fprintf(fp,"schreyer=1, gbListTower=");
172: printObjectList((struct object *)(ringp->gbListTower));
173: fprintf(fp,"\n");
174: }
175:
176: if (level) printOrder(ringp);
177:
178: if (ringp->next != (struct ring *)NULL) {
179: fprintf(fp,"\n\n-------- The next ring is .... --------------\n");
180: showRing(level,ringp->next);
181: }
182: }
183:
184: /***************************************************************
185: functions related to order
186: ******************************************************************/
187: #define xtoi(k) ((N-1)-(k))
188: #define dtoi(k) ((2*N-1)-(k))
189: #define itox(k) ((N-1)-(k))
190: #define itod(k) ((2*N-1)-(k))
191: #define isX(i) (i<N? 1: 0)
192: #define isD(i) (i<N? 0: 1)
193: /****************************************************
194: i : 0 1 N-1 N 2N-1
195: x :x_{N-1} x_{N-2} x_0
196: d : D_{N-1} D_{0}
197: if (isX(i)) x_{itox(i)}
198: if (isD(i)) D_{itod(i)}
199: ******************************************************/
200: /* xtoi(0):N-1 xtoi(1):N-2 ....
201: dtoi(0):2N-1 dtoi(1):2N-2 ...
202: itod(N):N-1 dtoi(N-1):N ...
203: */
204:
205: void printOrder(ringp)
1.4 ! takayama 206: struct ring *ringp;
1.1 maekawa 207: {
208: int i,j;
209: FILE *fp;
210: char tmp[100];
211: int N,M,L,C,NN,MM,LL,CC;
212: char **TransX,**TransD;
213: int *Order;
214: int P;
215: int omsize;
216: extern char *F_isSameComponent;
217:
218: N=ringp->n; M = ringp->m; L = ringp->l; C = ringp->c;
219: NN=ringp->nn; MM = ringp->mm; LL = ringp->ll; CC = ringp->cc;
220: TransX = ringp->x; TransD = ringp->D;
221: Order = ringp->order;
222: P = ringp->p;
223: omsize = ringp->orderMatrixSize;
224:
225: fp = stdout;
226:
227:
228: for (i=0; i<2*N; i++) printf("%4d",i);
229: fprintf(fp,"\n");
230:
231: /* print variables names */
232: for (i=0; i<N; i++) {
233: sprintf(tmp,"x%d",N-1-i);
234: fprintf(fp,"%4s",tmp);
235: }
236: for (i=0; i<N; i++) {
237: sprintf(tmp,"D%d",N-1-i);
238: fprintf(fp,"%4s",tmp);
239: }
240: fprintf(fp,"\n");
241:
242: /* print identifier names */
243: for (i=0; i<N; i++) fprintf(fp,"%4s",TransX[itox(i)]);
244: for (i=N; i<2*N; i++) fprintf(fp,"%4s",TransD[itod(i)]);
245: fprintf(fp,"\n");
246:
247: /* print D: differential DE: differential, should be eliminated
1.4 ! takayama 248: E: difference
! 249: Q: q-difference
! 250: C: commutative
1.1 maekawa 251: */
252: if (strcmp(F_isSameComponent,"x")== 0 || strcmp(F_isSameComponent,"xd")==0) {
253: for (i=0; i<N; i++) {
254: if ((NN<=itox(i)) && (itox(i)<N)) fprintf(fp,"%4s","DE");
255: if ((M<=itox(i)) && (itox(i)<NN)) fprintf(fp,"%4s","D");
256: if ((MM<=itox(i)) && (itox(i)<M)) fprintf(fp,"%4s","EE");
257: if ((L<=itox(i)) && (itox(i)<MM)) fprintf(fp,"%4s","E");
258: if ((LL<=itox(i)) && (itox(i)<L)) fprintf(fp,"%4s","QE");
259: if ((C<=itox(i)) && (itox(i)<LL)) fprintf(fp,"%4s","Q");
260: if ((CC<=itox(i)) && (itox(i)<C)) fprintf(fp,"%4s","CE");
261: if ((0<=itox(i)) && (itox(i)<CC)) fprintf(fp,"%4s","C");
262: }
263: }
264: if (strcmp(F_isSameComponent,"x")==0) {
265: for (i=N; i<2*N; i++) {
266: if ((M<=itod(i)) && (itod(i)<N)) fprintf(fp,"%4s","D");
267: if ((L<=itod(i)) && (itod(i)<M)) fprintf(fp,"%4s","E");
268: if ((C<=itod(i)) && (itod(i)<L)) fprintf(fp,"%4s","Q");
269: if ((0<=itod(i)) && (itod(i)<C)) fprintf(fp,"%4s","C");
270: }
271: }else if (strcmp(F_isSameComponent,"xd")==0) {
272: for (i=N; i<2*N; i++) {
273: if ((NN<=itod(i)) && (itod(i)<N)) fprintf(fp,"%4s","DE");
274: if ((M<=itod(i)) && (itod(i)<NN)) fprintf(fp,"%4s","D");
275: if ((MM<=itod(i)) && (itod(i)<M)) fprintf(fp,"%4s","EE");
276: if ((L<=itod(i)) && (itod(i)<MM)) fprintf(fp,"%4s","E");
277: if ((LL<=itod(i)) && (itod(i)<L)) fprintf(fp,"%4s","QE");
278: if ((C<=itod(i)) && (itod(i)<LL)) fprintf(fp,"%4s","Q");
279: if ((CC<=itod(i)) && (itod(i)<C)) fprintf(fp,"%4s","CE");
280: if ((0<=itod(i)) && (itod(i)<CC)) fprintf(fp,"%4s","C");
281: }
282: } else {
283: fprintf(fp,"Unknown graduation variable type.\n");
284: }
285: fprintf(fp,"\n");
286:
287: for (i=0; i< omsize; i++) {
288: for (j=0; j<2*N; j++) {
289: fprintf(fp,"%4d", Order[i*2*N+j]);
290: }
291: fprintf(fp,"\n");
292: }
293: fprintf(fp,"\n");
294:
295: }
296:
297: struct object oGetOrderMatrix(struct ring *ringp)
298: {
299: struct object rob,ob2;
300: int n,i,j,m;
301: int *om;
302: n = ringp->n;
303: m = ringp->orderMatrixSize;
304: om = ringp->order;
305: if (m<=0) m = 1;
306: rob = newObjectArray(m);
307: for (i=0; i<m; i++) {
308: ob2 = newObjectArray(2*n);
309: for (j=0; j<2*n; j++) {
310: putoa(ob2,j,KpoInteger(om[2*n*i+j]));
311: }
312: putoa(rob,i,ob2);
313: }
314: return(rob);
315: }
316:
317:
318: int mmLarger_matrix(ff,gg)
1.4 ! takayama 319: POLY ff; POLY gg;
1.1 maekawa 320: {
321: int exp[2*N0]; /* exponents */
322: int i,k;
323: int sum,flag;
324: int *Order;
325: int N;
326: MONOMIAL f,g;
327: struct ring *rp;
328: int in2;
329: int *from, *to;
330: int omsize;
331:
332: if (ff == POLYNULL ) {
333: if (gg == POLYNULL) return( 2 );
334: else return( 0 );
335: }
336: if (gg == POLYNULL) {
337: if (ff == POLYNULL) return( 2 );
338: else return( 1 );
339: }
340: f = ff->m; g=gg->m;
341:
342: rp = f->ringp;
343: Order = rp->order;
344: N = rp->n;
345: from = rp->from;
346: to = rp->to;
347: omsize = rp->orderMatrixSize;
348:
349: flag = 1;
350: for (i=N-1,k=0; i>=0; i--,k++) {
351: exp[k] = (f->e[i].x) - (g->e[i].x);
352: exp[k+N] = (f->e[i].D) - (g->e[i].D);
353: if ((exp[k] != 0) || (exp[k+N] != 0)) flag =0;
354: }
355: if (flag==1) return(2);
356: /* exp > 0 <---> f>g
357: exp = 0 <---> f=g
358: exp < 0 <---> f<g
359: */
360: for (i=0; i< omsize; i++) {
361: sum = 0; in2 = i*2*N;
362: /* for (k=0; k<2*N; k++) sum += exp[k]*Order[in2+k]; */
363: for (k=from[i]; k<to[i]; k++) sum += exp[k]*Order[in2+k];
364: if (sum > 0) return(1);
365: if (sum < 0) return(0);
366: }
367: return(2);
368: }
369:
370: /* This should be used in case of q */
371: int mmLarger_qmatrix(ff,gg)
1.4 ! takayama 372: POLY ff; POLY gg;
1.1 maekawa 373: {
374: int exp[2*N0]; /* exponents */
375: int i,k;
376: int sum,flag;
377: int *Order;
378: int N;
379: MONOMIAL f,g;
380: int omsize;
381:
382: if (ff == POLYNULL ) {
383: if (gg == POLYNULL) return( 2 );
384: else return( 0 );
385: }
386: if (gg == POLYNULL) {
387: if (ff == POLYNULL) return( 2 );
388: else return( 1 );
389: }
390: f = ff->m; g = gg->m;
391: Order = f->ringp->order;
392: N = f->ringp->n;
393: omsize = f->ringp->orderMatrixSize;
394:
395: flag = 1;
396: for (i=N-1,k=0; i>=0; i--,k++) {
397: exp[k] = (f->e[i].x) - (g->e[i].x);
398: exp[k+N] = (f->e[i].D) - (g->e[i].D);
399: if ((exp[k] != 0) || (exp[k+N] != 0)) flag =0;
400: }
401: if (flag==1) return(2);
402: /* exp > 0 <---> f>g
403: exp = 0 <---> f=g
404: exp < 0 <---> f<g
405: */
406: for (i=0; i< omsize; i++) {
407: sum = 0;
408: /* In case of q, you should do as follows */
409: for (k=0; k<N-1; k++) sum += exp[k]*Order[i*2*N+k]; /* skip k= N-1 -->q */
410: for (k=N; k<2*N-1; k++) sum += exp[k]*Order[i*2*N+k]; /* SKip k= 2*N-1 */
411: if (sum > 0) return(1);
412: else if (sum < 0) return(0);
413: }
414: if (exp[N-1] > 0) return(1);
415: else if (exp[N-1] < 0) return(0);
416: else return(2);
417: }
418:
419: /* x(N-1)>x(N-2)>....>D(N-1)>....>D(0) */
420: mmLarger_pureLexicographic(f,g)
1.4 ! takayama 421: POLY f;
! 422: POLY g;
1.1 maekawa 423: {
424: int i,r;
425: int n;
426: MONOMIAL fm,gm;
427: /* Note that this function ignores the order matrix of the given
428: ring. */
429: if (f == POLYNULL ) {
430: if (g == POLYNULL) return( 2 );
431: else return( 0 );
432: }
433: if (g == POLYNULL) {
434: if (f == POLYNULL) return( 2 );
435: else return( 1 );
436: }
437:
438:
439: fm = f->m; gm = g->m;
440: n = fm->ringp->n;
441: for (i=n-1; i>=0; i--) {
442: r = (fm->e[i].x) - (gm->e[i].x);
443: if (r > 0) return(1);
444: else if (r < 0) return(0);
445: else ;
446: }
447:
448: for (i=n-1; i>=0; i--) {
449: r = (fm->e[i].D) - (gm->e[i].D);
450: if (r > 0) return(1);
451: else if (r < 0) return(0);
452: else ;
453: }
454:
455: return(2);
456:
457: }
458:
459:
460: void setFromTo(ringp)
1.4 ! takayama 461: struct ring *ringp;
1.1 maekawa 462: {
463: int n;
464: int i,j,oasize;
465: if (ringp->order == (int *)NULL) errorOrder("setFromTo(); no order matrix.");
466: n = (ringp->n)*2;
467: oasize = ringp->orderMatrixSize;
468: ringp->from = (int *)sGC_malloc(sizeof(int)*oasize);
469: ringp->to = (int *)sGC_malloc(sizeof(int)*oasize);
470: if (ringp->from == (int *)NULL || ringp->to == (int *)NULL) {
471: errorOrder("setFromTo(): No memory.");
472: }
473: for (i=0; i<oasize; i++) {
474: ringp->from[i] = 0; ringp->to[i] = n;
475: for (j=0; j<n; j++) {
476: if (ringp->order[i*n+j] != 0) {
1.4 ! takayama 477: ringp->from[i] = j;
! 478: break;
1.1 maekawa 479: }
480: }
481: for (j=n-1; j>=0; j--) {
482: if (ringp->order[i*n+j] != 0) {
1.4 ! takayama 483: ringp->to[i] = j+1;
! 484: break;
1.1 maekawa 485: }
486: }
487: }
488: }
489:
490: /* It ignores h and should be used with mmLarger_tower */
491: /* cf. mmLarger_matrix. h always must be checked at last. */
492: static int mmLarger_matrix_schreyer(ff,gg)
1.4 ! takayama 493: POLY ff; POLY gg;
1.1 maekawa 494: {
495: int exp[2*N0]; /* exponents */
496: int i,k;
497: int sum,flag;
498: int *Order;
499: int N;
500: MONOMIAL f,g;
501: struct ring *rp;
502: int in2;
503: int *from, *to;
504: int omsize;
505:
506: if (ff == POLYNULL ) {
507: if (gg == POLYNULL) return( 2 );
508: else return( 0 );
509: }
510: if (gg == POLYNULL) {
511: if (ff == POLYNULL) return( 2 );
512: else return( 1 );
513: }
514: f = ff->m; g=gg->m;
515:
516: rp = f->ringp;
517: Order = rp->order;
518: N = rp->n;
519: from = rp->from;
520: to = rp->to;
521: omsize = rp->orderMatrixSize;
522:
523: flag = 1;
524: for (i=N-1,k=0; i>0; i--,k++) {
525: exp[k] = (f->e[i].x) - (g->e[i].x);
526: exp[k+N] = (f->e[i].D) - (g->e[i].D);
527: if ((exp[k] != 0) || (exp[k+N] != 0)) flag =0;
528: }
529: exp[N-1] = (f->e[0].x) - (g->e[0].x);
530: exp[2*N-1] = 0; /* f->e[0].D - g->e[0].D. Ignore h! */
531: if ((exp[N-1] != 0) || (exp[2*N-1] != 0)) flag =0;
532:
533: if (flag==1) return(2);
534: /* exp > 0 <---> f>g
535: exp = 0 <---> f=g
536: exp < 0 <---> f<g
537: */
538: for (i=0; i< omsize; i++) {
539: sum = 0; in2 = i*2*N;
540: /* for (k=0; k<2*N; k++) sum += exp[k]*Order[in2+k]; */
541: for (k=from[i]; k<to[i]; k++) sum += exp[k]*Order[in2+k];
542: if (sum > 0) return(1);
543: if (sum < 0) return(0);
544: }
545: return(2);
546: }
547:
548: int mmLarger_tower(POLY f,POLY g) {
549: struct object *gbList;
550: int r;
551: if (f == POLYNULL) {
552: if (g == POLYNULL) return(2);
553: else return(0);
554: }
555: if (g == POLYNULL) {
556: if (f == POLYNULL) return(2);
557: else return(1);
558: }
559: if (!(f->m->ringp->schreyer) || !(g->m->ringp->schreyer))
560: return(mmLarger_matrix(f,g));
1.4 ! takayama 561: /* modifiable: mmLarger_qmatrix */
1.1 maekawa 562: gbList = (struct object *)(g->m->ringp->gbListTower);
563: if (gbList == NULL) return(mmLarger_matrix(f,g));
1.4 ! takayama 564: /* modifiable: mmLarger_qmatrix */
1.1 maekawa 565: if (gbList->tag != Slist) {
566: warningOrder("mmLarger_tower(): gbList must be in Slist.\n");
567: return(1);
568: }
569: if (klength(gbList) ==0) return(mmLarger_matrix(f,g));
1.4 ! takayama 570: /* modifiable: mmLarger_qmatrix */
1.1 maekawa 571:
572: r = mmLarger_tower3(f,g,gbList);
573: /* printf("mmLarger_tower3(%s,%s) --> %d\n",POLYToString(head(f),'*',1),POLYToString(head(g),'*',1),r); */
574: if (r == 2) { /* Now, compare by h */
575: if (f->m->e[0].D > g->m->e[0].D) return(1);
576: else if (f->m->e[0].D < g->m->e[0].D) return(0);
577: else return(2);
578: }else{
579: return(r);
580: }
581: }
582:
583: int mmLarger_tower3(POLY f,POLY g,struct object *gbList)
584: { /* gbList is assumed to be Slist */
585: int n,fv,gv,t,r,nn;
586: POLY fm;
587: POLY gm;
588: struct object gb;
589:
590: if (f == POLYNULL) {
591: if (g == POLYNULL) return(2);
592: else return(0);
593: }
594: if (g == POLYNULL) {
595: if (f == POLYNULL) return(2);
596: else return(1); /* It assumes the zero is the minimum element!! */
597: }
598: n = f->m->ringp->n;
599: nn = f->m->ringp->nn;
600: /* critical and modifiable */ /* m e_u > m e_v <==> m g_u > m g_v */
1.4 ! takayama 601: /* or equal and u < v */
1.1 maekawa 602: fv = f->m->e[nn].x ; /* extract component (vector) number of f! */
603: gv = g->m->e[nn].x ;
604: if (fv == gv) { /* They have the same component number. */
605: return(mmLarger_matrix_schreyer(f,g));
606: }
607:
608: if (gbList == NULL) return(mmLarger_matrix_schreyer(f,g));
1.4 ! takayama 609: /* modifiable: mmLarger_qmatrix */
1.1 maekawa 610: if (gbList->tag != Slist) {
611: warningOrder("mmLarger_tower(): gbList must be in Slist.\n");
612: return(1);
613: }
614: if (klength(gbList) ==0) return(mmLarger_matrix(f,g));
1.4 ! takayama 615: /* modifiable: mmLarger_qmatrix */
1.1 maekawa 616: gb = car(gbList); /* each entry must be monomials */
617: if (gb.tag != Sarray) {
618: warningOrder("mmLarger_tower3(): car(gbList) must be an array.\n");
619: return(1);
620: }
621: t = getoaSize(gb);
622: if (t == 0) return(mmLarger_tower3(f,g,cdr(gbList)));
623:
624: fm = pmCopy(head(f)); fm->m->e[nn].x = 0; /* f is not modified. */
625: gm = pmCopy(head(g)); gm->m->e[nn].x = 0;
626: if (fv >= t || gv >= t) {
627: warningOrder("mmLarger_tower3(): incompatible input and gbList.\n");
628: printf("Length of gb is %d, f is %s, g is %s\n",t,KPOLYToString(f),
1.4 ! takayama 629: KPOLYToString(g));
1.3 takayama 630: KSexecuteString(" show_ring ");
1.1 maekawa 631: return(1);
632: }
633: /* mpMult_poly is too expensive to call. @@@*/
634: r = mmLarger_tower3(mpMult_poly(fm,KopPOLY(getoa(gb,fv))),
635: mpMult_poly(gm,KopPOLY(getoa(gb,gv))),
636: cdr(gbList));
637: if (r != 2) return(r);
638: else if (fv == gv) return(2);
639: else if (fv > gv) return(0); /* modifiable */
640: else if (fv < gv) return(1); /* modifiable */
641: }
642:
643: static void warningOrder(s)
1.4 ! takayama 644: char *s;
1.1 maekawa 645: {
646: fprintf(stderr,"Warning in order.c: %s\n",s);
647: }
648:
649: static void errorOrder(s)
1.4 ! takayama 650: char *s;
1.1 maekawa 651: {
652: fprintf(stderr,"order.c: %s\n",s);
653: exit(14);
654: }
655:
656:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to order.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / kan96xx / Kan