![[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|
Return to fctr.c CVS log | Up to [local] / OpenXM_contrib2 / asir2000 / builtin |
1.1 ! noro 1: /* $OpenXM: OpenXM/src/asir99/builtin/fctr.c,v 1.1.1.1 1999/11/10 08:12:25 noro Exp $ */
! 2: #include "ca.h"
! 3: #include "parse.h"
! 4:
! 5: void Pfctr(), Pgcd(), Pgcdz(), Plcm(), Psqfr(), Pufctrhint();
! 6: void Pptozp(), Pcont();
! 7: void Pafctr(), Pagcd();
! 8: void Pmodsqfr(),Pmodfctr(),Pddd(),Pnewddd(),Pddd_tab();
! 9: void Pirred_check(), Pnfctr_mod();
! 10:
! 11: struct ftab fctr_tab[] = {
! 12: {"fctr",Pfctr,1},
! 13: {"gcd",Pgcd,-3},
! 14: {"gcdz",Pgcdz,2},
! 15: {"lcm",Plcm,2},
! 16: {"sqfr",Psqfr,1},
! 17: {"ufctrhint",Pufctrhint,2},
! 18: {"ptozp",Pptozp,1},
! 19: {"cont",Pcont,-2},
! 20: {"afctr",Pafctr,2},
! 21: {"agcd",Pagcd,3},
! 22: {"modsqfr",Pmodsqfr,2},
! 23: {"modfctr",Pmodfctr,2},
! 24: #if 0
! 25: {"ddd",Pddd,2},
! 26: {"newddd",Pnewddd,2},
! 27: #endif
! 28: {"ddd_tab",Pddd_tab,2},
! 29: {"irred_check",Pirred_check,2},
! 30: {"nfctr_mod",Pnfctr_mod,2},
! 31: {0,0,0},
! 32: };
! 33:
! 34: void Pfctr(arg,rp)
! 35: NODE arg;
! 36: LIST *rp;
! 37: {
! 38: DCP dc;
! 39:
! 40: asir_assert(ARG0(arg),O_P,"fctr");
! 41: fctrp(CO,(P)ARG0(arg),&dc);
! 42: dcptolist(dc,rp);
! 43: }
! 44:
! 45: void Pgcd(arg,rp)
! 46: NODE arg;
! 47: P *rp;
! 48: {
! 49: P p1,p2,g1,g2,g;
! 50: Num m;
! 51: int mod;
! 52:
! 53: p1 = (P)ARG0(arg); p2 = (P)ARG1(arg);
! 54: asir_assert(p1,O_P,"gcd");
! 55: asir_assert(p2,O_P,"gcd");
! 56: if ( !p1 )
! 57: *rp = p2;
! 58: else if ( !p2 )
! 59: *rp = p1;
! 60: else if ( !qpcheck((Obj)p1) || !qpcheck((Obj)p2) )
! 61: error("gcd : invalid argument");
! 62: else if ( argc(arg) == 2 )
! 63: ezgcdp(CO,p1,p2,rp);
! 64: else {
! 65: m = (Num)ARG2(arg);
! 66: asir_assert(m,O_P,"gcd");
! 67: mod = QTOS((Q)m);
! 68: ptomp(mod,p1,&g1); ptomp(mod,p2,&g2);
! 69: gcdprsmp(CO,mod,g1,g2,&g);
! 70: mptop(g,rp);
! 71: }
! 72: }
! 73:
! 74: void Pgcdz(arg,rp)
! 75: NODE arg;
! 76: P *rp;
! 77: {
! 78: P p1,p2,t;
! 79: Q c1,c2;
! 80: N n;
! 81:
! 82: p1 = (P)ARG0(arg); p2 = (P)ARG1(arg);
! 83: asir_assert(p1,O_P,"gcdz");
! 84: asir_assert(p2,O_P,"gcdz");
! 85: if ( !p1 )
! 86: *rp = p2;
! 87: else if ( !p2 )
! 88: *rp = p1;
! 89: else if ( !qpcheck((Obj)p1) || !qpcheck((Obj)p2) )
! 90: error("gcdz : invalid argument");
! 91: else if ( NUM(p1) || NUM(p2) ) {
! 92: if ( NUM(p1) )
! 93: c1 = (Q)p1;
! 94: else
! 95: ptozp(p1,1,&c1,&t);
! 96: if ( NUM(p2) )
! 97: c2 = (Q)p2;
! 98: else
! 99: ptozp(p2,1,&c2,&t);
! 100: gcdn(NM(c1),NM(c2),&n); NTOQ(n,1,c1); *rp = (P)c1;
! 101: } else {
! 102: #if 0
! 103: w[0] = p1; w[1] = p2; nezgcdnpz(CO,w,2,rp);
! 104: #endif
! 105: ezgcdpz(CO,p1,p2,rp);
! 106: }
! 107: }
! 108:
! 109: void Plcm(arg,rp)
! 110: NODE arg;
! 111: P *rp;
! 112: {
! 113: P t1,t2,p1,p2,g,q;
! 114: Q c;
! 115:
! 116: p1 = (P)ARG0(arg); p2 = (P)ARG1(arg);
! 117: asir_assert(p1,O_P,"lcm");
! 118: asir_assert(p2,O_P,"lcm");
! 119: if ( !p1 || !p2 )
! 120: *rp = 0;
! 121: else if ( !qpcheck((Obj)p1) || !qpcheck((Obj)p2) )
! 122: error("lcm : invalid argument");
! 123: else {
! 124: ptozp(p1,1,&c,&t1); ptozp(p2,1,&c,&t2);
! 125: ezgcdp(CO,t1,t2,&g); divsp(CO,t1,g,&q); mulp(CO,q,t2,rp);
! 126: }
! 127: }
! 128:
! 129: void Psqfr(arg,rp)
! 130: NODE arg;
! 131: LIST *rp;
! 132: {
! 133: DCP dc;
! 134:
! 135: asir_assert(ARG0(arg),O_P,"sqfr");
! 136: sqfrp(CO,(P)ARG0(arg),&dc);
! 137: dcptolist(dc,rp);
! 138: }
! 139:
! 140: void Pufctrhint(arg,rp)
! 141: NODE arg;
! 142: LIST *rp;
! 143: {
! 144: DCP dc;
! 145:
! 146: asir_assert(ARG0(arg),O_P,"ufctrhint");
! 147: asir_assert(ARG1(arg),O_N,"ufctrhint");
! 148: ufctr((P)ARG0(arg),QTOS((Q)ARG1(arg)),&dc);
! 149: dcptolist(dc,rp);
! 150: }
! 151:
! 152: #if 0
! 153: Pmgcd(arg,rp)
! 154: NODE arg;
! 155: Obj *rp;
! 156: {
! 157: NODE node,tn;
! 158: int i,m;
! 159: P *l;
! 160:
! 161: node = BDY((LIST)ARG0(arg));
! 162: for ( i = 0, tn = node; tn; tn = NEXT(tn), i++ );
! 163: m = i; l = (P *)ALLOCA(m*sizeof(P));
! 164: for ( i = 0, tn = node; i < m; tn = NEXT(tn), i++ )
! 165: l[i] = (P)BDY(tn);
! 166: nezgcdnpz(CO,l,m,rp);
! 167: }
! 168: #endif
! 169:
! 170: void Pcont(arg,rp)
! 171: NODE arg;
! 172: P *rp;
! 173: {
! 174: DCP dc;
! 175: int m;
! 176: P p,p1;
! 177: P *l;
! 178: V v;
! 179:
! 180: asir_assert(ARG0(arg),O_P,"cont");
! 181: p = (P)ARG0(arg);
! 182: if ( NUM(p) )
! 183: *rp = p;
! 184: else {
! 185: if ( argc(arg) == 2 ) {
! 186: v = VR((P)ARG1(arg));
! 187: change_mvar(CO,p,v,&p1);
! 188: if ( VR(p1) != v ) {
! 189: *rp = p1; return;
! 190: } else
! 191: p = p1;
! 192: }
! 193: for ( m = 0, dc = DC(p); dc; dc = NEXT(dc), m++ );
! 194: l = (P *)ALLOCA(m*sizeof(P));
! 195: for ( m = 0, dc = DC(p); dc; dc = NEXT(dc), m++ )
! 196: l[m] = COEF(dc);
! 197: nezgcdnpz(CO,l,m,rp);
! 198: }
! 199: }
! 200:
! 201: void Pptozp(arg,rp)
! 202: NODE arg;
! 203: P *rp;
! 204: {
! 205: Q t;
! 206:
! 207: asir_assert(ARG0(arg),O_P,"ptozp");
! 208: ptozp((P)ARG0(arg),1,&t,rp);
! 209: }
! 210:
! 211: void Pafctr(arg,rp)
! 212: NODE arg;
! 213: LIST *rp;
! 214: {
! 215: DCP dc;
! 216:
! 217: asir_assert(ARG0(arg),O_P,"afctr");
! 218: asir_assert(ARG1(arg),O_P,"afctr");
! 219: afctr(CO,(P)ARG0(arg),(P)ARG1(arg),&dc);
! 220: dcptolist(dc,rp);
! 221: }
! 222:
! 223: void Pagcd(arg,rp)
! 224: NODE arg;
! 225: P *rp;
! 226: {
! 227: asir_assert(ARG0(arg),O_P,"agcd");
! 228: asir_assert(ARG1(arg),O_P,"agcd");
! 229: asir_assert(ARG2(arg),O_P,"agcd");
! 230: gcda(CO,(P)ARG0(arg),(P)ARG1(arg),(P)ARG2(arg),rp);
! 231: }
! 232:
! 233: #if 1
! 234: #define Mulum mulum
! 235: #define Divum divum
! 236: #define Mulsum mulsum
! 237: #define Gcdum gcdum
! 238: #endif
! 239:
! 240: void Mulum(), Mulsum(), Gcdum();
! 241: int Divum();
! 242:
! 243: #define FCTR 0 /* berlekamp */
! 244: #define SQFR 1
! 245: #define DDD 2 /* Cantor-Zassenhauss */
! 246: #define NEWDDD 3 /* berlekamp + root-finding by Cantor-Zassenhauss */
! 247:
! 248: UM *resberle();
! 249:
! 250: void Pmodfctr(arg,rp)
! 251: NODE arg;
! 252: LIST *rp;
! 253: {
! 254: DCP dc;
! 255: int mod;
! 256:
! 257: mod = QTOS((Q)ARG1(arg));
! 258: if ( mod < 0 )
! 259: error("modfctr : invalid modulus");
! 260: modfctrp(ARG0(arg),mod,NEWDDD,&dc);
! 261: if ( !dc ) {
! 262: NEWDC(dc); COEF(dc) = 0; DEG(dc) = ONE; NEXT(dc) = 0;
! 263: }
! 264: dcptolist(dc,rp);
! 265: }
! 266:
! 267: void Pmodsqfr(arg,rp)
! 268: NODE arg;
! 269: LIST *rp;
! 270: {
! 271: DCP dc;
! 272:
! 273: if ( !dc ) {
! 274: NEWDC(dc); COEF(dc) = 0; DEG(dc) = ONE; NEXT(dc) = 0;
! 275: }
! 276: modfctrp(ARG0(arg),QTOS((Q)ARG1(arg)),SQFR,&dc);
! 277: dcptolist(dc,rp);
! 278: }
! 279:
! 280: void Pddd(arg,rp)
! 281: NODE arg;
! 282: LIST *rp;
! 283: {
! 284: DCP dc;
! 285:
! 286: if ( !dc ) {
! 287: NEWDC(dc); COEF(dc) = 0; DEG(dc) = ONE; NEXT(dc) = 0;
! 288: }
! 289: modfctrp(ARG0(arg),QTOS((Q)ARG1(arg)),DDD,&dc);
! 290: dcptolist(dc,rp);
! 291: }
! 292:
! 293: void Pnewddd(arg,rp)
! 294: NODE arg;
! 295: LIST *rp;
! 296: {
! 297: DCP dc;
! 298:
! 299: if ( !dc ) {
! 300: NEWDC(dc); COEF(dc) = 0; DEG(dc) = ONE; NEXT(dc) = 0;
! 301: }
! 302: modfctrp(ARG0(arg),QTOS((Q)ARG1(arg)),NEWDDD,&dc);
! 303: dcptolist(dc,rp);
! 304: }
! 305:
! 306: void Pirred_check(arg,rp)
! 307: NODE arg;
! 308: Q *rp;
! 309: {
! 310: P p;
! 311: UM mp;
! 312: int r,mod;
! 313:
! 314: p = (P)ARG0(arg);
! 315: if ( !p ) {
! 316: *rp = 0; return;
! 317: }
! 318: mp = W_UMALLOC(UDEG(p));
! 319: mod = QTOS((Q)ARG1(arg));
! 320: ptoum(mod,p,mp);
! 321: r = irred_check(mp,mod);
! 322: if ( r )
! 323: *rp = ONE;
! 324: else
! 325: *rp = 0;
! 326: }
! 327:
! 328: void Pnfctr_mod(arg,rp)
! 329: NODE arg;
! 330: Q *rp;
! 331: {
! 332: P p;
! 333: UM mp;
! 334: int r,mod;
! 335:
! 336: p = (P)ARG0(arg);
! 337: if ( !p ) {
! 338: *rp = 0; return;
! 339: }
! 340: mp = W_UMALLOC(UDEG(p));
! 341: mod = QTOS((Q)ARG1(arg));
! 342: ptoum(mod,p,mp);
! 343: r = nfctr_mod(mp,mod);
! 344: STOQ(r,*rp);
! 345: }
! 346:
! 347: void Pddd_tab(arg,rp)
! 348: NODE arg;
! 349: VECT *rp;
! 350: {
! 351: P p;
! 352: UM mp,t,q,r1,w,w1;
! 353: UM *r,*s;
! 354: int dr,mod,n,i;
! 355: VECT result;
! 356: V v;
! 357:
! 358: p = (P)ARG0(arg); mod = QTOS((Q)ARG1(arg));
! 359: v = VR(p);
! 360: n = UDEG(p); mp = W_UMALLOC(n);
! 361: ptoum(mod,p,mp);
! 362: r = (UM *)W_ALLOC(n); s = (UM *)W_ALLOC(n);
! 363: r[0] = UMALLOC(0); DEG(r[0]) = 0; COEF(r[0])[0] = 1;
! 364: t = W_UMALLOC(mod); bzero(COEF(t),sizeof(int)*(mod+1));
! 365: DEG(t) = mod; COEF(t)[mod] = 1;
! 366: q = W_UMALLOC(mod);
! 367: dr = divum(mod,t,mp,q);
! 368: DEG(t) = dr; r[1] = r1 = UMALLOC(dr); cpyum(t,r1);
! 369: s[0] = W_UMALLOC(dr); cpyum(t,s[0]);
! 370: w = W_UMALLOC(n); bzero(COEF(w),sizeof(int)*(n+1));
! 371: w1 = W_UMALLOC(2*n); bzero(COEF(w1),sizeof(int)*(2*n+1));
! 372: for ( i = 1; i < n; i++ ) {
! 373: DEG(w) = i; COEF(w)[i-1] = 0; COEF(w)[i] = 1;
! 374: mulum(mod,r1,w,w1);
! 375: dr = divum(mod,w1,mp,q); DEG(w1) = dr;
! 376: s[i] = W_UMALLOC(dr); cpyum(w1,s[i]);
! 377: }
! 378: for ( i = 2; i < n; i++ ) {
! 379: mult_mod_tab(r[i-1],mod,s,w,n);
! 380: r[i] = UMALLOC(DEG(w)); cpyum(w,r[i]);
! 381: }
! 382: MKVECT(result,n);
! 383: for ( i = 0; i < n; i++ )
! 384: umtop(v,r[i],(P *)&BDY(result)[i]);
! 385: *rp = result;
! 386: }