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