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