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