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