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