Annotation of OpenXM_contrib2/asir2018/builtin/fctr.c, Revision 1.2
1.1 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
26: * e-mail at risa-admin@sec.flab.fujitsu.co.jp of the detailed specification
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.2 ! noro 48: * $OpenXM: OpenXM_contrib2/asir2018/builtin/fctr.c,v 1.1 2018/09/19 05:45:05 noro Exp $
1.1 noro 49: */
50: #include "ca.h"
51: #include "parse.h"
52:
53: void Pfctr(), Pgcd(), Pgcdz(), Plcm(), Psqfr(), Pufctrhint();
54: void Pptozp(), Pcont(), Psfcont();
55: void Pafctr(), Pagcd();
56: void Pmodsqfr(),Pmodfctr(),Pddd(),Pnewddd(),Pddd_tab();
57: void Psfsqfr(),Psffctr(),Psfbfctr(),Psfufctr(),Psfmintdeg(),Psfgcd();
58: void Pirred_check(), Pnfctr_mod();
59: void Pbivariate_hensel_special();
60:
61: void sfmintdeg(VL vl,P fx,int dy,int c,P *fr);
62:
63: struct ftab fctr_tab[] = {
64: {"bivariate_hensel_special",Pbivariate_hensel_special,6},
65: {"fctr",Pfctr,-2},
66: {"gcd",Pgcd,-3},
67: {"gcdz",Pgcdz,2},
68: {"lcm",Plcm,2},
69: {"sqfr",Psqfr,1},
70: {"ufctrhint",Pufctrhint,2},
71: {"ptozp",Pptozp,1},
72: {"cont",Pcont,-2},
73: {"sfcont",Psfcont,-2},
74: {"afctr",Pafctr,2},
75: {"agcd",Pagcd,3},
76: {"modsqfr",Pmodsqfr,2},
77: {"modfctr",Pmodfctr,2},
78: {"sfsqfr",Psfsqfr,1},
79: {"sffctr",Psffctr,1},
80: {"sfufctr",Psfufctr,1},
81: {"sfbfctr",Psfbfctr,-4},
82: {"sfmintdeg",Psfmintdeg,5},
83: {"sfgcd",Psfgcd,2},
84: #if 0
85: {"ddd",Pddd,2},
86: {"newddd",Pnewddd,2},
87: #endif
88: {"ddd_tab",Pddd_tab,2},
89: {"irred_check",Pirred_check,2},
90: {"nfctr_mod",Pnfctr_mod,2},
91: {0,0,0},
92: };
93:
94: /* bivariate_hensel_special(f(x,y):monic in x,g0(x),h0(y),x,y,d) */
95:
96: void Pbivariate_hensel_special(NODE arg,LIST *rp)
97: {
98: DCP dc;
99: struct oVN vn[2];
100: P f,g0,h0,ak,bk,gk,hk;
101: V vx,vy;
102: VL nvl;
103: Z qk;
104: Q cbd,bb;
105: int d;
106: NODE n;
107:
108: f = (P)ARG0(arg);
109: g0 = (P)ARG1(arg);
110: h0 = (P)ARG2(arg);
111: vx = VR((P)ARG3(arg));
112: vy = VR((P)ARG4(arg));
1.2 ! noro 113: d = ZTOS((Q)ARG5(arg));
1.1 noro 114: NEWVL(nvl); nvl->v = vx;
115: NEWVL(NEXT(nvl)); NEXT(nvl)->v = vy;
116: NEXT(NEXT(nvl)) = 0;
117: vn[0].v = vy; vn[0].n = 0;
118: vn[1].v = 0; vn[1].n = 0;
119: cbound(nvl,f,&cbd);
120: addq(cbd,cbd,&bb);
121: henzq1(g0,h0,bb,&bk,&ak,&qk);
122: henmv(nvl,vn,f,g0,h0,ak,bk,(P)ONE,(P)ONE,(P)ONE,(P)ONE,qk,d,&gk,&hk);
123: n = mknode(2,gk,hk);
124: MKLIST(*rp,n);
125: }
126:
127: void Pfctr(NODE arg,LIST *rp)
128: {
129: DCP dc;
130:
131: asir_assert(ARG0(arg),O_P,"fctr");
132: if ( argc(arg) == 1 )
133: fctrp(CO,(P)ARG0(arg),&dc);
134: else {
135: asir_assert(ARG1(arg),O_P,"fctr");
136: fctr_wrt_v_p(CO,(P)ARG0(arg),VR((P)ARG1(arg)),&dc);
137: }
138: dcptolist(dc,rp);
139: }
140:
141: void Pgcd(NODE arg,P *rp)
142: {
143: P p1,p2,g1,g2,g;
144: Num m;
145: int mod;
146:
147: p1 = (P)ARG0(arg); p2 = (P)ARG1(arg);
148: asir_assert(p1,O_P,"gcd");
149: asir_assert(p2,O_P,"gcd");
150: if ( !p1 )
151: *rp = p2;
152: else if ( !p2 )
153: *rp = p1;
154: else if ( !qpcheck((Obj)p1) || !qpcheck((Obj)p2) )
155: gcdprsp(CO,p1,p2,rp);
156: else if ( argc(arg) == 2 )
157: ezgcdp(CO,p1,p2,rp);
158: else {
159: m = (Num)ARG2(arg);
160: asir_assert(m,O_P,"gcd");
1.2 ! noro 161: mod = ZTOS((Q)m);
1.1 noro 162: ptomp(mod,p1,&g1); ptomp(mod,p2,&g2);
163: gcdprsmp(CO,mod,g1,g2,&g);
164: mptop(g,rp);
165: }
166: }
167:
168: void Pgcdz(NODE arg,P *rp)
169: {
170: P p1,p2,t;
171: Q c1,c2;
172: Z n1,n2,n;
173:
174: p1 = (P)ARG0(arg); p2 = (P)ARG1(arg);
175: asir_assert(p1,O_P,"gcdz");
176: asir_assert(p2,O_P,"gcdz");
177: if ( !p1 )
178: *rp = p2;
179: else if ( !p2 )
180: *rp = p1;
181: else if ( !qpcheck((Obj)p1) || !qpcheck((Obj)p2) )
182: error("gcdz : invalid argument");
183: else if ( NUM(p1) || NUM(p2) ) {
184: if ( NUM(p1) )
185: c1 = (Q)p1;
186: else
187: ptozp(p1,1,&c1,&t);
188: if ( NUM(p2) )
189: c2 = (Q)p2;
190: else
191: ptozp(p2,1,&c2,&t);
192: /* XXX */
193: nmq(c1,&n1); nmq(c2,&n2);
194: gcdz(n1,n2,&n); *rp = (P)n;
195: } else {
196: #if 0
197: w[0] = p1; w[1] = p2; nezgcdnpz(CO,w,2,rp);
198: #endif
199: ezgcdpz(CO,p1,p2,rp);
200: }
201: }
202:
203: void Plcm(NODE arg,P *rp)
204: {
205: P t1,t2,p1,p2,g,q;
206: Q c;
207:
208: p1 = (P)ARG0(arg); p2 = (P)ARG1(arg);
209: asir_assert(p1,O_P,"lcm");
210: asir_assert(p2,O_P,"lcm");
211: if ( !p1 || !p2 )
212: *rp = 0;
213: else if ( !qpcheck((Obj)p1) || !qpcheck((Obj)p2) )
214: error("lcm : invalid argument");
215: else {
216: ptozp(p1,1,&c,&t1); ptozp(p2,1,&c,&t2);
217: ezgcdp(CO,t1,t2,&g); divsp(CO,t1,g,&q); mulp(CO,q,t2,rp);
218: }
219: }
220:
221: void Psqfr(NODE arg,LIST *rp)
222: {
223: DCP dc;
224:
225: asir_assert(ARG0(arg),O_P,"sqfr");
226: sqfrp(CO,(P)ARG0(arg),&dc);
227: dcptolist(dc,rp);
228: }
229:
230: void Pufctrhint(NODE arg,LIST *rp)
231: {
232: DCP dc;
233:
234: asir_assert(ARG0(arg),O_P,"ufctrhint");
235: asir_assert(ARG1(arg),O_N,"ufctrhint");
1.2 ! noro 236: ufctr((P)ARG0(arg),ZTOS((Q)ARG1(arg)),&dc);
1.1 noro 237: dcptolist(dc,rp);
238: }
239:
240: #if 0
241: Pmgcd(arg,rp)
242: NODE arg;
243: Obj *rp;
244: {
245: NODE node,tn;
246: int i,m;
247: P *l;
248:
249: node = BDY((LIST)ARG0(arg));
250: for ( i = 0, tn = node; tn; tn = NEXT(tn), i++ );
251: m = i; l = (P *)ALLOCA(m*sizeof(P));
252: for ( i = 0, tn = node; i < m; tn = NEXT(tn), i++ )
253: l[i] = (P)BDY(tn);
254: nezgcdnpz(CO,l,m,rp);
255: }
256: #endif
257:
258: void Pcont(NODE arg,P *rp)
259: {
260: DCP dc;
261: int m;
262: P p,p1;
263: P *l;
264: V v;
265:
266: asir_assert(ARG0(arg),O_P,"cont");
267: p = (P)ARG0(arg);
268: if ( NUM(p) )
269: *rp = p;
270: else {
271: if ( argc(arg) == 2 ) {
272: v = VR((P)ARG1(arg));
273: change_mvar(CO,p,v,&p1);
274: if ( VR(p1) != v ) {
275: *rp = p1; return;
276: } else
277: p = p1;
278: }
279: for ( m = 0, dc = DC(p); dc; dc = NEXT(dc), m++ );
280: l = (P *)ALLOCA(m*sizeof(P));
281: for ( m = 0, dc = DC(p); dc; dc = NEXT(dc), m++ )
282: l[m] = COEF(dc);
283: nezgcdnpz(CO,l,m,rp);
284: }
285: }
286:
287: void Psfcont(NODE arg,P *rp)
288: {
289: DCP dc;
290: MP mp;
291: int m;
292: Obj obj;
293: P p,p1;
294: P *l;
295: V v;
296:
297: obj = (Obj)ARG0(arg);
298: if ( !obj || NUM(obj) )
299: *rp = (P)obj;
300: else if ( OID(obj) == O_P ) {
301: p = (P)obj;
302: if ( argc(arg) == 2 ) {
303: v = VR((P)ARG1(arg));
304: change_mvar(CO,p,v,&p1);
305: if ( VR(p1) != v ) {
306: *rp = p1; return;
307: } else
308: p = p1;
309: }
310: for ( m = 0, dc = DC(p); dc; dc = NEXT(dc), m++ );
311: l = (P *)ALLOCA(m*sizeof(P));
312: for ( m = 0, dc = DC(p); dc; dc = NEXT(dc), m++ )
313: l[m] = COEF(dc);
314: gcdsf(CO,l,m,rp);
315: } else if ( OID(obj) == O_DP ) {
316: for ( m = 0, mp = BDY((DP)obj); mp; mp = NEXT(mp), m++ );
317: l = (P *)ALLOCA(m*sizeof(P));
318: for ( m = 0, mp = BDY((DP)obj); mp; mp = NEXT(mp), m++)
319: l[m] = (P)mp->c;
320: gcdsf(CO,l,m,rp);
321: }
322: }
323:
324: void Pptozp(NODE arg,Obj *rp)
325: {
326: Q t;
327: NODE tt,p;
328: NODE n,n0;
329: char *key;
330: P pp;
331: LIST list;
332: int get_factor=0;
333:
334: asir_assert(ARG0(arg),O_P,"ptozp");
335:
336: /* analyze the option */
337: if ( current_option ) {
338: for ( tt = current_option; tt; tt = NEXT(tt) ) {
339: p = BDY((LIST)BDY(tt));
340: key = BDY((STRING)BDY(p));
341: /* value = (Obj)BDY(NEXT(p)); */
342: if ( !strcmp(key,"factor") ) get_factor=1;
343: else {
344: error("ptozp: unknown option.");
345: }
346: }
347: }
348:
349: ptozp((P)ARG0(arg),1,&t,&pp);
350:
351: /* printexpr(NULL,t); */
352: /* if the option factor is given, then it returns the answer
353: in the format [zpoly, num] where num*zpoly is equal to the argument.*/
354: if (get_factor) {
355: n0 = mknode(2,pp,t);
356: MKLIST(list,n0);
357: *rp = (Obj)list;
358: } else
359: *rp = (Obj)pp;
360: }
361:
362: void Pafctr(NODE arg,LIST *rp)
363: {
364: DCP dc;
365:
366: asir_assert(ARG0(arg),O_P,"afctr");
367: asir_assert(ARG1(arg),O_P,"afctr");
368: afctr(CO,(P)ARG0(arg),(P)ARG1(arg),&dc);
369: dcptolist(dc,rp);
370: }
371:
372: void Pagcd(NODE arg,P *rp)
373: {
374: asir_assert(ARG0(arg),O_P,"agcd");
375: asir_assert(ARG1(arg),O_P,"agcd");
376: asir_assert(ARG2(arg),O_P,"agcd");
377: gcda(CO,(P)ARG0(arg),(P)ARG1(arg),(P)ARG2(arg),rp);
378: }
379:
380: #if 1
381: #define Mulum mulum
382: #define Divum divum
383: #define Mulsum mulsum
384: #define Gcdum gcdum
385: #endif
386:
387: void Mulum(), Mulsum(), Gcdum();
388: int Divum();
389:
390: #define FCTR 0 /* berlekamp */
391: #define SQFR 1
392: #define DDD 2 /* Cantor-Zassenhauss */
393: #define NEWDDD 3 /* berlekamp + root-finding by Cantor-Zassenhauss */
394:
395: UM *resberle();
396:
397: void reduce_sfdc(DCP sfdc, DCP *dc);
398:
399: void Pmodfctr(NODE arg,LIST *rp)
400: {
401: DCP dc,dcu;
402: int mod,i,t;
403: P p;
404: Obj u;
405: VL vl;
406:
1.2 ! noro 407: mod = ZTOS((Q)ARG1(arg));
1.1 noro 408: if ( mod < 0 )
409: error("modfctr : invalid modulus");
410: p = (P)ARG0(arg);
411: clctv(CO,p,&vl);
412: if ( !vl ) {
413: NEWDC(dc); COEF(dc) = p; DEG(dc) = ONE; NEXT(dc) = 0;
414: } else if ( !NEXT(vl) )
415: modfctrp(ARG0(arg),mod,NEWDDD,&dc);
416: else {
417: /* XXX 16384 should be replaced by a macro */
418: for ( i = 1, t = mod; t*mod < 16384; t *= mod, i++ );
419: current_ff = FF_GFS;
420: setmod_sf(mod,i);
421: simp_ff((Obj)p,&u);
422: mfctrsf(CO,(P)u,&dcu);
423: reduce_sfdc(dcu,&dc);
424: }
425: if ( !dc ) {
426: NEWDC(dc); COEF(dc) = 0; DEG(dc) = ONE; NEXT(dc) = 0;
427: }
428: dcptolist(dc,rp);
429: }
430:
431: void Psfgcd(NODE arg,P *rp)
432: {
433: P ps[2];
434:
435: ps[0] = (P)ARG0(arg);
436: ps[1] = (P)ARG1(arg);
437: gcdsf(CO,ps,2,rp);
438: }
439:
440: void Psffctr(NODE arg,LIST *rp)
441: {
442: DCP dc;
443:
444: mfctrsf(CO,ARG0(arg),&dc);
445: dcptolist(dc,rp);
446: }
447:
448: void Psfsqfr(NODE arg,LIST *rp)
449: {
450: DCP dc;
451:
452: sqfrsf(CO,ARG0(arg),&dc);
453: dcptolist(dc,rp);
454: }
455:
456: void Psfufctr(NODE arg,LIST *rp)
457: {
458: DCP dc;
459:
460: ufctrsf(ARG0(arg),&dc);
461: dcptolist(dc,rp);
462: }
463:
464: void Psfbfctr(NODE arg,LIST *rp)
465: {
466: V x,y;
467: DCP dc,dct;
468: P t;
469: struct oVL vl1,vl2;
470: VL vl;
471: int degbound;
472:
473: x = VR((P)ARG1(arg));
474: y = VR((P)ARG2(arg));
475: vl1.v = x; vl1.next = &vl2;
476: vl2.v = y; vl2.next = 0;
477: vl = &vl1;
478: if ( argc(arg) == 4 )
1.2 ! noro 479: degbound = ZTOS((Q)ARG3(arg));
1.1 noro 480: else
481: degbound = -1;
482:
483: sfbfctr((P)ARG0(arg),x,y,degbound,&dc);
484: for ( dct = dc; dct; dct = NEXT(dct) ) {
485: reorderp(CO,vl,COEF(dct),&t); COEF(dct) = t;
486: }
487: dcptolist(dc,rp);
488: }
489:
490: void Psfmintdeg(NODE arg,P *rp)
491: {
492: V x,y;
493: P r;
494: struct oVL vl1,vl2;
495: VL vl;
496: int dy,c;
497:
498: x = VR((P)ARG1(arg));
499: y = VR((P)ARG2(arg));
500: vl1.v = x; vl1.next = &vl2;
501: vl2.v = y; vl2.next = 0;
502: vl = &vl1;
1.2 ! noro 503: dy = ZTOS((Q)ARG3(arg));
! 504: c = ZTOS((Q)ARG4(arg));
1.1 noro 505: sfmintdeg(vl,(P)ARG0(arg),dy,c,&r);
506: reorderp(CO,vl,r,rp);
507: }
508:
509: void Pmodsqfr(NODE arg,LIST *rp)
510: {
511: DCP dc;
512:
513: if ( !ARG0(arg) ) {
514: NEWDC(dc); COEF(dc) = 0; DEG(dc) = ONE; NEXT(dc) = 0;
515: } else
1.2 ! noro 516: modfctrp(ARG0(arg),ZTOS((Q)ARG1(arg)),SQFR,&dc);
1.1 noro 517: dcptolist(dc,rp);
518: }
519:
520: void Pddd(NODE arg,LIST *rp)
521: {
522: DCP dc;
523:
524: if ( !ARG0(arg) ) {
525: NEWDC(dc); COEF(dc) = 0; DEG(dc) = ONE; NEXT(dc) = 0;
526: } else
1.2 ! noro 527: modfctrp(ARG0(arg),ZTOS((Q)ARG1(arg)),DDD,&dc);
1.1 noro 528: dcptolist(dc,rp);
529: }
530:
531: void Pnewddd(NODE arg,LIST *rp)
532: {
533: DCP dc=0;
534:
535: if ( !ARG0(arg) ) {
536: NEWDC(dc); COEF(dc) = 0; DEG(dc) = ONE; NEXT(dc) = 0;
537: } else
1.2 ! noro 538: modfctrp(ARG0(arg),ZTOS((Q)ARG1(arg)),NEWDDD,&dc);
1.1 noro 539: dcptolist(dc,rp);
540: }
541:
542: void Pirred_check(NODE arg,Z *rp)
543: {
544: P p;
545: UM mp;
546: int r,mod;
547:
548: p = (P)ARG0(arg);
549: if ( !p ) {
550: *rp = 0; return;
551: }
552: mp = W_UMALLOC(UDEG(p));
1.2 ! noro 553: mod = ZTOS((Q)ARG1(arg));
1.1 noro 554: ptoum(mod,p,mp);
555: r = irred_check(mp,mod);
556: if ( r )
557: *rp = ONE;
558: else
559: *rp = 0;
560: }
561:
562: void Pnfctr_mod(NODE arg,Z *rp)
563: {
564: P p;
565: UM mp;
566: int r,mod;
567:
568: p = (P)ARG0(arg);
569: if ( !p ) {
570: *rp = 0; return;
571: }
572: mp = W_UMALLOC(UDEG(p));
1.2 ! noro 573: mod = ZTOS((Q)ARG1(arg));
1.1 noro 574: ptoum(mod,p,mp);
575: r = nfctr_mod(mp,mod);
1.2 ! noro 576: STOZ(r,*rp);
1.1 noro 577: }
578:
579: void Pddd_tab(NODE arg,VECT *rp)
580: {
581: P p;
582: UM mp,t,q,r1,w,w1;
583: UM *r,*s;
584: int dr,mod,n,i;
585: VECT result;
586: V v;
587:
1.2 ! noro 588: p = (P)ARG0(arg); mod = ZTOS((Q)ARG1(arg));
1.1 noro 589: v = VR(p);
590: n = UDEG(p); mp = W_UMALLOC(n);
591: ptoum(mod,p,mp);
592: r = (UM *)W_ALLOC(n); s = (UM *)W_ALLOC(n);
593: r[0] = UMALLOC(0); DEG(r[0]) = 0; COEF(r[0])[0] = 1;
594: t = W_UMALLOC(mod); bzero(COEF(t),sizeof(int)*(mod+1));
595: DEG(t) = mod; COEF(t)[mod] = 1;
596: q = W_UMALLOC(mod);
597: dr = divum(mod,t,mp,q);
598: DEG(t) = dr; r[1] = r1 = UMALLOC(dr); cpyum(t,r1);
599: s[0] = W_UMALLOC(dr); cpyum(t,s[0]);
600: w = W_UMALLOC(n); bzero(COEF(w),sizeof(int)*(n+1));
601: w1 = W_UMALLOC(2*n); bzero(COEF(w1),sizeof(int)*(2*n+1));
602: for ( i = 1; i < n; i++ ) {
603: DEG(w) = i; COEF(w)[i-1] = 0; COEF(w)[i] = 1;
604: mulum(mod,r1,w,w1);
605: dr = divum(mod,w1,mp,q); DEG(w1) = dr;
606: s[i] = W_UMALLOC(dr); cpyum(w1,s[i]);
607: }
608: for ( i = 2; i < n; i++ ) {
609: mult_mod_tab(r[i-1],mod,s,w,n);
610: r[i] = UMALLOC(DEG(w)); cpyum(w,r[i]);
611: }
612: MKVECT(result,n);
613: for ( i = 0; i < n; i++ )
614: umtop(v,r[i],(P *)&BDY(result)[i]);
615: *rp = result;
616: }
617:
618: void reduce_sfdc(DCP sfdc,DCP *dcr)
619: {
620: P c,t,s,u,f;
621: DCP dc0,dc,tdc;
622: DCP *a;
623: int i,j,n;
624:
625: if ( !current_gfs_ext ) {
626: /* we simply apply sfptop() */
627: for ( dc0 = 0; sfdc; sfdc = NEXT(sfdc) ) {
628: NEXTDC(dc0,dc);
629: DEG(dc) = DEG(sfdc);
630: sfptop(COEF(sfdc),&COEF(dc));
631: }
632: NEXT(dc) = 0;
633: *dcr = dc0;
634: return;
635: }
636:
637: if ( NUM(COEF(sfdc)) ) {
638: sfptop(COEF(sfdc),&c);
639: sfdc = NEXT(sfdc);
640: } else
641: c = (P)ONE;
642:
643: for ( n = 0, tdc = sfdc; tdc; tdc = NEXT(tdc), n++ );
644: a = (DCP *)ALLOCA(n*sizeof(DCP));
645: for ( i = 0, tdc = sfdc; i < n; tdc = NEXT(tdc), i++ )
646: a[i] = tdc;
647:
648: dc0 = 0; NEXTDC(dc0,dc); DEG(dc) = ONE; COEF(dc) = c;
649: for ( i = 0; i < n; i++ ) {
650: if ( !a[i] )
651: continue;
652: t = COEF(a[i]);
653: f = t;
654: while ( 1 ) {
655: sf_galois_action(t,(Q)ONE,&s);
656: for ( j = i; j < n; j++ )
657: if ( a[j] && !compp(CO,s,COEF(a[j])) )
658: break;
659: if ( j == n )
660: error("reduce_sfdc : cannot happen");
661: if ( j == i ) {
662: NEXTDC(dc0,dc); DEG(dc) = DEG(a[i]);
663: sfptop(f,&COEF(dc));
664: break;
665: } else {
666: mulp(CO,f,s,&u); f = u;
667: t = s;
668: a[j] = 0;
669: }
670: }
671: }
672: *dcr = dc0;
673: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>