![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to dist.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib2 / asir2000 / engine|
Return to dist.c CVS log | Up to [local] / OpenXM_contrib2 / asir2000 / engine |
1.8 noro 1: /*
2: * Copyright (c) 1994-2000 FUJITSU LABORATORIES LIMITED
3: * All rights reserved.
4: *
5: * FUJITSU LABORATORIES LIMITED ("FLL") hereby grants you a limited,
6: * non-exclusive and royalty-free license to use, copy, modify and
7: * redistribute, solely for non-commercial and non-profit purposes, the
8: * computer program, "Risa/Asir" ("SOFTWARE"), subject to the terms and
9: * conditions of this Agreement. For the avoidance of doubt, you acquire
10: * only a limited right to use the SOFTWARE hereunder, and FLL or any
11: * third party developer retains all rights, including but not limited to
12: * copyrights, in and to the SOFTWARE.
13: *
14: * (1) FLL does not grant you a license in any way for commercial
15: * purposes. You may use the SOFTWARE only for non-commercial and
16: * non-profit purposes only, such as academic, research and internal
17: * business use.
18: * (2) The SOFTWARE is protected by the Copyright Law of Japan and
19: * international copyright treaties. If you make copies of the SOFTWARE,
20: * with or without modification, as permitted hereunder, you shall affix
21: * to all such copies of the SOFTWARE the above copyright notice.
22: * (3) An explicit reference to this SOFTWARE and its copyright owner
23: * shall be made on your publication or presentation in any form of the
24: * results obtained by use of the SOFTWARE.
25: * (4) In the event that you modify the SOFTWARE, you shall notify FLL by
1.9 noro 26: * e-mail at risa-admin@sec.flab.fujitsu.co.jp of the detailed specification
1.8 noro 27: * for such modification or the source code of the modified part of the
28: * SOFTWARE.
29: *
30: * THE SOFTWARE IS PROVIDED AS IS WITHOUT ANY WARRANTY OF ANY KIND. FLL
31: * MAKES ABSOLUTELY NO WARRANTIES, EXPRESSED, IMPLIED OR STATUTORY, AND
32: * EXPRESSLY DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS
33: * FOR A PARTICULAR PURPOSE OR NONINFRINGEMENT OF THIRD PARTIES'
34: * RIGHTS. NO FLL DEALER, AGENT, EMPLOYEES IS AUTHORIZED TO MAKE ANY
35: * MODIFICATIONS, EXTENSIONS, OR ADDITIONS TO THIS WARRANTY.
36: * UNDER NO CIRCUMSTANCES AND UNDER NO LEGAL THEORY, TORT, CONTRACT,
37: * OR OTHERWISE, SHALL FLL BE LIABLE TO YOU OR ANY OTHER PERSON FOR ANY
38: * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, PUNITIVE OR CONSEQUENTIAL
39: * DAMAGES OF ANY CHARACTER, INCLUDING, WITHOUT LIMITATION, DAMAGES
40: * ARISING OUT OF OR RELATING TO THE SOFTWARE OR THIS AGREEMENT, DAMAGES
41: * FOR LOSS OF GOODWILL, WORK STOPPAGE, OR LOSS OF DATA, OR FOR ANY
42: * DAMAGES, EVEN IF FLL SHALL HAVE BEEN INFORMED OF THE POSSIBILITY OF
43: * SUCH DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY. EVEN IF A PART
44: * OF THE SOFTWARE HAS BEEN DEVELOPED BY A THIRD PARTY, THE THIRD PARTY
45: * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
46: * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
47: *
1.24 ! noro 48: * $OpenXM: OpenXM_contrib2/asir2000/engine/dist.c,v 1.23 2003/05/28 07:32:32 noro Exp $
1.8 noro 49: */
1.1 noro 50: #include "ca.h"
51:
52: #define ORD_REVGRADLEX 0
53: #define ORD_GRADLEX 1
54: #define ORD_LEX 2
55: #define ORD_BREVGRADLEX 3
56: #define ORD_BGRADLEX 4
57: #define ORD_BLEX 5
58: #define ORD_BREVREV 6
59: #define ORD_BGRADREV 7
60: #define ORD_BLEXREV 8
61: #define ORD_ELIM 9
1.12 noro 62: #define ORD_WEYL_ELIM 10
1.13 noro 63: #define ORD_HOMO_WW_DRL 11
1.21 noro 64: #define ORD_DRL_ZIGZAG 12
65: #define ORD_HOMO_WW_DRL_ZIGZAG 13
66:
67: int cmpdl_drl_zigzag(), cmpdl_homo_ww_drl_zigzag();
1.1 noro 68:
69: int (*cmpdl)()=cmpdl_revgradlex;
70: int (*primitive_cmpdl[3])() = {cmpdl_revgradlex,cmpdl_gradlex,cmpdl_lex};
71:
1.2 noro 72: int do_weyl;
73:
1.1 noro 74: int dp_nelim,dp_fcoeffs;
75: struct order_spec dp_current_spec;
76: int *dp_dl_work;
77:
1.24 ! noro 78: void comm_muld_trunc(VL vl,DP p1,DP p2,DL dl,DP *pr);
! 79: void comm_quod(VL vl,DP p1,DP p2,DP *pr);
! 80: void muldm_trunc(VL vl,DP p,MP m0,DL dl,DP *pr);
! 81: void muldc_trunc(VL vl,DP p,P c,DL dl,DP *pr);
! 82:
1.22 noro 83: int has_sfcoef(DP f)
1.1 noro 84: {
85: MP t;
86:
87: if ( !f )
88: return 0;
89: for ( t = BDY(f); t; t = NEXT(t) )
1.22 noro 90: if ( has_sfcoef_p(t->c) )
1.1 noro 91: break;
92: return t ? 1 : 0;
93: }
94:
1.22 noro 95: int has_sfcoef_p(P f)
1.1 noro 96: {
97: DCP dc;
98:
99: if ( !f )
100: return 0;
101: else if ( NUM(f) )
1.22 noro 102: return (NID((Num)f) == N_GFS) ? 1 : 0;
1.1 noro 103: else {
104: for ( dc = DC(f); dc; dc = NEXT(dc) )
1.22 noro 105: if ( has_sfcoef_p(COEF(dc)) )
1.1 noro 106: return 1;
107: return 0;
108: }
109: }
110:
1.19 noro 111: void initd(struct order_spec *spec)
1.1 noro 112: {
113: switch ( spec->id ) {
114: case 2:
115: cmpdl = cmpdl_matrix;
116: dp_dl_work = (int *)MALLOC_ATOMIC(spec->nv*sizeof(int));
117: break;
118: case 1:
119: cmpdl = cmpdl_order_pair;
120: break;
121: default:
122: switch ( spec->ord.simple ) {
123: case ORD_REVGRADLEX:
124: cmpdl = cmpdl_revgradlex; break;
125: case ORD_GRADLEX:
126: cmpdl = cmpdl_gradlex; break;
127: case ORD_BREVGRADLEX:
128: cmpdl = cmpdl_brevgradlex; break;
129: case ORD_BGRADLEX:
130: cmpdl = cmpdl_bgradlex; break;
131: case ORD_BLEX:
132: cmpdl = cmpdl_blex; break;
133: case ORD_BREVREV:
134: cmpdl = cmpdl_brevrev; break;
135: case ORD_BGRADREV:
136: cmpdl = cmpdl_bgradrev; break;
137: case ORD_BLEXREV:
138: cmpdl = cmpdl_blexrev; break;
139: case ORD_ELIM:
140: cmpdl = cmpdl_elim; break;
1.12 noro 141: case ORD_WEYL_ELIM:
142: cmpdl = cmpdl_weyl_elim; break;
1.13 noro 143: case ORD_HOMO_WW_DRL:
144: cmpdl = cmpdl_homo_ww_drl; break;
1.21 noro 145: case ORD_DRL_ZIGZAG:
146: cmpdl = cmpdl_drl_zigzag; break;
147: case ORD_HOMO_WW_DRL_ZIGZAG:
148: cmpdl = cmpdl_homo_ww_drl_zigzag; break;
1.1 noro 149: case ORD_LEX: default:
150: cmpdl = cmpdl_lex; break;
151: }
152: break;
153: }
154: dp_current_spec = *spec;
155: }
156:
1.19 noro 157: void ptod(VL vl,VL dvl,P p,DP *pr)
1.1 noro 158: {
159: int isconst = 0;
1.16 noro 160: int n,i,j,k;
1.1 noro 161: VL tvl;
162: V v;
163: DL d;
164: MP m;
165: DCP dc;
1.16 noro 166: DCP *w;
1.1 noro 167: DP r,s,t,u;
168: P x,c;
169:
170: if ( !p )
171: *pr = 0;
172: else {
173: for ( n = 0, tvl = dvl; tvl; tvl = NEXT(tvl), n++ );
174: if ( NUM(p) ) {
175: NEWDL(d,n);
176: NEWMP(m); m->dl = d; C(m) = p; NEXT(m) = 0; MKDP(n,m,*pr); (*pr)->sugar = 0;
177: } else {
178: for ( i = 0, tvl = dvl, v = VR(p);
179: tvl && tvl->v != v; tvl = NEXT(tvl), i++ );
180: if ( !tvl ) {
1.16 noro 181: for ( dc = DC(p), k = 0; dc; dc = NEXT(dc), k++ );
182: w = (DCP *)ALLOCA(k*sizeof(DCP));
183: for ( dc = DC(p), j = 0; j < k; dc = NEXT(dc), j++ )
184: w[j] = dc;
185:
186: for ( j = k-1, s = 0, MKV(v,x); j >= 0; j-- ) {
187: ptod(vl,dvl,COEF(w[j]),&t); pwrp(vl,x,DEG(w[j]),&c);
1.1 noro 188: muldc(vl,t,c,&r); addd(vl,r,s,&t); s = t;
189: }
190: *pr = s;
191: } else {
1.16 noro 192: for ( dc = DC(p), k = 0; dc; dc = NEXT(dc), k++ );
193: w = (DCP *)ALLOCA(k*sizeof(DCP));
194: for ( dc = DC(p), j = 0; j < k; dc = NEXT(dc), j++ )
195: w[j] = dc;
196:
197: for ( j = k-1, s = 0; j >= 0; j-- ) {
198: ptod(vl,dvl,COEF(w[j]),&t);
1.20 noro 199: NEWDL(d,n); d->d[i] = QTOS(DEG(w[j]));
200: d->td = MUL_WEIGHT(d->d[i],i);
1.1 noro 201: NEWMP(m); m->dl = d; C(m) = (P)ONE; NEXT(m) = 0; MKDP(n,m,u); u->sugar = d->td;
1.2 noro 202: comm_muld(vl,t,u,&r); addd(vl,r,s,&t); s = t;
1.1 noro 203: }
204: *pr = s;
205: }
206: }
207: }
1.17 noro 208: #if 0
1.22 noro 209: if ( !dp_fcoeffs && has_sfcoef(*pr) )
210: dp_fcoeffs = N_GFS;
1.17 noro 211: #endif
1.1 noro 212: }
213:
1.19 noro 214: void dtop(VL vl,VL dvl,DP p,P *pr)
1.1 noro 215: {
1.16 noro 216: int n,i,j,k;
1.1 noro 217: DL d;
218: MP m;
1.16 noro 219: MP *a;
1.1 noro 220: P r,s,t,u,w;
221: Q q;
222: VL tvl;
223:
224: if ( !p )
225: *pr = 0;
226: else {
1.16 noro 227: for ( k = 0, m = BDY(p); m; m = NEXT(m), k++ );
228: a = (MP *)ALLOCA(k*sizeof(MP));
229: for ( j = 0, m = BDY(p); j < k; m = NEXT(m), j++ )
230: a[j] = m;
231:
232: for ( n = p->nv, j = k-1, s = 0; j >= 0; j-- ) {
233: m = a[j];
1.1 noro 234: t = C(m);
235: if ( NUM(t) && NID((Num)t) == N_M ) {
236: mptop(t,&u); t = u;
237: }
238: for ( i = 0, d = m->dl, tvl = dvl;
239: i < n; tvl = NEXT(tvl), i++ ) {
240: MKV(tvl->v,r); STOQ(d->d[i],q); pwrp(vl,r,q,&u);
241: mulp(vl,t,u,&w); t = w;
242: }
243: addp(vl,s,t,&u); s = u;
244: }
245: *pr = s;
246: }
247: }
248:
1.19 noro 249: void nodetod(NODE node,DP *dp)
1.1 noro 250: {
251: NODE t;
252: int len,i,td;
253: Q e;
254: DL d;
255: MP m;
256: DP u;
257:
258: for ( t = node, len = 0; t; t = NEXT(t), len++ );
259: NEWDL(d,len);
260: for ( t = node, i = 0, td = 0; i < len; t = NEXT(t), i++ ) {
261: e = (Q)BDY(t);
262: if ( !e )
263: d->d[i] = 0;
264: else if ( !NUM(e) || !RATN(e) || !INT(e) )
265: error("nodetod : invalid input");
266: else {
1.20 noro 267: d->d[i] = QTOS((Q)e); td += MUL_WEIGHT(d->d[i],i);
1.1 noro 268: }
269: }
270: d->td = td;
271: NEWMP(m); m->dl = d; C(m) = (P)ONE; NEXT(m) = 0;
272: MKDP(len,m,u); u->sugar = td; *dp = u;
273: }
274:
1.19 noro 275: int sugard(MP m)
1.1 noro 276: {
277: int s;
278:
279: for ( s = 0; m; m = NEXT(m) )
280: s = MAX(s,m->dl->td);
281: return s;
282: }
283:
1.19 noro 284: void addd(VL vl,DP p1,DP p2,DP *pr)
1.1 noro 285: {
286: int n;
287: MP m1,m2,mr,mr0;
288: P t;
289:
290: if ( !p1 )
291: *pr = p2;
292: else if ( !p2 )
293: *pr = p1;
294: else {
295: for ( n = NV(p1), m1 = BDY(p1), m2 = BDY(p2), mr0 = 0; m1 && m2; )
296: switch ( (*cmpdl)(n,m1->dl,m2->dl) ) {
297: case 0:
298: addp(vl,C(m1),C(m2),&t);
299: if ( t ) {
300: NEXTMP(mr0,mr); mr->dl = m1->dl; C(mr) = t;
301: }
302: m1 = NEXT(m1); m2 = NEXT(m2); break;
303: case 1:
304: NEXTMP(mr0,mr); mr->dl = m1->dl; C(mr) = C(m1);
305: m1 = NEXT(m1); break;
306: case -1:
307: NEXTMP(mr0,mr); mr->dl = m2->dl; C(mr) = C(m2);
308: m2 = NEXT(m2); break;
309: }
310: if ( !mr0 )
311: if ( m1 )
312: mr0 = m1;
313: else if ( m2 )
314: mr0 = m2;
315: else {
316: *pr = 0;
317: return;
318: }
319: else if ( m1 )
320: NEXT(mr) = m1;
321: else if ( m2 )
322: NEXT(mr) = m2;
323: else
324: NEXT(mr) = 0;
325: MKDP(NV(p1),mr0,*pr);
326: if ( *pr )
327: (*pr)->sugar = MAX(p1->sugar,p2->sugar);
328: }
329: }
330:
331: /* for F4 symbolic reduction */
332:
1.19 noro 333: void symb_addd(DP p1,DP p2,DP *pr)
1.1 noro 334: {
335: int n;
336: MP m1,m2,mr,mr0;
337:
338: if ( !p1 )
339: *pr = p2;
340: else if ( !p2 )
341: *pr = p1;
342: else {
343: for ( n = NV(p1), m1 = BDY(p1), m2 = BDY(p2), mr0 = 0; m1 && m2; ) {
344: NEXTMP(mr0,mr); C(mr) = (P)ONE;
345: switch ( (*cmpdl)(n,m1->dl,m2->dl) ) {
346: case 0:
347: mr->dl = m1->dl;
348: m1 = NEXT(m1); m2 = NEXT(m2); break;
349: case 1:
350: mr->dl = m1->dl;
351: m1 = NEXT(m1); break;
352: case -1:
353: mr->dl = m2->dl;
354: m2 = NEXT(m2); break;
355: }
356: }
357: if ( !mr0 )
358: if ( m1 )
359: mr0 = m1;
360: else if ( m2 )
361: mr0 = m2;
362: else {
363: *pr = 0;
364: return;
365: }
366: else if ( m1 )
367: NEXT(mr) = m1;
368: else if ( m2 )
369: NEXT(mr) = m2;
370: else
371: NEXT(mr) = 0;
372: MKDP(NV(p1),mr0,*pr);
373: if ( *pr )
374: (*pr)->sugar = MAX(p1->sugar,p2->sugar);
1.3 noro 375: }
376: }
377:
378: /*
379: * destructive merge of two list
380: *
381: * p1, p2 : list of DL
382: * return : a merged list
383: */
384:
1.19 noro 385: NODE symb_merge(NODE m1,NODE m2,int n)
1.3 noro 386: {
387: NODE top,prev,cur,m,t;
388:
389: if ( !m1 )
390: return m2;
391: else if ( !m2 )
392: return m1;
393: else {
394: switch ( (*cmpdl)(n,(DL)BDY(m1),(DL)BDY(m2)) ) {
395: case 0:
396: top = m1; m = NEXT(m2);
397: break;
398: case 1:
399: top = m1; m = m2;
400: break;
401: case -1:
402: top = m2; m = m1;
403: break;
404: }
405: prev = top; cur = NEXT(top);
406: /* BDY(prev) > BDY(m) always holds */
407: while ( cur && m ) {
408: switch ( (*cmpdl)(n,(DL)BDY(cur),(DL)BDY(m)) ) {
409: case 0:
410: m = NEXT(m);
411: prev = cur; cur = NEXT(cur);
412: break;
413: case 1:
414: t = NEXT(cur); NEXT(cur) = m; m = t;
415: prev = cur; cur = NEXT(cur);
416: break;
417: case -1:
418: NEXT(prev) = m; m = cur;
419: prev = NEXT(prev); cur = NEXT(prev);
420: break;
1.18 noro 421: }
422: }
423: if ( !cur )
424: NEXT(prev) = m;
1.23 noro 425: return top;
426: }
427: }
428:
429: void _adddl(int n,DL d1,DL d2,DL d3)
430: {
431: int i;
432:
433: d3->td = d1->td+d2->td;
434: for ( i = 0; i < n; i++ )
435: d3->d[i] = d1->d[i]+d2->d[i];
436: }
437:
438: /* m1 <- m1 U dl*f, destructive */
439:
440: NODE mul_dllist(DL dl,DP f);
441:
442: NODE symb_mul_merge(NODE m1,DL dl,DP f,int n)
443: {
444: NODE top,prev,cur,n1;
445: DP g;
446: DL t,s;
447: MP m;
448:
449: if ( !m1 )
450: return mul_dllist(dl,f);
451: else if ( !f )
452: return m1;
453: else {
454: m = BDY(f);
455: NEWDL_NOINIT(t,n);
456: _adddl(n,m->dl,dl,t);
457: top = m1; prev = 0; cur = m1;
458: while ( m ) {
459: switch ( (*cmpdl)(n,(DL)BDY(cur),t) ) {
460: case 0:
461: prev = cur; cur = NEXT(cur);
462: if ( !cur ) {
463: MKDP(n,m,g);
464: NEXT(prev) = mul_dllist(dl,g);
465: return;
466: }
467: m = NEXT(m);
468: if ( m ) _adddl(n,m->dl,dl,t);
469: break;
470: case 1:
471: prev = cur; cur = NEXT(cur);
472: if ( !cur ) {
473: MKDP(n,m,g);
474: NEXT(prev) = mul_dllist(dl,g);
475: return;
476: }
477: break;
478: case -1:
479: NEWDL_NOINIT(s,n);
480: s->td = t->td;
481: bcopy(t->d,s->d,n*sizeof(int));
482: NEWNODE(n1);
483: n1->body = (pointer)s;
484: NEXT(n1) = cur;
485: if ( !prev ) {
486: top = n1; cur = n1;
487: } else {
488: NEXT(prev) = n1; prev = n1;
489: }
490: m = NEXT(m);
491: if ( m ) _adddl(n,m->dl,dl,t);
492: break;
493: }
494: }
1.18 noro 495: return top;
496: }
497: }
498:
1.19 noro 499: DLBUCKET symb_merge_bucket(DLBUCKET m1,DLBUCKET m2,int n)
1.18 noro 500: {
501: DLBUCKET top,prev,cur,m,t;
502:
503: if ( !m1 )
504: return m2;
505: else if ( !m2 )
506: return m1;
507: else {
508: if ( m1->td == m2->td ) {
509: top = m1;
510: BDY(top) = symb_merge(BDY(top),BDY(m2),n);
511: m = NEXT(m2);
512: } else if ( m1->td > m2->td ) {
513: top = m1; m = m2;
514: } else {
515: top = m2; m = m1;
516: }
517: prev = top; cur = NEXT(top);
518: /* prev->td > m->td always holds */
519: while ( cur && m ) {
520: if ( cur->td == m->td ) {
521: BDY(cur) = symb_merge(BDY(cur),BDY(m),n);
522: m = NEXT(m);
523: prev = cur; cur = NEXT(cur);
524: } else if ( cur->td > m->td ) {
525: t = NEXT(cur); NEXT(cur) = m; m = t;
526: prev = cur; cur = NEXT(cur);
527: } else {
528: NEXT(prev) = m; m = cur;
529: prev = NEXT(prev); cur = NEXT(prev);
1.3 noro 530: }
531: }
532: if ( !cur )
533: NEXT(prev) = m;
534: return top;
1.1 noro 535: }
536: }
537:
1.19 noro 538: void subd(VL vl,DP p1,DP p2,DP *pr)
1.1 noro 539: {
540: DP t;
541:
542: if ( !p2 )
543: *pr = p1;
544: else {
545: chsgnd(p2,&t); addd(vl,p1,t,pr);
546: }
547: }
548:
1.19 noro 549: void chsgnd(DP p,DP *pr)
1.1 noro 550: {
551: MP m,mr,mr0;
552:
553: if ( !p )
554: *pr = 0;
555: else {
556: for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
557: NEXTMP(mr0,mr); chsgnp(C(m),&C(mr)); mr->dl = m->dl;
558: }
559: NEXT(mr) = 0; MKDP(NV(p),mr0,*pr);
560: if ( *pr )
561: (*pr)->sugar = p->sugar;
562: }
563: }
564:
1.19 noro 565: void muld(VL vl,DP p1,DP p2,DP *pr)
1.1 noro 566: {
1.2 noro 567: if ( ! do_weyl )
568: comm_muld(vl,p1,p2,pr);
569: else
570: weyl_muld(vl,p1,p2,pr);
571: }
572:
1.19 noro 573: void comm_muld(VL vl,DP p1,DP p2,DP *pr)
1.2 noro 574: {
1.1 noro 575: MP m;
576: DP s,t,u;
1.5 noro 577: int i,l,l1;
578: static MP *w;
579: static int wlen;
1.1 noro 580:
581: if ( !p1 || !p2 )
582: *pr = 0;
583: else if ( OID(p1) <= O_P )
584: muldc(vl,p2,(P)p1,pr);
585: else if ( OID(p2) <= O_P )
586: muldc(vl,p1,(P)p2,pr);
587: else {
1.5 noro 588: for ( m = BDY(p1), l1 = 0; m; m = NEXT(m), l1++ );
1.4 noro 589: for ( m = BDY(p2), l = 0; m; m = NEXT(m), l++ );
1.5 noro 590: if ( l1 < l ) {
591: t = p1; p1 = p2; p2 = t;
592: l = l1;
593: }
594: if ( l > wlen ) {
595: if ( w ) GC_free(w);
596: w = (MP *)MALLOC(l*sizeof(MP));
597: wlen = l;
598: }
1.4 noro 599: for ( m = BDY(p2), i = 0; i < l; m = NEXT(m), i++ )
600: w[i] = m;
601: for ( s = 0, i = l-1; i >= 0; i-- ) {
602: muldm(vl,p1,w[i],&t); addd(vl,s,t,&u); s = u;
1.1 noro 603: }
1.5 noro 604: bzero(w,l*sizeof(MP));
1.1 noro 605: *pr = s;
606: }
607: }
608:
1.24 ! noro 609: /* discard terms which is not a multiple of dl */
! 610:
! 611: void comm_muld_trunc(VL vl,DP p1,DP p2,DL dl,DP *pr)
! 612: {
! 613: MP m;
! 614: DP s,t,u;
! 615: int i,l,l1;
! 616: static MP *w;
! 617: static int wlen;
! 618:
! 619: if ( !p1 || !p2 )
! 620: *pr = 0;
! 621: else if ( OID(p1) <= O_P )
! 622: muldc_trunc(vl,p2,(P)p1,dl,pr);
! 623: else if ( OID(p2) <= O_P )
! 624: muldc_trunc(vl,p1,(P)p2,dl,pr);
! 625: else {
! 626: for ( m = BDY(p1), l1 = 0; m; m = NEXT(m), l1++ );
! 627: for ( m = BDY(p2), l = 0; m; m = NEXT(m), l++ );
! 628: if ( l1 < l ) {
! 629: t = p1; p1 = p2; p2 = t;
! 630: l = l1;
! 631: }
! 632: if ( l > wlen ) {
! 633: if ( w ) GC_free(w);
! 634: w = (MP *)MALLOC(l*sizeof(MP));
! 635: wlen = l;
! 636: }
! 637: for ( m = BDY(p2), i = 0; i < l; m = NEXT(m), i++ )
! 638: w[i] = m;
! 639: for ( s = 0, i = l-1; i >= 0; i-- ) {
! 640: muldm_trunc(vl,p1,w[i],dl,&t); addd(vl,s,t,&u); s = u;
! 641: }
! 642: bzero(w,l*sizeof(MP));
! 643: *pr = s;
! 644: }
! 645: }
! 646:
! 647: void comm_quod(VL vl,DP p1,DP p2,DP *pr)
! 648: {
! 649: MP m,m0;
! 650: DP s,t;
! 651: int i,n,sugar;
! 652: DL d1,d2,d;
! 653: Q a,b;
! 654:
! 655: if ( !p2 )
! 656: error("comm_quod : invalid input");
! 657: if ( !p1 )
! 658: *pr = 0;
! 659: else {
! 660: n = NV(p1);
! 661: d2 = BDY(p2)->dl;
! 662: m0 = 0;
! 663: sugar = p1->sugar;
! 664: while ( p1 ) {
! 665: d1 = BDY(p1)->dl;
! 666: NEWDL(d,n);
! 667: d->td = d1->td - d2->td;
! 668: for ( i = 0; i < n; i++ )
! 669: d->d[i] = d1->d[i]-d2->d[i];
! 670: NEXTMP(m0,m);
! 671: m->dl = d;
! 672: divq((Q)BDY(p1)->c,(Q)BDY(p2)->c,&a); chsgnq(a,&b);
! 673: C(m) = (P)b;
! 674: muldm_trunc(vl,p2,m,d2,&t);
! 675: addd(vl,p1,t,&s); p1 = s;
! 676: C(m) = (P)a;
! 677: }
! 678: if ( m0 ) {
! 679: NEXT(m) = 0; MKDP(n,m0,*pr);
! 680: } else
! 681: *pr = 0;
! 682: /* XXX */
! 683: if ( *pr )
! 684: (*pr)->sugar = sugar - d2->td;
! 685: }
! 686: }
! 687:
1.19 noro 688: void muldm(VL vl,DP p,MP m0,DP *pr)
1.1 noro 689: {
690: MP m,mr,mr0;
691: P c;
692: DL d;
693: int n;
694:
695: if ( !p )
696: *pr = 0;
697: else {
698: for ( mr0 = 0, m = BDY(p), c = C(m0), d = m0->dl, n = NV(p);
699: m; m = NEXT(m) ) {
700: NEXTMP(mr0,mr);
701: if ( NUM(C(m)) && RATN(C(m)) && NUM(c) && RATN(c) )
702: mulq((Q)C(m),(Q)c,(Q *)&C(mr));
703: else
704: mulp(vl,C(m),c,&C(mr));
705: adddl(n,m->dl,d,&mr->dl);
706: }
707: NEXT(mr) = 0; MKDP(NV(p),mr0,*pr);
708: if ( *pr )
709: (*pr)->sugar = p->sugar + m0->dl->td;
1.2 noro 710: }
711: }
712:
1.24 ! noro 713: void muldm_trunc(VL vl,DP p,MP m0,DL dl,DP *pr)
! 714: {
! 715: MP m,mr,mr0;
! 716: P c;
! 717: DL d,tdl;
! 718: int n,i;
! 719:
! 720: if ( !p )
! 721: *pr = 0;
! 722: else {
! 723: n = NV(p);
! 724: NEWDL(tdl,n);
! 725: for ( mr0 = 0, m = BDY(p), c = C(m0), d = m0->dl;
! 726: m; m = NEXT(m) ) {
! 727: _adddl(n,m->dl,d,tdl);
! 728: for ( i = 0; i < n; i++ )
! 729: if ( tdl->d[i] < dl->d[i] )
! 730: break;
! 731: if ( i < n )
! 732: continue;
! 733: NEXTMP(mr0,mr);
! 734: mr->dl = tdl;
! 735: NEWDL(tdl,n);
! 736: if ( NUM(C(m)) && RATN(C(m)) && NUM(c) && RATN(c) )
! 737: mulq((Q)C(m),(Q)c,(Q *)&C(mr));
! 738: else
! 739: mulp(vl,C(m),c,&C(mr));
! 740: }
! 741: if ( mr0 ) {
! 742: NEXT(mr) = 0; MKDP(NV(p),mr0,*pr);
! 743: } else
! 744: *pr = 0;
! 745: if ( *pr )
! 746: (*pr)->sugar = p->sugar + m0->dl->td;
! 747: }
! 748: }
! 749:
1.19 noro 750: void weyl_muld(VL vl,DP p1,DP p2,DP *pr)
1.2 noro 751: {
752: MP m;
753: DP s,t,u;
1.4 noro 754: int i,l;
1.5 noro 755: static MP *w;
756: static int wlen;
1.2 noro 757:
758: if ( !p1 || !p2 )
759: *pr = 0;
760: else if ( OID(p1) <= O_P )
761: muldc(vl,p2,(P)p1,pr);
762: else if ( OID(p2) <= O_P )
763: muldc(vl,p1,(P)p2,pr);
764: else {
1.10 noro 765: for ( m = BDY(p1), l = 0; m; m = NEXT(m), l++ );
1.5 noro 766: if ( l > wlen ) {
767: if ( w ) GC_free(w);
768: w = (MP *)MALLOC(l*sizeof(MP));
769: wlen = l;
770: }
1.10 noro 771: for ( m = BDY(p1), i = 0; i < l; m = NEXT(m), i++ )
1.4 noro 772: w[i] = m;
773: for ( s = 0, i = l-1; i >= 0; i-- ) {
1.10 noro 774: weyl_muldm(vl,w[i],p2,&t); addd(vl,s,t,&u); s = u;
1.2 noro 775: }
1.5 noro 776: bzero(w,l*sizeof(MP));
1.2 noro 777: *pr = s;
778: }
779: }
780:
1.10 noro 781: /* monomial * polynomial */
782:
1.19 noro 783: void weyl_muldm(VL vl,MP m0,DP p,DP *pr)
1.2 noro 784: {
785: DP r,t,t1;
786: MP m;
1.10 noro 787: DL d0;
788: int n,n2,l,i,j,tlen;
789: static MP *w,*psum;
790: static struct cdl *tab;
1.5 noro 791: static int wlen;
1.10 noro 792: static int rtlen;
1.2 noro 793:
794: if ( !p )
795: *pr = 0;
796: else {
1.4 noro 797: for ( m = BDY(p), l = 0; m; m = NEXT(m), l++ );
1.5 noro 798: if ( l > wlen ) {
799: if ( w ) GC_free(w);
800: w = (MP *)MALLOC(l*sizeof(MP));
801: wlen = l;
802: }
1.4 noro 803: for ( m = BDY(p), i = 0; i < l; m = NEXT(m), i++ )
804: w[i] = m;
1.10 noro 805:
806: n = NV(p); n2 = n>>1;
807: d0 = m0->dl;
808: for ( i = 0, tlen = 1; i < n2; i++ )
809: tlen *= d0->d[n2+i]+1;
810: if ( tlen > rtlen ) {
811: if ( tab ) GC_free(tab);
812: if ( psum ) GC_free(psum);
813: rtlen = tlen;
814: tab = (struct cdl *)MALLOC(rtlen*sizeof(struct cdl));
815: psum = (MP *)MALLOC(rtlen*sizeof(MP));
816: }
817: bzero(psum,tlen*sizeof(MP));
818: for ( i = l-1; i >= 0; i-- ) {
819: bzero(tab,tlen*sizeof(struct cdl));
820: weyl_mulmm(vl,m0,w[i],n,tab,tlen);
821: for ( j = 0; j < tlen; j++ ) {
822: if ( tab[j].c ) {
823: NEWMP(m); m->dl = tab[j].d; C(m) = tab[j].c; NEXT(m) = psum[j];
824: psum[j] = m;
825: }
826: }
1.2 noro 827: }
1.10 noro 828: for ( j = tlen-1, r = 0; j >= 0; j-- )
829: if ( psum[j] ) {
830: MKDP(n,psum[j],t); addd(vl,r,t,&t1); r = t1;
831: }
1.2 noro 832: if ( r )
833: r->sugar = p->sugar + m0->dl->td;
834: *pr = r;
835: }
836: }
837:
1.10 noro 838: /* m0 = x0^d0*x1^d1*... * dx0^e0*dx1^e1*... */
839: /* rtab : array of length (e0+1)*(e1+1)*... */
1.2 noro 840:
1.19 noro 841: void weyl_mulmm(VL vl,MP m0,MP m1,int n,struct cdl *rtab,int rtablen)
1.2 noro 842: {
1.19 noro 843: P c,c0,c1;
1.10 noro 844: DL d,d0,d1,dt;
845: int i,j,a,b,k,l,n2,s,min,curlen;
846: struct cdl *p;
847: static Q *ctab;
848: static struct cdl *tab;
1.5 noro 849: static int tablen;
1.10 noro 850: static struct cdl *tmptab;
851: static int tmptablen;
1.2 noro 852:
1.10 noro 853:
854: if ( !m0 || !m1 ) {
855: rtab[0].c = 0;
856: rtab[0].d = 0;
857: return;
858: }
859: c0 = C(m0); c1 = C(m1);
860: mulp(vl,c0,c1,&c);
861: d0 = m0->dl; d1 = m1->dl;
862: n2 = n>>1;
863: curlen = 1;
864: NEWDL(d,n);
865: if ( n & 1 )
866: /* offset of h-degree */
867: d->td = d->d[n-1] = d0->d[n-1]+d1->d[n-1];
868: else
869: d->td = 0;
870: rtab[0].c = c;
871: rtab[0].d = d;
872:
873: if ( rtablen > tmptablen ) {
874: if ( tmptab ) GC_free(tmptab);
875: tmptab = (struct cdl *)MALLOC(rtablen*sizeof(struct cdl));
876: tmptablen = rtablen;
877: }
878: for ( i = 0; i < n2; i++ ) {
879: a = d0->d[i]; b = d1->d[n2+i];
880: k = d0->d[n2+i]; l = d1->d[i];
1.20 noro 881:
882: /* degree of xi^a*(Di^k*xi^l)*Di^b */
883: a += l;
884: b += k;
885: s = MUL_WEIGHT(a,i)+MUL_WEIGHT(b,n2+i);
886:
1.10 noro 887: if ( !k || !l ) {
888: for ( j = 0, p = rtab; j < curlen; j++, p++ ) {
889: if ( p->c ) {
890: dt = p->d;
891: dt->d[i] = a;
892: dt->d[n2+i] = b;
893: dt->td += s;
1.5 noro 894: }
1.10 noro 895: }
896: curlen *= k+1;
897: continue;
898: }
899: if ( k+1 > tablen ) {
900: if ( tab ) GC_free(tab);
901: if ( ctab ) GC_free(ctab);
902: tablen = k+1;
903: tab = (struct cdl *)MALLOC(tablen*sizeof(struct cdl));
904: ctab = (Q *)MALLOC(tablen*sizeof(Q));
905: }
906: /* compute xi^a*(Di^k*xi^l)*Di^b */
907: min = MIN(k,l);
908: mkwc(k,l,ctab);
909: bzero(tab,(k+1)*sizeof(struct cdl));
910: if ( n & 1 )
911: for ( j = 0; j <= min; j++ ) {
912: NEWDL(d,n);
1.20 noro 913: d->d[i] = a-j; d->d[n2+i] = b-j;
1.10 noro 914: d->td = s;
1.20 noro 915: d->d[n-1] = s-(MUL_WEIGHT(a-j,i)+MUL_WEIGHT(b-j,n2+i));
1.10 noro 916: tab[j].d = d;
917: tab[j].c = (P)ctab[j];
918: }
919: else
920: for ( j = 0; j <= min; j++ ) {
921: NEWDL(d,n);
1.20 noro 922: d->d[i] = a-j; d->d[n2+i] = b-j;
923: d->td = MUL_WEIGHT(a-j,i)+MUL_WEIGHT(b-j,n2+i); /* XXX */
1.10 noro 924: tab[j].d = d;
925: tab[j].c = (P)ctab[j];
926: }
927: bzero(ctab,(min+1)*sizeof(Q));
928: comm_muld_tab(vl,n,rtab,curlen,tab,k+1,tmptab);
929: curlen *= k+1;
930: bcopy(tmptab,rtab,curlen*sizeof(struct cdl));
931: }
932: }
933:
934: /* direct product of two cdl tables
935: rt[] = [
936: t[0]*t1[0],...,t[n-1]*t1[0],
937: t[0]*t1[1],...,t[n-1]*t1[1],
938: ...
939: t[0]*t1[n1-1],...,t[n-1]*t1[n1-1]
940: ]
941: */
942:
1.19 noro 943: void comm_muld_tab(VL vl,int nv,struct cdl *t,int n,struct cdl *t1,int n1,struct cdl *rt)
1.10 noro 944: {
945: int i,j;
946: struct cdl *p;
947: P c;
948: DL d;
949:
950: bzero(rt,n*n1*sizeof(struct cdl));
951: for ( j = 0, p = rt; j < n1; j++ ) {
952: c = t1[j].c;
953: d = t1[j].d;
954: if ( !c )
955: break;
956: for ( i = 0; i < n; i++, p++ ) {
957: if ( t[i].c ) {
958: mulp(vl,t[i].c,c,&p->c);
959: adddl(nv,t[i].d,d,&p->d);
960: }
1.6 noro 961: }
1.1 noro 962: }
963: }
964:
1.19 noro 965: void muldc(VL vl,DP p,P c,DP *pr)
1.1 noro 966: {
967: MP m,mr,mr0;
968:
969: if ( !p || !c )
970: *pr = 0;
971: else if ( NUM(c) && UNIQ((Q)c) )
972: *pr = p;
973: else if ( NUM(c) && MUNIQ((Q)c) )
974: chsgnd(p,pr);
975: else {
976: for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
977: NEXTMP(mr0,mr);
978: if ( NUM(C(m)) && RATN(C(m)) && NUM(c) && RATN(c) )
979: mulq((Q)C(m),(Q)c,(Q *)&C(mr));
980: else
981: mulp(vl,C(m),c,&C(mr));
982: mr->dl = m->dl;
983: }
984: NEXT(mr) = 0; MKDP(NV(p),mr0,*pr);
985: if ( *pr )
986: (*pr)->sugar = p->sugar;
987: }
1.24 ! noro 988: }
! 989:
! 990: void muldc_trunc(VL vl,DP p,P c,DL dl,DP *pr)
! 991: {
! 992: MP m,mr,mr0;
! 993: DL mdl;
! 994: int i,n;
! 995:
! 996: if ( !p || !c ) {
! 997: *pr = 0; return;
! 998: }
! 999: n = NV(p);
! 1000: for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
! 1001: mdl = m->dl;
! 1002: for ( i = 0; i < n; i++ )
! 1003: if ( mdl->d[i] < dl->d[i] )
! 1004: break;
! 1005: if ( i < n )
! 1006: break;
! 1007: NEXTMP(mr0,mr);
! 1008: if ( NUM(C(m)) && RATN(C(m)) && NUM(c) && RATN(c) )
! 1009: mulq((Q)C(m),(Q)c,(Q *)&C(mr));
! 1010: else
! 1011: mulp(vl,C(m),c,&C(mr));
! 1012: mr->dl = m->dl;
! 1013: }
! 1014: NEXT(mr) = 0; MKDP(NV(p),mr0,*pr);
! 1015: if ( *pr )
! 1016: (*pr)->sugar = p->sugar;
1.1 noro 1017: }
1018:
1.19 noro 1019: void divsdc(VL vl,DP p,P c,DP *pr)
1.1 noro 1020: {
1021: MP m,mr,mr0;
1022:
1023: if ( !c )
1024: error("disvsdc : division by 0");
1025: else if ( !p )
1026: *pr = 0;
1027: else {
1028: for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
1029: NEXTMP(mr0,mr); divsp(vl,C(m),c,&C(mr)); mr->dl = m->dl;
1030: }
1031: NEXT(mr) = 0; MKDP(NV(p),mr0,*pr);
1032: if ( *pr )
1033: (*pr)->sugar = p->sugar;
1034: }
1035: }
1036:
1.19 noro 1037: void adddl(int n,DL d1,DL d2,DL *dr)
1.1 noro 1038: {
1039: DL dt;
1040: int i;
1041:
1042: if ( !d1->td )
1043: *dr = d2;
1044: else if ( !d2->td )
1045: *dr = d1;
1046: else {
1047: *dr = dt = (DL)MALLOC_ATOMIC((n+1)*sizeof(int));
1048: dt->td = d1->td + d2->td;
1049: for ( i = 0; i < n; i++ )
1050: dt->d[i] = d1->d[i]+d2->d[i];
1051: }
1.11 noro 1052: }
1053:
1054: /* d1 += d2 */
1055:
1.19 noro 1056: void adddl_destructive(int n,DL d1,DL d2)
1.11 noro 1057: {
1058: int i;
1059:
1060: d1->td += d2->td;
1061: for ( i = 0; i < n; i++ )
1062: d1->d[i] += d2->d[i];
1.1 noro 1063: }
1064:
1.19 noro 1065: int compd(VL vl,DP p1,DP p2)
1.1 noro 1066: {
1067: int n,t;
1068: MP m1,m2;
1069:
1070: if ( !p1 )
1071: return p2 ? -1 : 0;
1072: else if ( !p2 )
1073: return 1;
1074: else {
1075: for ( n = NV(p1), m1 = BDY(p1), m2 = BDY(p2);
1076: m1 && m2; m1 = NEXT(m1), m2 = NEXT(m2) )
1077: if ( (t = (*cmpdl)(n,m1->dl,m2->dl)) ||
1078: (t = compp(vl,C(m1),C(m2)) ) )
1079: return t;
1080: if ( m1 )
1081: return 1;
1082: else if ( m2 )
1083: return -1;
1084: else
1085: return 0;
1086: }
1087: }
1088:
1.19 noro 1089: int cmpdl_lex(int n,DL d1,DL d2)
1.1 noro 1090: {
1091: int i;
1092:
1093: for ( i = 0; i < n && d1->d[i] == d2->d[i]; i++ );
1094: return i == n ? 0 : (d1->d[i] > d2->d[i] ? 1 : -1);
1095: }
1096:
1.19 noro 1097: int cmpdl_revlex(int n,DL d1,DL d2)
1.1 noro 1098: {
1099: int i;
1100:
1101: for ( i = n - 1; i >= 0 && d1->d[i] == d2->d[i]; i-- );
1102: return i < 0 ? 0 : (d1->d[i] < d2->d[i] ? 1 : -1);
1103: }
1104:
1.19 noro 1105: int cmpdl_gradlex(int n,DL d1,DL d2)
1.1 noro 1106: {
1107: if ( d1->td > d2->td )
1108: return 1;
1109: else if ( d1->td < d2->td )
1110: return -1;
1111: else
1112: return cmpdl_lex(n,d1,d2);
1113: }
1114:
1.19 noro 1115: int cmpdl_revgradlex(int n,DL d1,DL d2)
1.1 noro 1116: {
1.7 noro 1117: register int i;
1118: register int *p1,*p2;
1119:
1.1 noro 1120: if ( d1->td > d2->td )
1121: return 1;
1122: else if ( d1->td < d2->td )
1123: return -1;
1.7 noro 1124: else {
1125: for ( i= n - 1, p1 = d1->d+n-1, p2 = d2->d+n-1;
1126: i >= 0 && *p1 == *p2; i--, p1--, p2-- );
1127: return i < 0 ? 0 : (*p1 < *p2 ? 1 : -1);
1128: }
1.1 noro 1129: }
1130:
1.19 noro 1131: int cmpdl_blex(int n,DL d1,DL d2)
1.1 noro 1132: {
1133: int c;
1134:
1135: if ( c = cmpdl_lex(n-1,d1,d2) )
1136: return c;
1137: else {
1138: c = d1->d[n-1] - d2->d[n-1];
1139: return c > 0 ? 1 : c < 0 ? -1 : 0;
1140: }
1141: }
1142:
1.19 noro 1143: int cmpdl_bgradlex(int n,DL d1,DL d2)
1.1 noro 1144: {
1145: int e1,e2,c;
1146:
1147: e1 = d1->td - d1->d[n-1]; e2 = d2->td - d2->d[n-1];
1148: if ( e1 > e2 )
1149: return 1;
1150: else if ( e1 < e2 )
1151: return -1;
1152: else {
1153: c = cmpdl_lex(n-1,d1,d2);
1154: if ( c )
1155: return c;
1156: else
1157: return d1->td > d2->td ? 1 : d1->td < d2->td ? -1 : 0;
1158: }
1159: }
1160:
1.19 noro 1161: int cmpdl_brevgradlex(int n,DL d1,DL d2)
1.1 noro 1162: {
1163: int e1,e2,c;
1164:
1165: e1 = d1->td - d1->d[n-1]; e2 = d2->td - d2->d[n-1];
1166: if ( e1 > e2 )
1167: return 1;
1168: else if ( e1 < e2 )
1169: return -1;
1170: else {
1171: c = cmpdl_revlex(n-1,d1,d2);
1172: if ( c )
1173: return c;
1174: else
1175: return d1->td > d2->td ? 1 : d1->td < d2->td ? -1 : 0;
1176: }
1177: }
1178:
1.19 noro 1179: int cmpdl_brevrev(int n,DL d1,DL d2)
1.1 noro 1180: {
1181: int e1,e2,f1,f2,c,i;
1182:
1183: for ( i = 0, e1 = 0, e2 = 0; i < dp_nelim; i++ ) {
1184: e1 += d1->d[i]; e2 += d2->d[i];
1185: }
1186: f1 = d1->td - e1; f2 = d2->td - e2;
1187: if ( e1 > e2 )
1188: return 1;
1189: else if ( e1 < e2 )
1190: return -1;
1191: else {
1192: c = cmpdl_revlex(dp_nelim,d1,d2);
1193: if ( c )
1194: return c;
1195: else if ( f1 > f2 )
1196: return 1;
1197: else if ( f1 < f2 )
1198: return -1;
1199: else {
1200: for ( i = n - 1; i >= dp_nelim && d1->d[i] == d2->d[i]; i-- );
1201: return i < dp_nelim ? 0 : (d1->d[i] < d2->d[i] ? 1 : -1);
1202: }
1203: }
1204: }
1205:
1.19 noro 1206: int cmpdl_bgradrev(int n,DL d1,DL d2)
1.1 noro 1207: {
1208: int e1,e2,f1,f2,c,i;
1209:
1210: for ( i = 0, e1 = 0, e2 = 0; i < dp_nelim; i++ ) {
1211: e1 += d1->d[i]; e2 += d2->d[i];
1212: }
1213: f1 = d1->td - e1; f2 = d2->td - e2;
1214: if ( e1 > e2 )
1215: return 1;
1216: else if ( e1 < e2 )
1217: return -1;
1218: else {
1219: c = cmpdl_lex(dp_nelim,d1,d2);
1220: if ( c )
1221: return c;
1222: else if ( f1 > f2 )
1223: return 1;
1224: else if ( f1 < f2 )
1225: return -1;
1226: else {
1227: for ( i = n - 1; i >= dp_nelim && d1->d[i] == d2->d[i]; i-- );
1228: return i < dp_nelim ? 0 : (d1->d[i] < d2->d[i] ? 1 : -1);
1229: }
1230: }
1231: }
1232:
1.19 noro 1233: int cmpdl_blexrev(int n,DL d1,DL d2)
1.1 noro 1234: {
1235: int e1,e2,f1,f2,c,i;
1236:
1237: for ( i = 0, e1 = 0, e2 = 0; i < dp_nelim; i++ ) {
1238: e1 += d1->d[i]; e2 += d2->d[i];
1239: }
1240: f1 = d1->td - e1; f2 = d2->td - e2;
1241: c = cmpdl_lex(dp_nelim,d1,d2);
1242: if ( c )
1243: return c;
1244: else if ( f1 > f2 )
1245: return 1;
1246: else if ( f1 < f2 )
1247: return -1;
1248: else {
1249: for ( i = n - 1; i >= dp_nelim && d1->d[i] == d2->d[i]; i-- );
1250: return i < dp_nelim ? 0 : (d1->d[i] < d2->d[i] ? 1 : -1);
1251: }
1252: }
1253:
1.19 noro 1254: int cmpdl_elim(int n,DL d1,DL d2)
1.1 noro 1255: {
1256: int e1,e2,i;
1257:
1258: for ( i = 0, e1 = 0, e2 = 0; i < dp_nelim; i++ ) {
1259: e1 += d1->d[i]; e2 += d2->d[i];
1260: }
1261: if ( e1 > e2 )
1262: return 1;
1263: else if ( e1 < e2 )
1264: return -1;
1265: else
1266: return cmpdl_revgradlex(n,d1,d2);
1.12 noro 1267: }
1268:
1.19 noro 1269: int cmpdl_weyl_elim(int n,DL d1,DL d2)
1.12 noro 1270: {
1271: int e1,e2,i;
1272:
1273: for ( i = 1, e1 = 0, e2 = 0; i <= dp_nelim; i++ ) {
1274: e1 += d1->d[n-i]; e2 += d2->d[n-i];
1275: }
1276: if ( e1 > e2 )
1277: return 1;
1278: else if ( e1 < e2 )
1279: return -1;
1280: else if ( d1->td > d2->td )
1281: return 1;
1282: else if ( d1->td < d2->td )
1283: return -1;
1284: else return -cmpdl_revlex(n,d1,d2);
1.13 noro 1285: }
1286:
1287: /*
1288: a special ordering
1289: 1. total order
1290: 2. (-w,w) for the first 2*m variables
1291: 3. DRL for the first 2*m variables
1292: */
1293:
1.20 noro 1294: extern int *current_weyl_weight_vector;
1.13 noro 1295:
1.19 noro 1296: int cmpdl_homo_ww_drl(int n,DL d1,DL d2)
1.13 noro 1297: {
1298: int e1,e2,m,i;
1299: int *p1,*p2;
1300:
1301: if ( d1->td > d2->td )
1302: return 1;
1303: else if ( d1->td < d2->td )
1304: return -1;
1305:
1306: m = n>>1;
1.21 noro 1307: for ( i = 0, e1 = e2 = 0, p1 = d1->d, p2 = d2->d; i < m; i++ ) {
1308: e1 += current_weyl_weight_vector[i]*(p1[m+i] - p1[i]);
1309: e2 += current_weyl_weight_vector[i]*(p2[m+i] - p2[i]);
1.13 noro 1310: }
1311: if ( e1 > e2 )
1312: return 1;
1313: else if ( e1 < e2 )
1314: return -1;
1315:
1316: e1 = d1->td - d1->d[n-1];
1317: e2 = d2->td - d2->d[n-1];
1318: if ( e1 > e2 )
1319: return 1;
1320: else if ( e1 < e2 )
1321: return -1;
1322:
1323: for ( i= n - 1, p1 = d1->d+n-1, p2 = d2->d+n-1;
1324: i >= 0 && *p1 == *p2; i--, p1--, p2-- );
1325: return i < 0 ? 0 : (*p1 < *p2 ? 1 : -1);
1.21 noro 1326: }
1327:
1328: int cmpdl_drl_zigzag(int n,DL d1,DL d2)
1329: {
1330: int i,t,m;
1331: int *p1,*p2;
1332:
1333: if ( d1->td > d2->td )
1334: return 1;
1335: else if ( d1->td < d2->td )
1336: return -1;
1337: else {
1338: m = n>>1;
1339: for ( i= m - 1, p1 = d1->d, p2 = d2->d; i >= 0; i-- ) {
1340: if ( t = p1[m+i] - p2[m+i] ) return t > 0 ? -1 : 1;
1341: if ( t = p1[i] - p2[i] ) return t > 0 ? -1 : 1;
1342: }
1343: return 0;
1344: }
1345: }
1346:
1347: int cmpdl_homo_ww_drl_zigzag(int n,DL d1,DL d2)
1348: {
1349: int e1,e2,m,i,t;
1350: int *p1,*p2;
1351:
1352: if ( d1->td > d2->td )
1353: return 1;
1354: else if ( d1->td < d2->td )
1355: return -1;
1356:
1357: m = n>>1;
1358: for ( i = 0, e1 = e2 = 0, p1 = d1->d, p2 = d2->d; i < m; i++ ) {
1359: e1 += current_weyl_weight_vector[i]*(p1[m+i] - p1[i]);
1360: e2 += current_weyl_weight_vector[i]*(p2[m+i] - p2[i]);
1361: }
1362: if ( e1 > e2 )
1363: return 1;
1364: else if ( e1 < e2 )
1365: return -1;
1366:
1367: e1 = d1->td - d1->d[n-1];
1368: e2 = d2->td - d2->d[n-1];
1369: if ( e1 > e2 )
1370: return 1;
1371: else if ( e1 < e2 )
1372: return -1;
1373:
1374: for ( i= m - 1, p1 = d1->d, p2 = d2->d; i >= 0; i-- ) {
1375: if ( t = p1[m+i] - p2[m+i] ) return t > 0 ? -1 : 1;
1376: if ( t = p1[i] - p2[i] ) return t > 0 ? -1 : 1;
1377: }
1378: return 0;
1.1 noro 1379: }
1380:
1.19 noro 1381: int cmpdl_order_pair(int n,DL d1,DL d2)
1.1 noro 1382: {
1383: int e1,e2,i,j,l;
1384: int *t1,*t2;
1.20 noro 1385: int len,head;
1.1 noro 1386: struct order_pair *pair;
1387:
1388: len = dp_current_spec.ord.block.length;
1389: pair = dp_current_spec.ord.block.order_pair;
1390:
1.20 noro 1391: head = 0;
1.1 noro 1392: for ( i = 0, t1 = d1->d, t2 = d2->d; i < len; i++ ) {
1393: l = pair[i].length;
1394: switch ( pair[i].order ) {
1395: case 0:
1396: for ( j = 0, e1 = e2 = 0; j < l; j++ ) {
1.20 noro 1397: e1 += MUL_WEIGHT(t1[j],head+j);
1398: e2 += MUL_WEIGHT(t2[j],head+j);
1.1 noro 1399: }
1400: if ( e1 > e2 )
1401: return 1;
1402: else if ( e1 < e2 )
1403: return -1;
1404: else {
1405: for ( j = l - 1; j >= 0 && t1[j] == t2[j]; j-- );
1406: if ( j >= 0 )
1407: return t1[j] < t2[j] ? 1 : -1;
1408: }
1409: break;
1410: case 1:
1411: for ( j = 0, e1 = e2 = 0; j < l; j++ ) {
1.20 noro 1412: e1 += MUL_WEIGHT(t1[j],head+j);
1413: e2 += MUL_WEIGHT(t2[j],head+j);
1.1 noro 1414: }
1415: if ( e1 > e2 )
1416: return 1;
1417: else if ( e1 < e2 )
1418: return -1;
1419: else {
1420: for ( j = 0; j < l && t1[j] == t2[j]; j++ );
1421: if ( j < l )
1422: return t1[j] > t2[j] ? 1 : -1;
1423: }
1424: break;
1425: case 2:
1426: for ( j = 0; j < l && t1[j] == t2[j]; j++ );
1427: if ( j < l )
1428: return t1[j] > t2[j] ? 1 : -1;
1429: break;
1430: default:
1431: error("cmpdl_order_pair : invalid order"); break;
1432: }
1.20 noro 1433: t1 += l; t2 += l; head += l;
1.1 noro 1434: }
1435: return 0;
1436: }
1437:
1.19 noro 1438: int cmpdl_matrix(int n,DL d1,DL d2)
1.1 noro 1439: {
1440: int *v,*w,*t1,*t2;
1441: int s,i,j,len;
1442: int **matrix;
1443:
1444: for ( i = 0, t1 = d1->d, t2 = d2->d, w = dp_dl_work; i < n; i++ )
1445: w[i] = t1[i]-t2[i];
1446: len = dp_current_spec.ord.matrix.row;
1447: matrix = dp_current_spec.ord.matrix.matrix;
1448: for ( j = 0; j < len; j++ ) {
1449: v = matrix[j];
1450: for ( i = 0, s = 0; i < n; i++ )
1451: s += v[i]*w[i];
1452: if ( s > 0 )
1453: return 1;
1454: else if ( s < 0 )
1455: return -1;
1456: }
1457: return 0;
1458: }