![[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.19 ! noro 48: * $OpenXM: OpenXM_contrib2/asir2000/engine/dist.c,v 1.18 2001/09/13 03:04:28 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.1 noro 64:
65: int (*cmpdl)()=cmpdl_revgradlex;
66: int (*primitive_cmpdl[3])() = {cmpdl_revgradlex,cmpdl_gradlex,cmpdl_lex};
67:
1.2 noro 68: int do_weyl;
69:
1.1 noro 70: int dp_nelim,dp_fcoeffs;
71: struct order_spec dp_current_spec;
72: int *dp_dl_work;
73:
1.19 ! noro 74: int has_fcoef(DP f)
1.1 noro 75: {
76: MP t;
77:
78: if ( !f )
79: return 0;
80: for ( t = BDY(f); t; t = NEXT(t) )
81: if ( has_fcoef_p(t->c) )
82: break;
83: return t ? 1 : 0;
84: }
85:
1.19 ! noro 86: int has_fcoef_p(P f)
1.1 noro 87: {
88: DCP dc;
89:
90: if ( !f )
91: return 0;
92: else if ( NUM(f) )
1.14 noro 93: return (NID((Num)f) == N_LM
94: || NID((Num)f) == N_GF2N
1.15 noro 95: || NID((Num)f) == N_GFPN
96: || NID((Num)f) == N_GFS) ? 1 : 0;
1.1 noro 97: else {
98: for ( dc = DC(f); dc; dc = NEXT(dc) )
99: if ( has_fcoef_p(COEF(dc)) )
100: return 1;
101: return 0;
102: }
103: }
104:
1.19 ! noro 105: void initd(struct order_spec *spec)
1.1 noro 106: {
107: switch ( spec->id ) {
108: case 2:
109: cmpdl = cmpdl_matrix;
110: dp_dl_work = (int *)MALLOC_ATOMIC(spec->nv*sizeof(int));
111: break;
112: case 1:
113: cmpdl = cmpdl_order_pair;
114: break;
115: default:
116: switch ( spec->ord.simple ) {
117: case ORD_REVGRADLEX:
118: cmpdl = cmpdl_revgradlex; break;
119: case ORD_GRADLEX:
120: cmpdl = cmpdl_gradlex; break;
121: case ORD_BREVGRADLEX:
122: cmpdl = cmpdl_brevgradlex; break;
123: case ORD_BGRADLEX:
124: cmpdl = cmpdl_bgradlex; break;
125: case ORD_BLEX:
126: cmpdl = cmpdl_blex; break;
127: case ORD_BREVREV:
128: cmpdl = cmpdl_brevrev; break;
129: case ORD_BGRADREV:
130: cmpdl = cmpdl_bgradrev; break;
131: case ORD_BLEXREV:
132: cmpdl = cmpdl_blexrev; break;
133: case ORD_ELIM:
134: cmpdl = cmpdl_elim; break;
1.12 noro 135: case ORD_WEYL_ELIM:
136: cmpdl = cmpdl_weyl_elim; break;
1.13 noro 137: case ORD_HOMO_WW_DRL:
138: cmpdl = cmpdl_homo_ww_drl; break;
1.1 noro 139: case ORD_LEX: default:
140: cmpdl = cmpdl_lex; break;
141: }
142: break;
143: }
144: dp_current_spec = *spec;
145: }
146:
1.19 ! noro 147: void ptod(VL vl,VL dvl,P p,DP *pr)
1.1 noro 148: {
149: int isconst = 0;
1.16 noro 150: int n,i,j,k;
1.1 noro 151: VL tvl;
152: V v;
153: DL d;
154: MP m;
155: DCP dc;
1.16 noro 156: DCP *w;
1.1 noro 157: DP r,s,t,u;
158: P x,c;
159:
160: if ( !p )
161: *pr = 0;
162: else {
163: for ( n = 0, tvl = dvl; tvl; tvl = NEXT(tvl), n++ );
164: if ( NUM(p) ) {
165: NEWDL(d,n);
166: NEWMP(m); m->dl = d; C(m) = p; NEXT(m) = 0; MKDP(n,m,*pr); (*pr)->sugar = 0;
167: } else {
168: for ( i = 0, tvl = dvl, v = VR(p);
169: tvl && tvl->v != v; tvl = NEXT(tvl), i++ );
170: if ( !tvl ) {
1.16 noro 171: for ( dc = DC(p), k = 0; dc; dc = NEXT(dc), k++ );
172: w = (DCP *)ALLOCA(k*sizeof(DCP));
173: for ( dc = DC(p), j = 0; j < k; dc = NEXT(dc), j++ )
174: w[j] = dc;
175:
176: for ( j = k-1, s = 0, MKV(v,x); j >= 0; j-- ) {
177: ptod(vl,dvl,COEF(w[j]),&t); pwrp(vl,x,DEG(w[j]),&c);
1.1 noro 178: muldc(vl,t,c,&r); addd(vl,r,s,&t); s = t;
179: }
180: *pr = s;
181: } else {
1.16 noro 182: for ( dc = DC(p), k = 0; dc; dc = NEXT(dc), k++ );
183: w = (DCP *)ALLOCA(k*sizeof(DCP));
184: for ( dc = DC(p), j = 0; j < k; dc = NEXT(dc), j++ )
185: w[j] = dc;
186:
187: for ( j = k-1, s = 0; j >= 0; j-- ) {
188: ptod(vl,dvl,COEF(w[j]),&t);
189: NEWDL(d,n); d->td = QTOS(DEG(w[j])); d->d[i] = d->td;
1.1 noro 190: NEWMP(m); m->dl = d; C(m) = (P)ONE; NEXT(m) = 0; MKDP(n,m,u); u->sugar = d->td;
1.2 noro 191: comm_muld(vl,t,u,&r); addd(vl,r,s,&t); s = t;
1.1 noro 192: }
193: *pr = s;
194: }
195: }
196: }
1.17 noro 197: #if 0
1.1 noro 198: if ( !dp_fcoeffs && has_fcoef(*pr) )
199: dp_fcoeffs = 1;
1.17 noro 200: #endif
1.1 noro 201: }
202:
1.19 ! noro 203: void dtop(VL vl,VL dvl,DP p,P *pr)
1.1 noro 204: {
1.16 noro 205: int n,i,j,k;
1.1 noro 206: DL d;
207: MP m;
1.16 noro 208: MP *a;
1.1 noro 209: P r,s,t,u,w;
210: Q q;
211: VL tvl;
212:
213: if ( !p )
214: *pr = 0;
215: else {
1.16 noro 216: for ( k = 0, m = BDY(p); m; m = NEXT(m), k++ );
217: a = (MP *)ALLOCA(k*sizeof(MP));
218: for ( j = 0, m = BDY(p); j < k; m = NEXT(m), j++ )
219: a[j] = m;
220:
221: for ( n = p->nv, j = k-1, s = 0; j >= 0; j-- ) {
222: m = a[j];
1.1 noro 223: t = C(m);
224: if ( NUM(t) && NID((Num)t) == N_M ) {
225: mptop(t,&u); t = u;
226: }
227: for ( i = 0, d = m->dl, tvl = dvl;
228: i < n; tvl = NEXT(tvl), i++ ) {
229: MKV(tvl->v,r); STOQ(d->d[i],q); pwrp(vl,r,q,&u);
230: mulp(vl,t,u,&w); t = w;
231: }
232: addp(vl,s,t,&u); s = u;
233: }
234: *pr = s;
235: }
236: }
237:
1.19 ! noro 238: void nodetod(NODE node,DP *dp)
1.1 noro 239: {
240: NODE t;
241: int len,i,td;
242: Q e;
243: DL d;
244: MP m;
245: DP u;
246:
247: for ( t = node, len = 0; t; t = NEXT(t), len++ );
248: NEWDL(d,len);
249: for ( t = node, i = 0, td = 0; i < len; t = NEXT(t), i++ ) {
250: e = (Q)BDY(t);
251: if ( !e )
252: d->d[i] = 0;
253: else if ( !NUM(e) || !RATN(e) || !INT(e) )
254: error("nodetod : invalid input");
255: else {
256: d->d[i] = QTOS((Q)e); td += d->d[i];
257: }
258: }
259: d->td = td;
260: NEWMP(m); m->dl = d; C(m) = (P)ONE; NEXT(m) = 0;
261: MKDP(len,m,u); u->sugar = td; *dp = u;
262: }
263:
1.19 ! noro 264: int sugard(MP m)
1.1 noro 265: {
266: int s;
267:
268: for ( s = 0; m; m = NEXT(m) )
269: s = MAX(s,m->dl->td);
270: return s;
271: }
272:
1.19 ! noro 273: void addd(VL vl,DP p1,DP p2,DP *pr)
1.1 noro 274: {
275: int n;
276: MP m1,m2,mr,mr0;
277: P t;
278:
279: if ( !p1 )
280: *pr = p2;
281: else if ( !p2 )
282: *pr = p1;
283: else {
284: for ( n = NV(p1), m1 = BDY(p1), m2 = BDY(p2), mr0 = 0; m1 && m2; )
285: switch ( (*cmpdl)(n,m1->dl,m2->dl) ) {
286: case 0:
287: addp(vl,C(m1),C(m2),&t);
288: if ( t ) {
289: NEXTMP(mr0,mr); mr->dl = m1->dl; C(mr) = t;
290: }
291: m1 = NEXT(m1); m2 = NEXT(m2); break;
292: case 1:
293: NEXTMP(mr0,mr); mr->dl = m1->dl; C(mr) = C(m1);
294: m1 = NEXT(m1); break;
295: case -1:
296: NEXTMP(mr0,mr); mr->dl = m2->dl; C(mr) = C(m2);
297: m2 = NEXT(m2); break;
298: }
299: if ( !mr0 )
300: if ( m1 )
301: mr0 = m1;
302: else if ( m2 )
303: mr0 = m2;
304: else {
305: *pr = 0;
306: return;
307: }
308: else if ( m1 )
309: NEXT(mr) = m1;
310: else if ( m2 )
311: NEXT(mr) = m2;
312: else
313: NEXT(mr) = 0;
314: MKDP(NV(p1),mr0,*pr);
315: if ( *pr )
316: (*pr)->sugar = MAX(p1->sugar,p2->sugar);
317: }
318: }
319:
320: /* for F4 symbolic reduction */
321:
1.19 ! noro 322: void symb_addd(DP p1,DP p2,DP *pr)
1.1 noro 323: {
324: int n;
325: MP m1,m2,mr,mr0;
326:
327: if ( !p1 )
328: *pr = p2;
329: else if ( !p2 )
330: *pr = p1;
331: else {
332: for ( n = NV(p1), m1 = BDY(p1), m2 = BDY(p2), mr0 = 0; m1 && m2; ) {
333: NEXTMP(mr0,mr); C(mr) = (P)ONE;
334: switch ( (*cmpdl)(n,m1->dl,m2->dl) ) {
335: case 0:
336: mr->dl = m1->dl;
337: m1 = NEXT(m1); m2 = NEXT(m2); break;
338: case 1:
339: mr->dl = m1->dl;
340: m1 = NEXT(m1); break;
341: case -1:
342: mr->dl = m2->dl;
343: m2 = NEXT(m2); break;
344: }
345: }
346: if ( !mr0 )
347: if ( m1 )
348: mr0 = m1;
349: else if ( m2 )
350: mr0 = m2;
351: else {
352: *pr = 0;
353: return;
354: }
355: else if ( m1 )
356: NEXT(mr) = m1;
357: else if ( m2 )
358: NEXT(mr) = m2;
359: else
360: NEXT(mr) = 0;
361: MKDP(NV(p1),mr0,*pr);
362: if ( *pr )
363: (*pr)->sugar = MAX(p1->sugar,p2->sugar);
1.3 noro 364: }
365: }
366:
367: /*
368: * destructive merge of two list
369: *
370: * p1, p2 : list of DL
371: * return : a merged list
372: */
373:
1.19 ! noro 374: NODE symb_merge(NODE m1,NODE m2,int n)
1.3 noro 375: {
376: NODE top,prev,cur,m,t;
377:
378: if ( !m1 )
379: return m2;
380: else if ( !m2 )
381: return m1;
382: else {
383: switch ( (*cmpdl)(n,(DL)BDY(m1),(DL)BDY(m2)) ) {
384: case 0:
385: top = m1; m = NEXT(m2);
386: break;
387: case 1:
388: top = m1; m = m2;
389: break;
390: case -1:
391: top = m2; m = m1;
392: break;
393: }
394: prev = top; cur = NEXT(top);
395: /* BDY(prev) > BDY(m) always holds */
396: while ( cur && m ) {
397: switch ( (*cmpdl)(n,(DL)BDY(cur),(DL)BDY(m)) ) {
398: case 0:
399: m = NEXT(m);
400: prev = cur; cur = NEXT(cur);
401: break;
402: case 1:
403: t = NEXT(cur); NEXT(cur) = m; m = t;
404: prev = cur; cur = NEXT(cur);
405: break;
406: case -1:
407: NEXT(prev) = m; m = cur;
408: prev = NEXT(prev); cur = NEXT(prev);
409: break;
1.18 noro 410: }
411: }
412: if ( !cur )
413: NEXT(prev) = m;
414: return top;
415: }
416: }
417:
1.19 ! noro 418: DLBUCKET symb_merge_bucket(DLBUCKET m1,DLBUCKET m2,int n)
1.18 noro 419: {
420: DLBUCKET top,prev,cur,m,t;
421:
422: if ( !m1 )
423: return m2;
424: else if ( !m2 )
425: return m1;
426: else {
427: if ( m1->td == m2->td ) {
428: top = m1;
429: BDY(top) = symb_merge(BDY(top),BDY(m2),n);
430: m = NEXT(m2);
431: } else if ( m1->td > m2->td ) {
432: top = m1; m = m2;
433: } else {
434: top = m2; m = m1;
435: }
436: prev = top; cur = NEXT(top);
437: /* prev->td > m->td always holds */
438: while ( cur && m ) {
439: if ( cur->td == m->td ) {
440: BDY(cur) = symb_merge(BDY(cur),BDY(m),n);
441: m = NEXT(m);
442: prev = cur; cur = NEXT(cur);
443: } else if ( cur->td > m->td ) {
444: t = NEXT(cur); NEXT(cur) = m; m = t;
445: prev = cur; cur = NEXT(cur);
446: } else {
447: NEXT(prev) = m; m = cur;
448: prev = NEXT(prev); cur = NEXT(prev);
1.3 noro 449: }
450: }
451: if ( !cur )
452: NEXT(prev) = m;
453: return top;
1.1 noro 454: }
455: }
456:
1.19 ! noro 457: void subd(VL vl,DP p1,DP p2,DP *pr)
1.1 noro 458: {
459: DP t;
460:
461: if ( !p2 )
462: *pr = p1;
463: else {
464: chsgnd(p2,&t); addd(vl,p1,t,pr);
465: }
466: }
467:
1.19 ! noro 468: void chsgnd(DP p,DP *pr)
1.1 noro 469: {
470: MP m,mr,mr0;
471:
472: if ( !p )
473: *pr = 0;
474: else {
475: for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
476: NEXTMP(mr0,mr); chsgnp(C(m),&C(mr)); mr->dl = m->dl;
477: }
478: NEXT(mr) = 0; MKDP(NV(p),mr0,*pr);
479: if ( *pr )
480: (*pr)->sugar = p->sugar;
481: }
482: }
483:
1.19 ! noro 484: void muld(VL vl,DP p1,DP p2,DP *pr)
1.1 noro 485: {
1.2 noro 486: if ( ! do_weyl )
487: comm_muld(vl,p1,p2,pr);
488: else
489: weyl_muld(vl,p1,p2,pr);
490: }
491:
1.19 ! noro 492: void comm_muld(VL vl,DP p1,DP p2,DP *pr)
1.2 noro 493: {
1.1 noro 494: MP m;
495: DP s,t,u;
1.5 noro 496: int i,l,l1;
497: static MP *w;
498: static int wlen;
1.1 noro 499:
500: if ( !p1 || !p2 )
501: *pr = 0;
502: else if ( OID(p1) <= O_P )
503: muldc(vl,p2,(P)p1,pr);
504: else if ( OID(p2) <= O_P )
505: muldc(vl,p1,(P)p2,pr);
506: else {
1.5 noro 507: for ( m = BDY(p1), l1 = 0; m; m = NEXT(m), l1++ );
1.4 noro 508: for ( m = BDY(p2), l = 0; m; m = NEXT(m), l++ );
1.5 noro 509: if ( l1 < l ) {
510: t = p1; p1 = p2; p2 = t;
511: l = l1;
512: }
513: if ( l > wlen ) {
514: if ( w ) GC_free(w);
515: w = (MP *)MALLOC(l*sizeof(MP));
516: wlen = l;
517: }
1.4 noro 518: for ( m = BDY(p2), i = 0; i < l; m = NEXT(m), i++ )
519: w[i] = m;
520: for ( s = 0, i = l-1; i >= 0; i-- ) {
521: muldm(vl,p1,w[i],&t); addd(vl,s,t,&u); s = u;
1.1 noro 522: }
1.5 noro 523: bzero(w,l*sizeof(MP));
1.1 noro 524: *pr = s;
525: }
526: }
527:
1.19 ! noro 528: void muldm(VL vl,DP p,MP m0,DP *pr)
1.1 noro 529: {
530: MP m,mr,mr0;
531: P c;
532: DL d;
533: int n;
534:
535: if ( !p )
536: *pr = 0;
537: else {
538: for ( mr0 = 0, m = BDY(p), c = C(m0), d = m0->dl, n = NV(p);
539: m; m = NEXT(m) ) {
540: NEXTMP(mr0,mr);
541: if ( NUM(C(m)) && RATN(C(m)) && NUM(c) && RATN(c) )
542: mulq((Q)C(m),(Q)c,(Q *)&C(mr));
543: else
544: mulp(vl,C(m),c,&C(mr));
545: adddl(n,m->dl,d,&mr->dl);
546: }
547: NEXT(mr) = 0; MKDP(NV(p),mr0,*pr);
548: if ( *pr )
549: (*pr)->sugar = p->sugar + m0->dl->td;
1.2 noro 550: }
551: }
552:
1.19 ! noro 553: void weyl_muld(VL vl,DP p1,DP p2,DP *pr)
1.2 noro 554: {
555: MP m;
556: DP s,t,u;
1.4 noro 557: int i,l;
1.5 noro 558: static MP *w;
559: static int wlen;
1.2 noro 560:
561: if ( !p1 || !p2 )
562: *pr = 0;
563: else if ( OID(p1) <= O_P )
564: muldc(vl,p2,(P)p1,pr);
565: else if ( OID(p2) <= O_P )
566: muldc(vl,p1,(P)p2,pr);
567: else {
1.10 noro 568: for ( m = BDY(p1), l = 0; m; m = NEXT(m), l++ );
1.5 noro 569: if ( l > wlen ) {
570: if ( w ) GC_free(w);
571: w = (MP *)MALLOC(l*sizeof(MP));
572: wlen = l;
573: }
1.10 noro 574: for ( m = BDY(p1), i = 0; i < l; m = NEXT(m), i++ )
1.4 noro 575: w[i] = m;
576: for ( s = 0, i = l-1; i >= 0; i-- ) {
1.10 noro 577: weyl_muldm(vl,w[i],p2,&t); addd(vl,s,t,&u); s = u;
1.2 noro 578: }
1.5 noro 579: bzero(w,l*sizeof(MP));
1.2 noro 580: *pr = s;
581: }
582: }
583:
1.10 noro 584: /* monomial * polynomial */
585:
1.19 ! noro 586: void weyl_muldm(VL vl,MP m0,DP p,DP *pr)
1.2 noro 587: {
588: DP r,t,t1;
589: MP m;
1.10 noro 590: DL d0;
591: int n,n2,l,i,j,tlen;
592: static MP *w,*psum;
593: static struct cdl *tab;
1.5 noro 594: static int wlen;
1.10 noro 595: static int rtlen;
1.2 noro 596:
597: if ( !p )
598: *pr = 0;
599: else {
1.4 noro 600: for ( m = BDY(p), l = 0; m; m = NEXT(m), l++ );
1.5 noro 601: if ( l > wlen ) {
602: if ( w ) GC_free(w);
603: w = (MP *)MALLOC(l*sizeof(MP));
604: wlen = l;
605: }
1.4 noro 606: for ( m = BDY(p), i = 0; i < l; m = NEXT(m), i++ )
607: w[i] = m;
1.10 noro 608:
609: n = NV(p); n2 = n>>1;
610: d0 = m0->dl;
611: for ( i = 0, tlen = 1; i < n2; i++ )
612: tlen *= d0->d[n2+i]+1;
613: if ( tlen > rtlen ) {
614: if ( tab ) GC_free(tab);
615: if ( psum ) GC_free(psum);
616: rtlen = tlen;
617: tab = (struct cdl *)MALLOC(rtlen*sizeof(struct cdl));
618: psum = (MP *)MALLOC(rtlen*sizeof(MP));
619: }
620: bzero(psum,tlen*sizeof(MP));
621: for ( i = l-1; i >= 0; i-- ) {
622: bzero(tab,tlen*sizeof(struct cdl));
623: weyl_mulmm(vl,m0,w[i],n,tab,tlen);
624: for ( j = 0; j < tlen; j++ ) {
625: if ( tab[j].c ) {
626: NEWMP(m); m->dl = tab[j].d; C(m) = tab[j].c; NEXT(m) = psum[j];
627: psum[j] = m;
628: }
629: }
1.2 noro 630: }
1.10 noro 631: for ( j = tlen-1, r = 0; j >= 0; j-- )
632: if ( psum[j] ) {
633: MKDP(n,psum[j],t); addd(vl,r,t,&t1); r = t1;
634: }
1.2 noro 635: if ( r )
636: r->sugar = p->sugar + m0->dl->td;
637: *pr = r;
638: }
639: }
640:
1.10 noro 641: /* m0 = x0^d0*x1^d1*... * dx0^e0*dx1^e1*... */
642: /* rtab : array of length (e0+1)*(e1+1)*... */
1.2 noro 643:
1.19 ! noro 644: void weyl_mulmm(VL vl,MP m0,MP m1,int n,struct cdl *rtab,int rtablen)
1.2 noro 645: {
1.19 ! noro 646: P c,c0,c1;
1.10 noro 647: DL d,d0,d1,dt;
648: int i,j,a,b,k,l,n2,s,min,curlen;
649: struct cdl *p;
650: static Q *ctab;
651: static struct cdl *tab;
1.5 noro 652: static int tablen;
1.10 noro 653: static struct cdl *tmptab;
654: static int tmptablen;
1.2 noro 655:
1.10 noro 656:
657: if ( !m0 || !m1 ) {
658: rtab[0].c = 0;
659: rtab[0].d = 0;
660: return;
661: }
662: c0 = C(m0); c1 = C(m1);
663: mulp(vl,c0,c1,&c);
664: d0 = m0->dl; d1 = m1->dl;
665: n2 = n>>1;
666: curlen = 1;
667: NEWDL(d,n);
668: if ( n & 1 )
669: /* offset of h-degree */
670: d->td = d->d[n-1] = d0->d[n-1]+d1->d[n-1];
671: else
672: d->td = 0;
673: rtab[0].c = c;
674: rtab[0].d = d;
675:
676: if ( rtablen > tmptablen ) {
677: if ( tmptab ) GC_free(tmptab);
678: tmptab = (struct cdl *)MALLOC(rtablen*sizeof(struct cdl));
679: tmptablen = rtablen;
680: }
681: for ( i = 0; i < n2; i++ ) {
682: a = d0->d[i]; b = d1->d[n2+i];
683: k = d0->d[n2+i]; l = d1->d[i];
684: if ( !k || !l ) {
685: a += l;
686: b += k;
687: s = a+b;
688: for ( j = 0, p = rtab; j < curlen; j++, p++ ) {
689: if ( p->c ) {
690: dt = p->d;
691: dt->d[i] = a;
692: dt->d[n2+i] = b;
693: dt->td += s;
1.5 noro 694: }
1.10 noro 695: }
696: curlen *= k+1;
697: continue;
698: }
699: if ( k+1 > tablen ) {
700: if ( tab ) GC_free(tab);
701: if ( ctab ) GC_free(ctab);
702: tablen = k+1;
703: tab = (struct cdl *)MALLOC(tablen*sizeof(struct cdl));
704: ctab = (Q *)MALLOC(tablen*sizeof(Q));
705: }
706: /* degree of xi^a*(Di^k*xi^l)*Di^b */
707: s = a+k+l+b;
708: /* compute xi^a*(Di^k*xi^l)*Di^b */
709: min = MIN(k,l);
710: mkwc(k,l,ctab);
711: bzero(tab,(k+1)*sizeof(struct cdl));
712: if ( n & 1 )
713: for ( j = 0; j <= min; j++ ) {
714: NEWDL(d,n);
715: d->d[i] = l-j+a; d->d[n2+i] = k-j+b;
716: d->td = s;
717: d->d[n-1] = s-(d->d[i]+d->d[n2+i]);
718: tab[j].d = d;
719: tab[j].c = (P)ctab[j];
720: }
721: else
722: for ( j = 0; j <= min; j++ ) {
723: NEWDL(d,n);
724: d->d[i] = l-j+a; d->d[n2+i] = k-j+b;
725: d->td = d->d[i]+d->d[n2+i]; /* XXX */
726: tab[j].d = d;
727: tab[j].c = (P)ctab[j];
728: }
729: bzero(ctab,(min+1)*sizeof(Q));
730: comm_muld_tab(vl,n,rtab,curlen,tab,k+1,tmptab);
731: curlen *= k+1;
732: bcopy(tmptab,rtab,curlen*sizeof(struct cdl));
733: }
734: }
735:
736: /* direct product of two cdl tables
737: rt[] = [
738: t[0]*t1[0],...,t[n-1]*t1[0],
739: t[0]*t1[1],...,t[n-1]*t1[1],
740: ...
741: t[0]*t1[n1-1],...,t[n-1]*t1[n1-1]
742: ]
743: */
744:
1.19 ! noro 745: void comm_muld_tab(VL vl,int nv,struct cdl *t,int n,struct cdl *t1,int n1,struct cdl *rt)
1.10 noro 746: {
747: int i,j;
748: struct cdl *p;
749: P c;
750: DL d;
751:
752: bzero(rt,n*n1*sizeof(struct cdl));
753: for ( j = 0, p = rt; j < n1; j++ ) {
754: c = t1[j].c;
755: d = t1[j].d;
756: if ( !c )
757: break;
758: for ( i = 0; i < n; i++, p++ ) {
759: if ( t[i].c ) {
760: mulp(vl,t[i].c,c,&p->c);
761: adddl(nv,t[i].d,d,&p->d);
762: }
1.6 noro 763: }
1.1 noro 764: }
765: }
766:
1.19 ! noro 767: void muldc(VL vl,DP p,P c,DP *pr)
1.1 noro 768: {
769: MP m,mr,mr0;
770:
771: if ( !p || !c )
772: *pr = 0;
773: else if ( NUM(c) && UNIQ((Q)c) )
774: *pr = p;
775: else if ( NUM(c) && MUNIQ((Q)c) )
776: chsgnd(p,pr);
777: else {
778: for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
779: NEXTMP(mr0,mr);
780: if ( NUM(C(m)) && RATN(C(m)) && NUM(c) && RATN(c) )
781: mulq((Q)C(m),(Q)c,(Q *)&C(mr));
782: else
783: mulp(vl,C(m),c,&C(mr));
784: mr->dl = m->dl;
785: }
786: NEXT(mr) = 0; MKDP(NV(p),mr0,*pr);
787: if ( *pr )
788: (*pr)->sugar = p->sugar;
789: }
790: }
791:
1.19 ! noro 792: void divsdc(VL vl,DP p,P c,DP *pr)
1.1 noro 793: {
794: MP m,mr,mr0;
795:
796: if ( !c )
797: error("disvsdc : division by 0");
798: else if ( !p )
799: *pr = 0;
800: else {
801: for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
802: NEXTMP(mr0,mr); divsp(vl,C(m),c,&C(mr)); mr->dl = m->dl;
803: }
804: NEXT(mr) = 0; MKDP(NV(p),mr0,*pr);
805: if ( *pr )
806: (*pr)->sugar = p->sugar;
807: }
808: }
809:
1.19 ! noro 810: void adddl(int n,DL d1,DL d2,DL *dr)
1.1 noro 811: {
812: DL dt;
813: int i;
814:
815: if ( !d1->td )
816: *dr = d2;
817: else if ( !d2->td )
818: *dr = d1;
819: else {
820: *dr = dt = (DL)MALLOC_ATOMIC((n+1)*sizeof(int));
821: dt->td = d1->td + d2->td;
822: for ( i = 0; i < n; i++ )
823: dt->d[i] = d1->d[i]+d2->d[i];
824: }
1.11 noro 825: }
826:
827: /* d1 += d2 */
828:
1.19 ! noro 829: void adddl_destructive(int n,DL d1,DL d2)
1.11 noro 830: {
831: int i;
832:
833: d1->td += d2->td;
834: for ( i = 0; i < n; i++ )
835: d1->d[i] += d2->d[i];
1.1 noro 836: }
837:
1.19 ! noro 838: int compd(VL vl,DP p1,DP p2)
1.1 noro 839: {
840: int n,t;
841: MP m1,m2;
842:
843: if ( !p1 )
844: return p2 ? -1 : 0;
845: else if ( !p2 )
846: return 1;
847: else {
848: for ( n = NV(p1), m1 = BDY(p1), m2 = BDY(p2);
849: m1 && m2; m1 = NEXT(m1), m2 = NEXT(m2) )
850: if ( (t = (*cmpdl)(n,m1->dl,m2->dl)) ||
851: (t = compp(vl,C(m1),C(m2)) ) )
852: return t;
853: if ( m1 )
854: return 1;
855: else if ( m2 )
856: return -1;
857: else
858: return 0;
859: }
860: }
861:
1.19 ! noro 862: int cmpdl_lex(int n,DL d1,DL d2)
1.1 noro 863: {
864: int i;
865:
866: for ( i = 0; i < n && d1->d[i] == d2->d[i]; i++ );
867: return i == n ? 0 : (d1->d[i] > d2->d[i] ? 1 : -1);
868: }
869:
1.19 ! noro 870: int cmpdl_revlex(int n,DL d1,DL d2)
1.1 noro 871: {
872: int i;
873:
874: for ( i = n - 1; i >= 0 && d1->d[i] == d2->d[i]; i-- );
875: return i < 0 ? 0 : (d1->d[i] < d2->d[i] ? 1 : -1);
876: }
877:
1.19 ! noro 878: int cmpdl_gradlex(int n,DL d1,DL d2)
1.1 noro 879: {
880: if ( d1->td > d2->td )
881: return 1;
882: else if ( d1->td < d2->td )
883: return -1;
884: else
885: return cmpdl_lex(n,d1,d2);
886: }
887:
1.19 ! noro 888: int cmpdl_revgradlex(int n,DL d1,DL d2)
1.1 noro 889: {
1.7 noro 890: register int i;
891: register int *p1,*p2;
892:
1.1 noro 893: if ( d1->td > d2->td )
894: return 1;
895: else if ( d1->td < d2->td )
896: return -1;
1.7 noro 897: else {
898: for ( i= n - 1, p1 = d1->d+n-1, p2 = d2->d+n-1;
899: i >= 0 && *p1 == *p2; i--, p1--, p2-- );
900: return i < 0 ? 0 : (*p1 < *p2 ? 1 : -1);
901: }
1.1 noro 902: }
903:
1.19 ! noro 904: int cmpdl_blex(int n,DL d1,DL d2)
1.1 noro 905: {
906: int c;
907:
908: if ( c = cmpdl_lex(n-1,d1,d2) )
909: return c;
910: else {
911: c = d1->d[n-1] - d2->d[n-1];
912: return c > 0 ? 1 : c < 0 ? -1 : 0;
913: }
914: }
915:
1.19 ! noro 916: int cmpdl_bgradlex(int n,DL d1,DL d2)
1.1 noro 917: {
918: int e1,e2,c;
919:
920: e1 = d1->td - d1->d[n-1]; e2 = d2->td - d2->d[n-1];
921: if ( e1 > e2 )
922: return 1;
923: else if ( e1 < e2 )
924: return -1;
925: else {
926: c = cmpdl_lex(n-1,d1,d2);
927: if ( c )
928: return c;
929: else
930: return d1->td > d2->td ? 1 : d1->td < d2->td ? -1 : 0;
931: }
932: }
933:
1.19 ! noro 934: int cmpdl_brevgradlex(int n,DL d1,DL d2)
1.1 noro 935: {
936: int e1,e2,c;
937:
938: e1 = d1->td - d1->d[n-1]; e2 = d2->td - d2->d[n-1];
939: if ( e1 > e2 )
940: return 1;
941: else if ( e1 < e2 )
942: return -1;
943: else {
944: c = cmpdl_revlex(n-1,d1,d2);
945: if ( c )
946: return c;
947: else
948: return d1->td > d2->td ? 1 : d1->td < d2->td ? -1 : 0;
949: }
950: }
951:
1.19 ! noro 952: int cmpdl_brevrev(int n,DL d1,DL d2)
1.1 noro 953: {
954: int e1,e2,f1,f2,c,i;
955:
956: for ( i = 0, e1 = 0, e2 = 0; i < dp_nelim; i++ ) {
957: e1 += d1->d[i]; e2 += d2->d[i];
958: }
959: f1 = d1->td - e1; f2 = d2->td - e2;
960: if ( e1 > e2 )
961: return 1;
962: else if ( e1 < e2 )
963: return -1;
964: else {
965: c = cmpdl_revlex(dp_nelim,d1,d2);
966: if ( c )
967: return c;
968: else if ( f1 > f2 )
969: return 1;
970: else if ( f1 < f2 )
971: return -1;
972: else {
973: for ( i = n - 1; i >= dp_nelim && d1->d[i] == d2->d[i]; i-- );
974: return i < dp_nelim ? 0 : (d1->d[i] < d2->d[i] ? 1 : -1);
975: }
976: }
977: }
978:
1.19 ! noro 979: int cmpdl_bgradrev(int n,DL d1,DL d2)
1.1 noro 980: {
981: int e1,e2,f1,f2,c,i;
982:
983: for ( i = 0, e1 = 0, e2 = 0; i < dp_nelim; i++ ) {
984: e1 += d1->d[i]; e2 += d2->d[i];
985: }
986: f1 = d1->td - e1; f2 = d2->td - e2;
987: if ( e1 > e2 )
988: return 1;
989: else if ( e1 < e2 )
990: return -1;
991: else {
992: c = cmpdl_lex(dp_nelim,d1,d2);
993: if ( c )
994: return c;
995: else if ( f1 > f2 )
996: return 1;
997: else if ( f1 < f2 )
998: return -1;
999: else {
1000: for ( i = n - 1; i >= dp_nelim && d1->d[i] == d2->d[i]; i-- );
1001: return i < dp_nelim ? 0 : (d1->d[i] < d2->d[i] ? 1 : -1);
1002: }
1003: }
1004: }
1005:
1.19 ! noro 1006: int cmpdl_blexrev(int n,DL d1,DL d2)
1.1 noro 1007: {
1008: int e1,e2,f1,f2,c,i;
1009:
1010: for ( i = 0, e1 = 0, e2 = 0; i < dp_nelim; i++ ) {
1011: e1 += d1->d[i]; e2 += d2->d[i];
1012: }
1013: f1 = d1->td - e1; f2 = d2->td - e2;
1014: c = cmpdl_lex(dp_nelim,d1,d2);
1015: if ( c )
1016: return c;
1017: else if ( f1 > f2 )
1018: return 1;
1019: else if ( f1 < f2 )
1020: return -1;
1021: else {
1022: for ( i = n - 1; i >= dp_nelim && d1->d[i] == d2->d[i]; i-- );
1023: return i < dp_nelim ? 0 : (d1->d[i] < d2->d[i] ? 1 : -1);
1024: }
1025: }
1026:
1.19 ! noro 1027: int cmpdl_elim(int n,DL d1,DL d2)
1.1 noro 1028: {
1029: int e1,e2,i;
1030:
1031: for ( i = 0, e1 = 0, e2 = 0; i < dp_nelim; i++ ) {
1032: e1 += d1->d[i]; e2 += d2->d[i];
1033: }
1034: if ( e1 > e2 )
1035: return 1;
1036: else if ( e1 < e2 )
1037: return -1;
1038: else
1039: return cmpdl_revgradlex(n,d1,d2);
1.12 noro 1040: }
1041:
1.19 ! noro 1042: int cmpdl_weyl_elim(int n,DL d1,DL d2)
1.12 noro 1043: {
1044: int e1,e2,i;
1045:
1046: for ( i = 1, e1 = 0, e2 = 0; i <= dp_nelim; i++ ) {
1047: e1 += d1->d[n-i]; e2 += d2->d[n-i];
1048: }
1049: if ( e1 > e2 )
1050: return 1;
1051: else if ( e1 < e2 )
1052: return -1;
1053: else if ( d1->td > d2->td )
1054: return 1;
1055: else if ( d1->td < d2->td )
1056: return -1;
1057: else return -cmpdl_revlex(n,d1,d2);
1.13 noro 1058: }
1059:
1060: /*
1061: a special ordering
1062: 1. total order
1063: 2. (-w,w) for the first 2*m variables
1064: 3. DRL for the first 2*m variables
1065: */
1066:
1067: extern int *current_weight_vector;
1068:
1.19 ! noro 1069: int cmpdl_homo_ww_drl(int n,DL d1,DL d2)
1.13 noro 1070: {
1071: int e1,e2,m,i;
1072: int *p1,*p2;
1073:
1074: if ( d1->td > d2->td )
1075: return 1;
1076: else if ( d1->td < d2->td )
1077: return -1;
1078:
1079: m = n>>1;
1080: for ( i = 0, e1 = e2 = 0; i < m; i++ ) {
1081: e1 += current_weight_vector[i]*(d1->d[m+i] - d1->d[i]);
1082: e2 += current_weight_vector[i]*(d2->d[m+i] - d2->d[i]);
1083: }
1084: if ( e1 > e2 )
1085: return 1;
1086: else if ( e1 < e2 )
1087: return -1;
1088:
1089: e1 = d1->td - d1->d[n-1];
1090: e2 = d2->td - d2->d[n-1];
1091: if ( e1 > e2 )
1092: return 1;
1093: else if ( e1 < e2 )
1094: return -1;
1095:
1096: for ( i= n - 1, p1 = d1->d+n-1, p2 = d2->d+n-1;
1097: i >= 0 && *p1 == *p2; i--, p1--, p2-- );
1098: return i < 0 ? 0 : (*p1 < *p2 ? 1 : -1);
1.1 noro 1099: }
1100:
1.19 ! noro 1101: int cmpdl_order_pair(int n,DL d1,DL d2)
1.1 noro 1102: {
1103: int e1,e2,i,j,l;
1104: int *t1,*t2;
1105: int len;
1106: struct order_pair *pair;
1107:
1108: len = dp_current_spec.ord.block.length;
1109: pair = dp_current_spec.ord.block.order_pair;
1110:
1111: for ( i = 0, t1 = d1->d, t2 = d2->d; i < len; i++ ) {
1112: l = pair[i].length;
1113: switch ( pair[i].order ) {
1114: case 0:
1115: for ( j = 0, e1 = e2 = 0; j < l; j++ ) {
1116: e1 += t1[j]; e2 += t2[j];
1117: }
1118: if ( e1 > e2 )
1119: return 1;
1120: else if ( e1 < e2 )
1121: return -1;
1122: else {
1123: for ( j = l - 1; j >= 0 && t1[j] == t2[j]; j-- );
1124: if ( j >= 0 )
1125: return t1[j] < t2[j] ? 1 : -1;
1126: }
1127: break;
1128: case 1:
1129: for ( j = 0, e1 = e2 = 0; j < l; j++ ) {
1130: e1 += t1[j]; e2 += t2[j];
1131: }
1132: if ( e1 > e2 )
1133: return 1;
1134: else if ( e1 < e2 )
1135: return -1;
1136: else {
1137: for ( j = 0; j < l && t1[j] == t2[j]; j++ );
1138: if ( j < l )
1139: return t1[j] > t2[j] ? 1 : -1;
1140: }
1141: break;
1142: case 2:
1143: for ( j = 0; j < l && t1[j] == t2[j]; j++ );
1144: if ( j < l )
1145: return t1[j] > t2[j] ? 1 : -1;
1146: break;
1147: default:
1148: error("cmpdl_order_pair : invalid order"); break;
1149: }
1150: t1 += l; t2 += l;
1151: }
1152: return 0;
1153: }
1154:
1.19 ! noro 1155: int cmpdl_matrix(int n,DL d1,DL d2)
1.1 noro 1156: {
1157: int *v,*w,*t1,*t2;
1158: int s,i,j,len;
1159: int **matrix;
1160:
1161: for ( i = 0, t1 = d1->d, t2 = d2->d, w = dp_dl_work; i < n; i++ )
1162: w[i] = t1[i]-t2[i];
1163: len = dp_current_spec.ord.matrix.row;
1164: matrix = dp_current_spec.ord.matrix.matrix;
1165: for ( j = 0; j < len; j++ ) {
1166: v = matrix[j];
1167: for ( i = 0, s = 0; i < n; i++ )
1168: s += v[i]*w[i];
1169: if ( s > 0 )
1170: return 1;
1171: else if ( s < 0 )
1172: return -1;
1173: }
1174: return 0;
1175: }