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