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