[BACK]Return to Fgfs.c CVS log [TXT][DIR] Up to [local] / OpenXM_contrib2 / asir2000 / engine

Annotation of OpenXM_contrib2/asir2000/engine/Fgfs.c, Revision 1.3

1.3     ! noro        1: /* $OpenXM: OpenXM_contrib2/asir2000/engine/Fgfs.c,v 1.2 2002/09/26 09:07:42 noro Exp $ */
1.1       noro        2:
                      3: #include "ca.h"
                      4:
1.3     ! noro        5: void cont_pp_mv_sf(VL vl,VL rvl,P p,P *c,P *pp);
        !             6: void gcdsf_main(VL vl,P *pa,int m,P *r);
        !             7: void ugcdsf(P *pa,int m,P *r);
        !             8: void head_monomial(V v,P p,P *coef,P *term);
1.1       noro        9:
                     10: void gcdsf(VL vl,P *pa,int k,P *r)
                     11: {
1.3     ! noro       12:        P *ps,*pl,*pm;
        !            13:        P **cp;
1.1       noro       14:        int *cn;
                     15:        DCP *ml;
                     16:        Obj obj;
                     17:        int i,j,l,m;
                     18:        P mg,mgsf,t;
                     19:        VL avl,nvl,tvl,svl;
                     20:
                     21:        ps = (P *)ALLOCA(k*sizeof(P));
                     22:        for ( i = 0, m = 0; i < k; i++ ) {
                     23:                simp_ff((Obj)pa[i],&obj);
                     24:                if ( obj )
1.3     ! noro       25:                        ps[m++] = (P)obj;
1.1       noro       26:        }
                     27:        if ( !m ) {
                     28:                *r = 0;
                     29:                return;
                     30:        }
                     31:        if ( m == 1 ) {
1.3     ! noro       32:                *r = ps[0];
1.1       noro       33:                return;
                     34:        }
                     35:        pl = (P *)ALLOCA(m*sizeof(P));
                     36:        ml = (DCP *)ALLOCA(m*sizeof(DCP));
                     37:        for ( i = 0; i < m; i++ )
                     38:                monomialfctr(vl,ps[i],&pl[i],&ml[i]);
1.3     ! noro       39:        gcdmonomial(vl,ml,m,&mg); simp_ff((Obj)mg,&obj); mgsf = (P)obj;
1.1       noro       40:        for ( i = 0, nvl = vl, avl = 0; nvl && i < m; i++ ) {
                     41:                clctv(vl,pl[i],&tvl);
                     42:                intersectv(nvl,tvl,&svl); nvl = svl;
                     43:                mergev(vl,avl,tvl,&svl); avl = svl;
                     44:        }
                     45:        if ( !nvl ) {
                     46:                *r = mgsf;
                     47:                return;
                     48:        }
                     49:        if ( !NEXT(avl) ) {
                     50:                ugcdsf(pl,m,&t);
                     51:                mulp(vl,mgsf,t,r);
                     52:                return;
                     53:        }
                     54:        for ( tvl = nvl, i = 0; tvl; tvl = NEXT(tvl), i++ );
                     55:        for ( tvl = avl, j = 0; tvl; tvl = NEXT(tvl), j++ );
                     56:        if ( i == j ) {
                     57:                /* all the pl[i]'s have the same variables */
                     58:                gcdsf_main(avl,pl,m,&t);
                     59:        } else {
                     60:                cp = (P **)ALLOCA(m*sizeof(P *));
                     61:                cn = (int *)ALLOCA(m*sizeof(int));
                     62:                for ( i = 0; i < m; i++ ) {
                     63:                        cp[i] = (P *)ALLOCA(lengthp(pl[i])*sizeof(P));
                     64:                        cn[i] = pcoef(vl,nvl,pl[i],cp[i]);
                     65:                }
                     66:                for ( i = j = 0; i < m; i++ )
                     67:                        j += cn[i];
                     68:                pm = (P *)ALLOCA(j*sizeof(P));
                     69:                for ( i = l = 0; i < m; i++ )
                     70:                        for ( j = 0; j < cn[i]; j++ )
                     71:                                pm[l++] = cp[i][j];
                     72:                gcdsf(vl,pm,l,&t);
                     73:        }
                     74:        mulp(vl,mgsf,t,r);
                     75: }
                     76:
                     77: /* univariate gcd */
                     78:
                     79: void ugcdsf(P *pa,int m,P *r)
                     80: {
1.3     ! noro       81:        P *ps;
1.1       noro       82:        int i;
                     83:        UM w1,w2,w3,w;
                     84:        int d;
                     85:        V v;
                     86:
                     87:        if ( m == 1 ) {
                     88:                *r = pa[0];
                     89:                return;
                     90:        }
1.3     ! noro       91:        for ( i = 0; i < m; i++ )
        !            92:                if ( NUM(pa[i]) ) {
        !            93:                        itogfs(1,r);
        !            94:                        return;
        !            95:                }
1.1       noro       96:        ps = (P *)ALLOCA(m*sizeof(P));
                     97:        sort_by_deg(m,pa,ps);
1.3     ! noro       98:        v = VR(ps[m-1]);
        !            99:        d = getdeg(v,ps[m-1]);
1.1       noro      100:        w1 = W_UMALLOC(d);
                    101:        w2 = W_UMALLOC(d);
                    102:        w3 = W_UMALLOC(d);
                    103:        ptosfum(ps[0],w1);
                    104:        for ( i = 1; i < m; i++ ) {
                    105:                ptosfum(ps[i],w2);
                    106:                gcdsfum(w1,w2,w3);
                    107:                w = w1; w1 = w3; w3 = w;
                    108:                if ( !DEG(w1) ) {
1.3     ! noro      109:                        itogfs(1,r);
1.1       noro      110:                        return;
                    111:                }
                    112:        }
                    113:        sfumtop(v,w1,r);
                    114: }
                    115:
                    116:
                    117: /* all the pa[i]'s have the same variables (=vl) */
                    118:
                    119: void gcdsf_main(VL vl,P *pa,int m,P *r)
                    120: {
1.3     ! noro      121:        int nv,i,i0,imin,d,d0,d1,d2,dmin,index;
        !           122:        V v,v0,vmin;
1.2       noro      123:        VL tvl,nvl,rvl,nvl0,rvl0;
1.3     ! noro      124:        P *pc, *ps, *ph,*lps;
        !           125:        P x,t,cont,hg,g,hm,mod,s;
        !           126:        P hge,ge,ce,he,u,cof1e,mode,mod1,adj,cof1,coadj,q;
        !           127:        GFS sf;
1.2       noro      128:
1.1       noro      129:        for ( nv = 0, tvl = vl; tvl; tvl = NEXT(tvl), nv++);
                    130:        if ( nv == 1 ) {
                    131:                ugcdsf(pa,m,r);
                    132:                return;
                    133:        }
                    134:        /* find v s.t. min(deg(pa[i],v)) is minimal */
                    135:        tvl = vl;
                    136:        do {
                    137:                v = tvl->v;
                    138:                i = 0;
                    139:                do {
1.3     ! noro      140:                        d = getdeg(v,pa[i]);
1.1       noro      141:                        if ( i == 0 || (d < d0) ) {
                    142:                                d0 = d; i0 = i; v0 = v;
                    143:                        }
                    144:                } while ( ++i < m );
                    145:                if ( tvl == vl || (d0 < dmin) ) {
                    146:                        dmin = d0; imin = i0; vmin = v0;
                    147:                }
                    148:        } while ( tvl = NEXT(tvl) );
                    149:
                    150:        /* reorder variables so that vmin is the last variable */
                    151:        for ( nvl0 = 0, rvl0 = 0, tvl = vl; tvl; tvl = NEXT(tvl) )
                    152:                if ( tvl->v != vmin ) {
                    153:                        NEXTVL(nvl0,nvl); nvl->v = tvl->v;
                    154:                        NEXTVL(rvl0,rvl); rvl->v = tvl->v;
                    155:                }
                    156:        /* rvl = remaining variables */
1.3     ! noro      157:        NEXT(rvl) = 0; rvl = rvl0;
1.1       noro      158:        /* nvl = ...,vmin */
1.3     ! noro      159:        NEXTVL(nvl0,nvl); nvl->v = vmin; NEXT(nvl) = 0; nvl = nvl0;
1.2       noro      160:        MKV(vmin,x);
1.1       noro      161:
                    162:        /* for content and primitive part */
                    163:        pc = (P *)ALLOCA(m*sizeof(P));
                    164:        ps = (P *)ALLOCA(m*sizeof(P));
                    165:        ph = (P *)ALLOCA(m*sizeof(P));
                    166:        /* separate the contents */
                    167:        for ( i = 0; i < m; i++ ) {
1.3     ! noro      168:                reorderp(nvl,vl,pa[i],&t);
1.1       noro      169:                cont_pp_mv_sf(nvl,rvl,t,&pc[i],&ps[i]);
                    170:                head_monomial(vmin,ps[i],&ph[i],&t);
                    171:        }
                    172:        ugcdsf(pc,m,&cont);
                    173:        ugcdsf(ph,m,&hg);
                    174:
                    175:        /* for hg*pp (used in check phase) */
                    176:        lps = (P *)ALLOCA(m*sizeof(P));
                    177:        for ( i = 0; i < m; i++ )
                    178:                mulp(nvl,hg,ps[i],&lps[i]);
                    179:
                    180:        while ( 1 ) {
                    181:                g = 0;
1.3     ! noro      182:                cof1 = 0;
1.1       noro      183:                hm = 0;
1.3     ! noro      184:                itogfs(1,&mod);
1.1       noro      185:                index = 0;
1.3     ! noro      186:                for ( index = 0; getdeg(vmin,mod) <= d+1; index++ ) {
1.1       noro      187:                        /* evaluation pt */
1.3     ! noro      188:                        indextogfs(index,&s);
1.1       noro      189:                        substp(nvl,hg,vmin,s,&hge);
                    190:                        if ( !hge )
                    191:                                continue;
                    192:                        for ( i = 0; i < m; i++ )
                    193:                                substp(nvl,ps[i],vmin,s,&ph[i]);
                    194:                        /* ge = GCD(ps[0]|x=s,...,ps[m-1]|x=s) */
                    195:                        gcdsf(nvl,ph,m,&ge);
                    196:                        head_monomial(vmin,ge,&ce,&he);
1.3     ! noro      197:                        if ( NUM(he) ) {
1.1       noro      198:                                *r = cont;
                    199:                                return;
                    200:                        }
1.3     ! noro      201:                        divgfs((GFS)hge,(GFS)ce,&sf); t = (P)sf;
        !           202:                        mulp(nvl,t,ge,&u); ge = u;
1.1       noro      203:                        divsp(nvl,ph[imin],ge,&t); mulp(nvl,hge,t,&cof1e);
1.2       noro      204:                        /* hm=0 : reset; he==hm : lucky */
1.3     ! noro      205:                        if ( !hm || !compp(nvl,he,hm) ) {
1.2       noro      206:                                substp(nvl,mod,vmin,s,&mode); divsp(nvl,mod,mode,&mod1);
                    207:                                /* adj = mod/(mod|x=s)*(ge-g|x=s) */
                    208:                                substp(nvl,g,vmin,s,&t);
                    209:                                subp(nvl,ge,t,&u); mulp(nvl,mod1,u,&adj);
                    210:                                /* coadj = mod/(mod|vmin=s)*(cof1e-cof1e|vmin=s) */
                    211:                                substp(nvl,cof1,vmin,s,&t);
1.3     ! noro      212:                                subp(nvl,cof1e,t,&u); mulp(nvl,mod1,u,&coadj);
1.2       noro      213:                                if ( !adj ) {
                    214:                                        /* adj == gcd ? */
                    215:                                        for ( i = 0; i < m; i++ )
1.3     ! noro      216:                                                if ( !divtp(nvl,lps[i],g,&t) )
1.2       noro      217:                                                        break;
                    218:                                        if ( i == m ) {
1.3     ! noro      219:                                                cont_pp_mv_sf(nvl,rvl,g,&t,&u);
1.2       noro      220:                                                mulp(nvl,cont,u,&t);
1.3     ! noro      221:                                                reorderp(vl,nvl,t,r);
1.2       noro      222:                                                return;
                    223:                                        }
                    224:                                } else if ( !coadj ) {
1.3     ! noro      225:                                        /* ps[imin]/coadj == gcd ? */
        !           226:                                        if ( divtp(nvl,lps[imin],cof1,&q) ) {
1.2       noro      227:                                                for ( i = 0; i < m; i++ )
                    228:                                                        if ( !divtp(nvl,lps[i],q,&t) )
                    229:                                                                break;
                    230:                                                if ( i == m ) {
                    231:                                                        cont_pp_mv_sf(nvl,rvl,q,&t,&u);
                    232:                                                        mulp(nvl,cont,u,&t);
1.3     ! noro      233:                                                        reorderp(vl,nvl,t,r);
1.2       noro      234:                                                        return;
                    235:                                                }
                    236:                                        }
                    237:                                }
                    238:                                addp(nvl,g,adj,&t); g = t;
                    239:                                addp(nvl,cof1,coadj,&t); cof1 = t;
                    240:                                subp(nvl,x,s,&t); mulp(nvl,mod,t,&u); mod = u;
                    241:                                hm = he;
                    242:                        } else {
                    243:                                d1 = homdeg(hm); d2 = homdeg(he);
                    244:                                if ( d1 < d2 ) /* we use current hm */
                    245:                                        continue;
                    246:                                else if ( d1 > d2 ) {
                    247:                                        /* use he */
                    248:                                        g = ge;
                    249:                                        cof1 = cof1e;
                    250:                                        hm = he;
                    251:                                        subp(nvl,x,s,&mod);
                    252:                                } else {
                    253:                                        /* d1==d2, but hm!=he => both are unlucky */
                    254:                                        g = 0;
                    255:                                        cof1 = 0;
1.3     ! noro      256:                                        itogfs(1,&mod);
1.2       noro      257:                                }
1.1       noro      258:                        }
                    259:                }
                    260:        }
                    261: }
                    262:
                    263: void head_monomial(V v,P p,P *coef,P *term)
                    264: {
                    265:        P t,s,u;
                    266:        DCP dc;
                    267:        GFS one;
1.3     ! noro      268:        VL vl;
1.1       noro      269:
1.3     ! noro      270:        itogfs(1,&one);
        !           271:        t = (P)one;
1.1       noro      272:        while ( 1 ) {
                    273:                if ( NUM(p) || VR(p) == v ) {
                    274:                        *coef = p;
                    275:                        *term = t;
                    276:                        return;
                    277:                } else {
1.3     ! noro      278:                        NEWDC(dc);
        !           279:                        COEF(dc) = (P)one; DEG(dc) = DEG(DC(p));
1.1       noro      280:                        MKP(VR(p),dc,s);
                    281:                        mulp(vl,t,s,&u); t = u;
                    282:                        p = COEF(DC(p));
                    283:                }
                    284:        }
                    285: }
                    286:
                    287: void cont_pp_mv_sf(VL vl,VL rvl,P p,P *c,P *pp)
                    288: {
                    289:        DP dp;
                    290:        MP t;
                    291:        int i,m;
                    292:        P *ps;
                    293:
                    294:        ptod(vl,rvl,p,&dp);
                    295:        for ( t = BDY(dp), m = 0; t; t = NEXT(t), m++ );
                    296:        ps = (P *)ALLOCA(m*sizeof(P));
1.3     ! noro      297:        for ( t = BDY(dp), i = 0; t; t = NEXT(t), i++ )
1.1       noro      298:                ps[i] = C(t);
                    299:        ugcdsf(ps,m,c);
1.3     ! noro      300:        divsp(vl,p,*c,pp);
1.1       noro      301: }

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>