[BACK]Return to pd.rr CVS log [TXT][DIR] Up to [local] / OpenXM / src / asir-contrib / testing / noro

Annotation of OpenXM/src/asir-contrib/testing/noro/pd.rr, Revision 1.12

1.12    ! ohara       1: /* $OpenXM: OpenXM/src/asir-contrib/testing/noro/pd.rr,v 1.11 2010/08/20 04:21:18 noro Exp $ */
1.1       noro        2: import("gr")$
                      3: module noro_pd$
                      4: static GBCheck,F4,Procs,SatHomo$
                      5:
                      6: localf init_procs, kill_procs, syca_dec, syc_dec, find_separating_ideal0$
                      7: localf find_separating_ideal1, find_separating_ideal2$
                      8: localf sy_dec, pseudo_dec, iso_comp, prima_dec$
                      9: localf prime_dec, prime_dec_main, lex_predec1, zprimedec, zprimadec$
                     10: localf complete_qdecomp, partial_qdecomp, partial_qdecomp0, complete_decomp$
                     11: localf partial_decomp, partial_decomp0, zprimacomp, zprimecomp$
1.5       noro       12: localf fast_gb, incremental_gb, elim_gb, ldim, make_mod_subst$
1.1       noro       13: localf rsgn, find_npos, gen_minipoly, indepset$
                     14: localf maxindep, contraction, ideal_list_intersection, ideal_intersection$
1.7       noro       15: localf radical_membership, modular_radical_membership$
1.1       noro       16: localf radical_membership_rep, ideal_product, saturation$
                     17: localf sat, satind, sat_ind, colon$
1.2       noro       18: localf ideal_colon, ideal_sat, ideal_inclusion, qd_simp_comp, qd_remove_redundant_comp$
1.7       noro       19: localf pd_remove_redundant_comp, ppart, sq, gen_fctr, gen_nf, gen_gb_comp$
                     20: localf gen_mptop, lcfactor, compute_deg0, compute_deg, member$
1.1       noro       21: localf elimination, setintersection, setminus, sep_list$
                     22: localf first_element, comp_tdeg, tdeg, comp_by_ord, comp_by_second$
1.7       noro       23: localf gbcheck,f4,sathomo,qd_check$
1.1       noro       24:
                     25: SatHomo=0$
                     26: GBCheck=1$
                     27:
                     28: #define MAX(a,b) ((a)>(b)?(a):(b))
                     29:
                     30: def gbcheck(A)
                     31: {
                     32:        if ( A ) GBCheck = 1;
1.3       noro       33:        else GBCheck = -1;
1.1       noro       34: }
                     35:
                     36: def f4(A)
                     37: {
                     38:        if ( A ) F4 = 1;
                     39:        else F4 = 0;
                     40: }
                     41:
                     42: def sathomo(A)
                     43: {
                     44:        if ( A ) SatHomo = 1;
                     45:        else SatHomo = 0;
                     46: }
                     47:
                     48: def init_procs()
                     49: {
                     50:        if ( type(NoX=getopt(nox)) == -1 ) NoX = 0;
                     51:        if ( !Procs ) {
                     52:                if ( NoX ) {
                     53:                        P0 = ox_launch_nox();
                     54:                        P1 = ox_launch_nox();
                     55:                } else {
                     56:                        P0 = ox_launch();
                     57:                        P1 = ox_launch();
                     58:                }
                     59:                Procs = [P0,P1];
                     60:        }
                     61: }
                     62:
                     63: def kill_procs()
                     64: {
                     65:        if ( Procs ) {
                     66:                ox_shutdown(Procs[0]);
                     67:                ox_shutdown(Procs[1]);
                     68:                Procs = 0;
                     69:        }
                     70: }
                     71:
1.6       noro       72: def qd_check(B,V,QD)
                     73: {
1.7       noro       74:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                     75:        G = nd_gr(B,V,Mod,0);
                     76:        Iso = ideal_list_intersection(map(first_element,QD[0]),V,0|mod=Mod);
                     77:        Emb = ideal_list_intersection(map(first_element,QD[1]),V,0|mod=Mod);
                     78:        GG = ideal_intersection(Iso,Emb,V,0|mod=Mod);
                     79:        return gen_gb_comp(G,GG,Mod);
1.6       noro       80: }
                     81:
1.1       noro       82: /* SYC primary decomositions */
                     83:
                     84: def syca_dec(B,V)
                     85: {
                     86: T00 = time();
1.7       noro       87:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1.1       noro       88:        if ( type(Nolexdec=getopt(nolexdec)) == -1 ) Nolexdec = 0;
                     89:        if ( type(SepIdeal=getopt(sepideal)) == -1 ) SepIdeal = 1;
                     90:        if ( type(NoSimp=getopt(nosimp)) == -1 ) NoSimp = 0;
                     91:        if ( type(Time=getopt(time)) == -1 ) Time = 0;
                     92:        Ord = 0;
1.7       noro       93:        Gt = G0 = G = fast_gb(B,V,Mod,Ord);
1.1       noro       94:        Q0 = Q = []; IntQ0 = IntQ = [1]; First = 1;
                     95:        C = 0;
                     96:
                     97:        Tass = Tiso = Tcolon = Tsep = Tirred = 0;
                     98:        Rass = Riso = Rcolon = Rsep = Rirred = 0;
                     99:        while ( 1 ) {
                    100:                if ( type(Gt[0])==1 ) break;
                    101:                T0 = time();
1.8       noro      102:                PtR = prime_dec(Gt,V|indep=1,nolexdec=Nolexdec,mod=Mod,radical=1);
1.1       noro      103:                T1 = time(); Tass += T1[0]-T0[0]+T1[1]-T0[1]; Rass += T1[3]-T0[3];
1.8       noro      104:                Pt = PtR[0]; IntPt = PtR[1];
                    105:                if ( gen_gb_comp(Gt,IntPt,Mod) ) {
                    106:                        /* Gt is radical and Gt = cap Pt */
                    107:                        for ( T = Pt, Qt = []; T != []; T = cdr(T) )
                    108:                                Qt = cons([car(T)[0],car(T)[0]],Qt);
                    109:                        if ( First )
                    110:                                return [Qt,[]];
                    111:                        else
                    112:                                Q0 = append(Qt,Q0);
                    113:                        break;
                    114:                }
1.1       noro      115:                T0 = time();
1.7       noro      116:                Qt = iso_comp(Gt,Pt,V,Ord|mod=Mod,isgb=1);
1.1       noro      117:                T1 = time(); Tiso += T1[0]-T0[0]+T1[1]-T0[1]; Riso += T1[3]-T0[3];
1.7       noro      118:                IntQt = ideal_list_intersection(map(first_element,Qt),V,Ord|mod=Mod);
1.1       noro      119:                if ( First ) {
                    120:                        IntQ0 = IntQ = IntQt; IntP = IntPt; Qi = Qt; First = 0;
                    121:                } else {
1.7       noro      122:                        IntQ1 = ideal_intersection(IntQ,IntQt,V,Ord|mod=Mod);
                    123:                        if ( gen_gb_comp(IntQ,IntQ1,Mod) ) {
1.1       noro      124:                                G = Gt; IntP = IntPt; Q = []; IntQ = [1]; C = 0;
                    125:                                continue;
                    126:                        } else {
                    127:                                IntQ = IntQ1;
1.7       noro      128:                                IntQ1 = ideal_intersection(IntQ0,IntQt,V,Ord|mod=Mod);
                    129:                                if ( !gen_gb_comp(IntQ0,IntQ1,Mod) ) {
                    130:                                        Q = append(Qt,Q);
                    131: #if 1
                    132:                                        for ( T = Qt; T != []; T = cdr(T) )
                    133:                                                if ( !ideal_inclusion(IntQ0,car(T)[0],V,Ord|mod=Mod) )
                    134:                                                        Q0 = append(Q0,[car(T)]);
                    135: #else
                    136:                                        Q0 = append(Q0,Qt);
                    137: #endif
1.1       noro      138:                                        IntQ0 = IntQ1;
                    139:                                }
                    140:                        }
                    141:                }
1.7       noro      142:                if ( gen_gb_comp(IntQt,Gt,Mod) || gen_gb_comp(IntQ,G,Mod) || gen_gb_comp(IntQ0,G0,Mod) ) break;
1.1       noro      143:                T0 = time();
1.7       noro      144:                C1 = ideal_colon(G,IntQ,V|mod=Mod);
1.1       noro      145:                T1 = time(); Tcolon += T1[0]-T0[0]+T1[1]-T0[1]; Rcolon += T1[3]-T0[3];
1.7       noro      146:                if ( C && gen_gb_comp(C,C1,Mod) ) {
1.1       noro      147:                        G = Gt; IntP = IntPt; Q = []; IntQ = [1]; C = 0;
                    148:                        continue;
                    149:                } else C = C1;
                    150:                T0 = time();
                    151:                if ( SepIdeal == 0 )
1.7       noro      152:                        Ok = find_separating_ideal0(C,G,IntQ,IntP,V,Ord|mod=Mod);
1.1       noro      153:                else if ( SepIdeal == 1 )
1.7       noro      154:                        Ok = find_separating_ideal1(C,G,IntQ,IntP,V,Ord|mod=Mod);
1.1       noro      155:                else if ( SepIdeal == 2 )
1.7       noro      156:                        Ok = find_separating_ideal2(C,G,IntQ,IntP,V,Ord|mod=Mod);
1.1       noro      157:                G1 = append(Ok,G);
1.8       noro      158:                Gt1 = incremental_gb(G1,V,Ord|mod=Mod);
1.1       noro      159:                T1 = time(); Tsep += T1[0]-T0[0]+T1[1]-T0[1]; Rsep += T1[3]-T0[3];
                    160: #if 0
1.7       noro      161:                if ( ideal_inclusion(Gt1,Gt,V,Ord|mod=Mod) ) {
1.1       noro      162:                        G = Gt; IntP = IntPt; Q = []; IntQ = [1]; C = 0;
                    163:                } else
                    164: #endif
                    165:                        Gt = Gt1;
                    166:        }
                    167:        T0 = time();
1.7       noro      168:        if ( !NoSimp ) Q1 = qd_remove_redundant_comp(G0,Qi,Q0,V,Ord|mod=Mod);
1.1       noro      169:        else Q1 = Q0;
                    170:        if ( Time ) {
                    171:                T1 = time(); Tirred += T1[0]-T0[0]+T1[1]-T0[1]; Rirred += T1[3]-T0[3];
                    172:                Tall = T1[0]-T00[0]+T1[1]-T00[1]; Rall += T1[3]-T00[3];
                    173:                print(["total",Tall,"ass",Tass,"iso",Tiso, "colon",Tcolon,"sep",Tsep,"irred",Tirred]);
                    174:                print(["Rtotal",Rall,"Rass",Rass,"Riso",Riso, "Rcolon",Rcolon,"Rsep",Rsep,"Rirred",Rirred]);
                    175:                print(["iso",length(Qi),"emb",length(Q0),"->",length(Q1)]);
                    176:        }
                    177:        return [Qi,Q1];
                    178: }
                    179:
                    180: def syc_dec(B,V)
                    181: {
                    182: T00 = time();
1.7       noro      183:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1.1       noro      184:        if ( type(Nolexdec=getopt(nolexdec)) == -1 ) Nolexdec = 0;
                    185:        if ( type(SepIdeal=getopt(sepideal)) == -1 ) SepIdeal = 1;
                    186:        if ( type(NoSimp=getopt(nosimp)) == -1 ) NoSimp = 0;
                    187:        if ( type(Time=getopt(time)) == -1 ) Time = 0;
                    188:        Ord = 0;
1.7       noro      189:        G = fast_gb(B,V,Mod,Ord);
1.1       noro      190:        Q = []; IntQ = [1]; Gt = G; First = 1;
                    191:        Tass = Tiso = Tcolon = Tsep = Tirred = 0;
                    192:        Rass = Riso = Rcolon = Rsep = Rirred = 0;
                    193:        while ( 1 ) {
                    194:                if ( type(Gt[0])==1 ) break;
                    195:                T0 = time();
1.8       noro      196:                PtR = prime_dec(Gt,V|indep=1,nolexdec=Nolexdec,mod=Mod,radical=1);
1.1       noro      197:                T1 = time(); Tass += T1[0]-T0[0]+T1[1]-T0[1]; Rass += T1[3]-T0[3];
1.8       noro      198:                Pt = PtR[0]; IntPt = PtR[1];
                    199:                if ( gen_gb_comp(Gt,IntPt,Mod) ) {
                    200:                        /* Gt is radical and Gt = cap Pt */
                    201:                        for ( T = Pt, Qt = []; T != []; T = cdr(T) )
                    202:                                Qt = cons([car(T)[0],car(T)[0]],Qt);
                    203:                        if ( First )
                    204:                                return [Qt,[]];
                    205:                        else
                    206:                                Q = append(Qt,Q);
                    207:                        break;
                    208:                }
                    209:
1.1       noro      210:                T0 = time();
1.7       noro      211:                Qt = iso_comp(Gt,Pt,V,Ord|mod=Mod,isgb=1);
1.1       noro      212:                T1 = time(); Tiso += T1[0]-T0[0]+T1[1]-T0[1]; Riso += T1[3]-T0[3];
1.7       noro      213:                IntQt = ideal_list_intersection(map(first_element,Qt),V,Ord|mod=Mod);
1.1       noro      214:                if ( First ) {
                    215:                        IntQ = IntQt; Qi = Qt; First = 0;
                    216:                } else {
1.7       noro      217:                        IntQ1 = ideal_intersection(IntQ,IntQt,V,Ord|mod=Mod);
                    218:                        if ( !gen_gb_comp(IntQ1,IntQ,Mod) )
1.1       noro      219:                                Q = append(Qt,Q);
                    220:                }
1.7       noro      221:                if ( gen_gb_comp(IntQ,G,Mod) || gen_gb_comp(IntQt,Gt,Mod) )
1.1       noro      222:                        break;
                    223:                T0 = time();
1.7       noro      224:                C = ideal_colon(Gt,IntQt,V|mod=Mod);
1.1       noro      225:                T1 = time(); Tcolon += T1[0]-T0[0]+T1[1]-T0[1]; Rcolon += T1[3]-T0[3];
1.2       noro      226:                T0 = time();
1.1       noro      227:                if ( SepIdeal == 0 )
1.7       noro      228:                        Ok = find_separating_ideal0(C,Gt,IntQt,IntPt,V,Ord|mod=Mod);
1.1       noro      229:                else if ( SepIdeal == 1 )
1.7       noro      230:                        Ok = find_separating_ideal1(C,Gt,IntQt,IntPt,V,Ord|mod=Mod);
1.1       noro      231:                else if ( SepIdeal == 2 )
1.7       noro      232:                        Ok = find_separating_ideal2(C,Gt,IntQt,IntPt,V,Ord|mod=Mod);
1.1       noro      233:                G1 = append(Ok,Gt);
1.8       noro      234:                Gt = incremental_gb(G1,V,Ord|mod=Mod);
1.1       noro      235:                T1 = time(); Tsep += T1[0]-T0[0]+T1[1]-T0[1]; Rsep += T1[3]-T0[3];
                    236:        }
                    237:        T0 = time();
1.7       noro      238:        if ( !NoSimp ) Q1 = qd_remove_redundant_comp(G,Qi,Q,V,Ord|mod=Mod);
1.1       noro      239:        else Q1 = Q;
                    240:        T1 = time(); Tirred += T1[0]-T0[0]+T1[1]-T0[1]; Rirred += T1[3]-T0[3];
                    241:        Tall = T1[0]-T00[0]+T1[1]-T00[1]; Rall += T1[3]-T00[3];
                    242:        if ( Time ) {
                    243:                print(["total",Tall,"ass",Tass,"iso",Tiso, "colon",Tcolon,"sep",Tsep,"irred",Tirred]);
                    244:                print(["Rtotal",Rall,"Rass",Rass,"Riso",Riso, "Rcolon",Rcolon,"Rsep",Rsep,"Rirred",Rirred]);
                    245:                print(["iso",length(Qi),"emb",length(Q),"->",length(Q1)]);
                    246:        }
                    247:        return [Qi,Q1];
                    248: }
                    249:
1.7       noro      250: /* XXX */
1.1       noro      251: /* C=G:Q, Rad=rad(Q), return J s.t. Q cap (G+J) = G */
                    252:
                    253: def find_separating_ideal0(C,G,Q,Rad,V,Ord) {
1.7       noro      254:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1.1       noro      255:        for ( CI = C, I = 1; ; I++ ) {
                    256:                for ( T = CI, S = []; T != []; T = cdr(T) )
1.7       noro      257:                        if ( gen_nf(car(T),Q,V,Ord,Mod) ) S = cons(car(T),S);
1.1       noro      258:                if ( S == [] )
                    259:                        error("find_separating_ideal0 : cannot happen");
                    260:                G1 = append(S,G);
1.7       noro      261:                Int = ideal_intersection(G1,Q,V,Ord|mod=Mod);
1.1       noro      262:                /* check whether (Q cap (G+S)) = G */
1.7       noro      263:                if ( gen_gb_comp(Int,G,Mod) ) return reverse(S);
                    264:                CI = ideal_product(CI,C,V|mod=Mod);
1.1       noro      265:        }
                    266: }
                    267:
                    268: def find_separating_ideal1(C,G,Q,Rad,V,Ord) {
1.7       noro      269:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1.1       noro      270:        for ( T = C, S = []; T != []; T = cdr(T) )
1.7       noro      271:                if ( gen_nf(car(T),Q,V,Ord,Mod) ) S = cons(car(T),S);
1.1       noro      272:        if ( S == [] )
                    273:                error("find_separating_ideal1 : cannot happen");
                    274:        G1 = append(S,G);
1.7       noro      275:        Int = ideal_intersection(G1,Q,V,Ord|mod=Mod);
1.1       noro      276:        /* check whether (Q cap (G+S)) = G */
1.7       noro      277:        if ( gen_gb_comp(Int,G,Mod) ) return reverse(S);
1.1       noro      278:
1.12    ! ohara     279:        /* or qsort(C,noro_pd.comp_tdeg) */
        !           280:        C = qsort(S,noro_pd.comp_tdeg);
1.5       noro      281:
                    282:        Tmp = ttttt; TV = cons(Tmp,V); Ord1 = [[0,1],[Ord,length(V)]];
                    283:        Int0 = incremental_gb(append(vtol(ltov(G)*Tmp),vtol(ltov(Q)*(1-Tmp))),
1.7       noro      284:                TV,Ord1|gbblock=[[0,length(G)]],mod=Mod);
1.8       noro      285:        Dp = dp_gr_print(); dp_gr_print(0);
1.1       noro      286:        for ( T = C, S = []; T != []; T = cdr(T) ) {
1.7       noro      287:                if ( !gen_nf(car(T),Rad,V,Ord,Mod) ) continue;
1.1       noro      288:                Ui = U = car(T);
                    289:                for ( I = 1; ; I++ ) {
                    290:                        G1 = cons(Ui,G);
1.7       noro      291:                        Int = ideal_intersection(G1,Q,V,Ord|mod=Mod);
                    292:                        if ( gen_gb_comp(Int,G,Mod) ) break;
1.1       noro      293:                        else
1.7       noro      294:                                Ui = gen_nf(Ui*U,G,V,Ord,Mod);
1.1       noro      295:                }
1.8       noro      296:                print([length(T),I],2);
1.5       noro      297:                Int1 = incremental_gb(append(Int0,[Tmp*Ui]),TV,Ord1
1.7       noro      298:                        |gbblock=[[0,length(Int0)]],mod=Mod);
1.5       noro      299:                Int = elimination(Int1,V);
1.8       noro      300:                if ( !gen_gb_comp(Int,G,Mod) ) {
1.5       noro      301:                        break;
1.8       noro      302:                } else {
1.5       noro      303:                        Int0 = Int1;
                    304:                        S = cons(Ui,S);
1.1       noro      305:                }
                    306:        }
1.8       noro      307:        print("");
                    308:        dp_gr_print(Dp);
1.1       noro      309:        return reverse(S);
                    310: }
                    311:
                    312: def find_separating_ideal2(C,G,Q,Rad,V,Ord) {
1.7       noro      313:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1.1       noro      314:        for ( T = C, S = []; T != []; T = cdr(T) )
1.7       noro      315:                if ( gen_nf(car(T),Q,V,Ord,Mod) ) S = cons(car(T),S);
1.1       noro      316:        if ( S == [] )
                    317:                error("find_separating_ideal2 : cannot happen");
                    318:        G1 = append(S,G);
1.7       noro      319:        Int = ideal_intersection(G1,Q,V,Ord|mod=Mod);
1.1       noro      320:        /* check whether (Q cap (G+S)) = G */
1.7       noro      321:        if ( gen_gb_comp(Int,G,Mod) ) return reverse(S);
1.1       noro      322:
1.12    ! ohara     323:        /* or qsort(S,noro_pd.comp_tdeg) */
        !           324:        C = qsort(C,noro_pd.comp_tdeg);
1.5       noro      325:        Dp = dp_gr_print(); dp_gr_print(0);
1.1       noro      326:        for ( T = C, S = []; T != []; T = cdr(T) ) {
1.7       noro      327:                if ( !gen_nf(car(T),Rad,V,Ord,Mod) ) continue;
1.1       noro      328:                Ui = U = car(T);
                    329:                for ( I = 1; ; I++ ) {
1.7       noro      330:                        G1 = append(G,[Ui]);
                    331:                        Int = ideal_intersection(G1,Q,V,Ord|mod=Mod,
                    332:                                gbblock=[[0,length(G)],[length(G1),length(Q)]]);
                    333:                        if ( gen_gb_comp(Int,G,Mod) ) break;
1.1       noro      334:                        else
1.7       noro      335:                                Ui = gen_nf(Ui*U,G,V,Ord,Mod);
1.1       noro      336:                }
1.7       noro      337:                print([length(T),I],2);
1.1       noro      338:                S = cons(Ui,S);
                    339:        }
1.7       noro      340:        print("");
1.12    ! ohara     341:        S = qsort(S,noro_pd.comp_tdeg);
1.8       noro      342:        End = Len = length(S);
1.5       noro      343:
                    344:        Tmp = ttttt; TV = cons(Tmp,V); Ord1 = [[0,1],[Ord,length(V)]];
1.8       noro      345:        Prev = 1;
                    346:        G1 = append(G,[S[0]]);
                    347:        Int0 = incremental_gb(append(vtol(ltov(G1)*Tmp),vtol(ltov(Q)*(1-Tmp))),
                    348:                TV,Ord1|gbblock=[[0,length(G)]],mod=Mod);
                    349:        if ( End > 1 ) {
1.5       noro      350:                Cur = 2;
                    351:                while ( Prev < Cur ) {
                    352:                        for ( St = [], I = Prev; I < Cur; I++ ) St = cons(Tmp*S[I],St);
                    353:                        Int1 = incremental_gb(append(Int0,St),TV,Ord1
1.7       noro      354:                                |gbblock=[[0,length(Int0)]],mod=Mod);
1.5       noro      355:                        Int = elimination(Int1,V);
1.7       noro      356:                        if ( gen_gb_comp(Int,G,Mod) ) {
1.8       noro      357:                                print([Cur],2);
1.5       noro      358:                                Prev = Cur;
1.8       noro      359:                                Cur = Cur+idiv(End-Cur+1,2);
1.5       noro      360:                                Int0 = Int1;
                    361:                        } else {
1.8       noro      362:                                End = Cur;
1.5       noro      363:                                Cur = Prev + idiv(Cur-Prev,2);
1.1       noro      364:                        }
                    365:                }
1.5       noro      366:                for ( St = [], I = 0; I < Prev; I++ ) St = cons(S[I],St);
                    367:        } else
1.8       noro      368:                St = [S[0]];
                    369:        print("");
1.9       noro      370:        for ( I = Prev; I < Len; I++ ) {
                    371:                Int1 = incremental_gb(append(Int0,[Tmp*S[I]]),TV,Ord1
                    372:                        |gbblock=[[0,length(Int0)]],mod=Mod);
                    373:                Int = elimination(Int1,V);
                    374:                if ( gen_gb_comp(Int,G,Mod) ) {
                    375:                        print([I],2);
                    376:                        St = cons(S[I],St);
                    377:                        Int0 = Int1;
1.8       noro      378:                }
                    379:        }
                    380:        Ok = reverse(St);
                    381:        print("");
1.5       noro      382:        print([length(S),length(Ok)]);
                    383:        dp_gr_print(Dp);
1.1       noro      384:        return Ok;
                    385: }
                    386:
                    387: /* SY primary decompsition */
                    388:
                    389: def sy_dec(B,V)
                    390: {
1.7       noro      391:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1.1       noro      392:        if ( type(Nolexdec=getopt(nolexdec)) == -1 ) Nolexdec = 0;
                    393:        Ord = 0;
1.7       noro      394:        G = fast_gb(B,V,Mod,Ord);
1.1       noro      395:        Q = [];
                    396:        IntQ = [1];
                    397:        Gt = G;
                    398:        First = 1;
                    399:        while ( 1 ) {
                    400:                if ( type(Gt[0]) == 1 ) break;
1.7       noro      401:                Pt = prime_dec(Gt,V|indep=1,nolexdec=Nolexdec,mod=Mod);
                    402:                L = pseudo_dec(Gt,Pt,V,Ord|mod=Mod);
1.1       noro      403:                Qt = L[0]; Rt = L[1]; St = L[2];
1.7       noro      404:                IntQt = ideal_list_intersection(map(first_element,Qt),V,Ord|mod=Mod);
1.1       noro      405:                if ( First ) {
                    406:                        IntQ = IntQt;
                    407:                        Qi = Qt;
                    408:                        First = 0;
                    409:                } else {
1.7       noro      410:                        IntQ = ideal_intersection(IntQ,IntQt,V,Ord|mod=Mod);
1.1       noro      411:                        Q = append(Qt,Q);
                    412:                }
1.7       noro      413:                if ( gen_gb_comp(IntQ,G,Mod) ) break;
1.1       noro      414:                for ( T = Rt; T != []; T = cdr(T) ) {
                    415:                        if ( type(car(T)[0]) == 1 ) continue;
1.7       noro      416:                        U = sy_dec(car(T),V|nolexdec=Nolexdec,mod=Mod);
                    417:                        IntQ = ideal_list_intersection(cons(IntQ,map(first_element,U)),
                    418:                                V,Ord|mod=Mod);
1.1       noro      419:                        Q = append(U,Q);
1.7       noro      420:                        if ( gen_gb_comp(IntQ,G,Mod) ) break;
1.1       noro      421:                }
1.7       noro      422:                Gt = fast_gb(append(Gt,St),V,Mod,Ord);
1.1       noro      423:        }
1.7       noro      424:        Q = qd_remove_redundant_comp(G,Qi,Q,V,Ord|mod=Mod);
1.1       noro      425:        return append(Qi,Q);
                    426: }
                    427:
                    428: def pseudo_dec(G,L,V,Ord)
                    429: {
1.7       noro      430:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1.1       noro      431:        N = length(L);
                    432:        S = vector(N);
                    433:        Q = vector(N);
                    434:        R = vector(N);
                    435:        L0 = map(first_element,L);
                    436:        for ( I = 0; I < N; I++ ) {
                    437:                LI = setminus(L0,[L0[I]]);
1.7       noro      438:                PI = ideal_list_intersection(LI,V,Ord|mod=Mod);
1.12    ! ohara     439:                PI = qsort(PI,noro_pd.comp_tdeg);
1.1       noro      440:                for ( T = PI; T != []; T = cdr(T) )
1.7       noro      441:                        if ( gen_nf(car(T),L0[I],V,Ord,Mod) ) break;
1.1       noro      442:                if ( T == [] ) error("separator : cannot happen");
1.11      noro      443:                SI = sat_ind(G,car(T),V|mod=Mod);
1.1       noro      444:                QI = SI[0];
                    445:                S[I] = car(T)^SI[1];
                    446:                PV = L[I][1];
                    447:                V0 = setminus(V,PV);
                    448: #if 0
1.7       noro      449:                GI = fast_gb(QI,append(V0,PV),Mod,
1.1       noro      450:                        [[Ord,length(V0)],[Ord,length(PV)]]);
                    451: #else
1.7       noro      452:                GI = fast_gb(QI,append(V0,PV),Mod,
1.1       noro      453:                        [[2,length(V0)],[Ord,length(PV)]]);
                    454: #endif
1.7       noro      455:                LCFI = lcfactor(GI,V0,Ord,Mod);
1.1       noro      456:                for ( F = 1, T = LCFI, Gt = QI; T != []; T = cdr(T) ) {
1.11      noro      457:                        St = sat_ind(Gt,T[0],V|mod=Mod);
1.1       noro      458:                        Gt = St[0]; F *= T[0]^St[1];
                    459:                }
1.7       noro      460:                Q[I] = [Gt,L0[I]];
                    461:                R[I] = fast_gb(cons(F,QI),V,Mod,Ord);
1.1       noro      462:        }
                    463:        return [vtol(Q),vtol(R),vtol(S)];
                    464: }
                    465:
                    466: def iso_comp(G,L,V,Ord)
                    467: {
1.7       noro      468:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                    469:        if ( type(IsGB=getopt(isgb)) == -1 ) IsGB = 0;
1.1       noro      470:        N = length(L);
                    471:        S = vector(N);
                    472:        Ind = vector(N);
                    473:        Q = vector(N);
                    474:        L0 = map(first_element,L);
1.7       noro      475:        if ( !IsGB ) G = nd_gr(G,V,Mod,Ord);
1.1       noro      476:        for ( I = 0; I < N; I++ ) {
                    477:                LI = setminus(L0,[L0[I]]);
1.7       noro      478:                PI = ideal_list_intersection(LI,V,Ord|mod=Mod);
1.1       noro      479:                for ( T = PI; T != []; T = cdr(T) )
1.7       noro      480:                        if ( gen_nf(car(T),L0[I],V,Ord,Mod) ) break;
1.1       noro      481:                if ( T == [] ) error("separator : cannot happen");
                    482:                S[I] = car(T);
1.7       noro      483:                QI = sat(G,S[I],V|isgb=1,mod=Mod);
1.1       noro      484:                PV = L[I][1];
                    485:                V0 = setminus(V,PV);
1.7       noro      486:                GI = elim_gb(QI,V0,PV,Mod,[[0,length(V0)],[0,length(PV)]]);
                    487:                Q[I] = [contraction(GI,V0|mod=Mod),L0[I]];
1.1       noro      488:        }
                    489:        return vtol(Q);
                    490: }
                    491:
                    492: /* GTZ primary decompsition */
                    493:
                    494: def prima_dec(B,V)
                    495: {
1.7       noro      496:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                    497:        if ( type(Ord=getopt(ord)) == -1 ) Ord = 0;
                    498:        G0 = fast_gb(B,V,Mod,0);
                    499:        G = fast_gb(G0,V,Mod,Ord);
1.1       noro      500:        IntP = [1];
                    501:        QD = [];
                    502:        while ( 1 ) {
1.7       noro      503:                if ( type(G[0])==1 || ideal_inclusion(IntP,G0,V,0|mod=Mod) )
                    504:                        break;
                    505:                W = maxindep(G,V,Ord); NP = length(W);
1.1       noro      506:                V0 = setminus(V,W); N = length(V0);
                    507:                V1 = append(V0,W);
1.7       noro      508:                G1 = fast_gb(G,V1,Mod,[[Ord,N],[Ord,NP]]);
                    509:                LCF = lcfactor(G1,V0,Ord,Mod);
                    510:                L = zprimacomp(G,V0|mod=Mod);
1.1       noro      511:                F = 1;
1.7       noro      512:                for ( T = LCF, G2 = G; T != []; T = cdr(T) ) {
1.11      noro      513:                        S = sat_ind(G2,T[0],V1|mod=Mod);
1.1       noro      514:                        G2 = S[0]; F *= T[0]^S[1];
                    515:                }
                    516:                for ( T = L, QL = []; T != []; T = cdr(T) )
                    517:                        QL = cons(car(T)[0],QL);
1.7       noro      518:                Int = ideal_list_intersection(QL,V,0|mod=Mod);
                    519:                IntP = ideal_intersection(IntP,Int,V,0|mod=Mod);
1.1       noro      520:                QD = append(QD,L);
1.7       noro      521:                F = gen_nf(F,G,V,0,Mod);
                    522:                G = fast_gb(cons(F,G),V,Mod,Ord);
1.1       noro      523:        }
1.7       noro      524:        QD = qd_remove_redundant_comp(G0,[],QD,V,0);
                    525:        return QD;
1.1       noro      526: }
                    527:
                    528: /* SL prime decomposition */
                    529:
                    530: def prime_dec(B,V)
                    531: {
1.7       noro      532:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1.1       noro      533:        if ( type(Indep=getopt(indep)) == -1 ) Indep = 0;
                    534:        if ( type(NoLexDec=getopt(nolexdec)) == -1 ) NoLexDec = 0;
1.8       noro      535:        if ( type(Rad=getopt(radical)) == -1 ) Rad = 0;
1.7       noro      536:        B = map(sq,B,Mod);
1.1       noro      537:        if ( !NoLexDec )
1.7       noro      538:                PD = lex_predec1(B,V|mod=Mod);
1.1       noro      539:        else
                    540:                PD = [B];
1.7       noro      541:        G = ideal_list_intersection(PD,V,0|mod=Mod);
                    542:        PD = pd_remove_redundant_comp(G,PD,V,0|mod=Mod);
1.1       noro      543:        R = [];
                    544:        for ( T = PD; T != []; T = cdr(T) )
1.7       noro      545:                R = append(prime_dec_main(car(T),V|indep=Indep,mod=Mod),R);
1.1       noro      546:        if ( Indep ) {
1.7       noro      547:                G = ideal_list_intersection(map(first_element,R),V,0|mod=Mod);
                    548:                if ( !NoLexDec ) R = pd_remove_redundant_comp(G,R,V,0|first=1,mod=Mod);
1.1       noro      549:        } else {
1.7       noro      550:                G = ideal_list_intersection(R,V,0|mod=Mod);
                    551:                if ( !NoLexDec ) R = pd_remove_redundant_comp(G,R,V,0|mod=Mod);
1.1       noro      552:        }
1.8       noro      553:        return Rad ? [R,G] : R;
1.1       noro      554: }
                    555:
                    556: def prime_dec_main(B,V)
                    557: {
1.7       noro      558:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1.1       noro      559:        if ( type(Indep=getopt(indep)) == -1 ) Indep = 0;
1.7       noro      560:        G = fast_gb(B,V,Mod,0);
1.1       noro      561:        IntP = [1];
                    562:        PD = [];
                    563:        while ( 1 ) {
                    564:                /* rad(G) subset IntP */
                    565:                /* check if IntP subset rad(G) */
                    566:                for ( T = IntP; T != []; T = cdr(T) ) {
1.7       noro      567:                        if ( (GNV = modular_radical_membership(car(T),G,V|mod=Mod)) ) {
1.1       noro      568:                                F = car(T);
                    569:                                break;
                    570:                        }
                    571:                }
                    572:                if ( T == [] ) return PD;
                    573:
                    574:                /* GNV = [GB(<NV*F-1,G>),NV] */
1.7       noro      575:                G1 = fast_gb(GNV[0],cons(GNV[1],V),Mod,[[0,1],[0,length(V)]]);
1.1       noro      576:                G0 = elimination(G1,V);
1.7       noro      577:                PD0 = zprimecomp(G0,V,Indep|mod=Mod);
1.1       noro      578:                if ( Indep ) {
1.7       noro      579:                        Int = ideal_list_intersection(PD0[0],V,0|mod=Mod);
1.1       noro      580:                        IndepSet = PD0[1];
                    581:                        for ( PD1 = [], T = PD0[0]; T != []; T = cdr(T) )
                    582:                                PD1 = cons([car(T),IndepSet],PD1);
                    583:                        PD = append(PD,reverse(PD1));
                    584:                } else {
1.7       noro      585:                        Int = ideal_list_intersection(PD0,V,0|mod=Mod);
1.1       noro      586:                        PD = append(PD,PD0);
                    587:                }
1.7       noro      588:                IntP = ideal_intersection(IntP,Int,V,0|mod=Mod);
1.1       noro      589:        }
                    590: }
                    591:
                    592: /* pre-decomposition */
                    593:
                    594: def lex_predec1(B,V)
                    595: {
1.7       noro      596:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                    597:        G = fast_gb(B,V,Mod,2);
1.1       noro      598:        for ( T = G; T != []; T = cdr(T) ) {
1.7       noro      599:                F = gen_fctr(car(T),Mod);
1.1       noro      600:                if ( length(F) > 2 || length(F) == 2 && F[1][1] > 1 ) {
                    601:                        for ( R = [], S = cdr(F); S != []; S = cdr(S) ) {
                    602:                                Ft = car(S)[0];
1.7       noro      603:                                Gt = map(ptozp,map(gen_nf,G,[Ft],V,0,Mod));
                    604:                                R1 = fast_gb(cons(Ft,Gt),V,Mod,0);
1.1       noro      605:                                R = cons(R1,R);
                    606:                        }
                    607:                        return R;
                    608:                }
                    609:        }
                    610:        return [G];
                    611: }
                    612:
                    613: /* zero-dimensional prime/primary decomosition */
                    614:
                    615: def zprimedec(B,V,Mod)
                    616: {
                    617:        L = partial_decomp(B,V,Mod);
                    618:        P = L[0]; NP = L[1];
                    619:        R = [];
                    620:        for ( ; P != []; P = cdr(P) ) R = cons(car(car(P)),R);
                    621:        for ( T = NP; T != []; T = cdr(T) ) {
                    622:                R1 = complete_decomp(car(T),V,Mod);
                    623:                R = append(R1,R);
                    624:        }
                    625:        return R;
                    626: }
                    627:
                    628: def zprimadec(B,V,Mod)
                    629: {
                    630:        L = partial_qdecomp(B,V,Mod);
                    631:        Q = L[0]; NQ = L[1];
                    632:        R = [];
                    633:        for ( ; Q != []; Q = cdr(Q) ) {
                    634:                T = car(Q); R = cons([T[0],T[1]],R);
                    635:        }
                    636:        for ( T = NQ; T != []; T = cdr(T) ) {
                    637:                R1 = complete_qdecomp(car(T),V,Mod);
                    638:                R = append(R1,R);
                    639:        }
                    640:        return R;
                    641: }
                    642:
                    643: def complete_qdecomp(GD,V,Mod)
                    644: {
                    645:        GQ = GD[0]; GP = GD[1]; D = GD[2];
                    646:        W = vars(GP);
                    647:        PV = setminus(W,V);
                    648:        N = length(V); PN = length(PV);
                    649:        U = find_npos([GP,D],V,PV,Mod);
                    650:        NV = ttttt;
                    651:        M = gen_minipoly(cons(NV-U,GQ),cons(NV,V),PV,0,NV,Mod);
                    652:        M = ppart(M,NV,Mod);
                    653:        MF = Mod ? modfctr(M) : fctr(M);
                    654:        R = [];
                    655:        for ( T = cdr(MF); T != []; T = cdr(T) ) {
                    656:                S = car(T);
                    657:                Mt = subst(S[0],NV,U);
                    658:                GP1 = fast_gb(cons(Mt,GP),W,Mod,0);
                    659:                GQ1 = fast_gb(cons(Mt^S[1],GQ),W,Mod,0);
                    660:                if ( PV != [] ) {
                    661:                        GP1 = elim_gb(GP1,V,PV,Mod,[[0,N],[0,PN]]);
                    662:                        GQ1 = elim_gb(GQ1,V,PV,Mod,[[0,N],[0,PN]]);
                    663:                }
                    664:                R = cons([GQ1,GP1],R);
                    665:        }
                    666:        return R;
                    667: }
                    668:
                    669: def partial_qdecomp(B,V,Mod)
                    670: {
                    671:        Elim = (Elim=getopt(elim))&&type(Elim)!=-1 ? 1 : 0;
                    672:        N = length(V);
                    673:        W = vars(B);
                    674:        PV = setminus(W,V);
                    675:        NP = length(PV);
                    676:        W = append(V,PV);
                    677:        if ( Elim && PV != [] ) Ord = [[0,N],[0,NP]];
                    678:        else Ord = 0;
                    679:        if ( Mod )
                    680:                B = nd_f4(B,W,Mod,Ord);
                    681:        else
                    682:                B = nd_gr_trace(B,W,1,GBCheck,Ord);
                    683:        Q = []; NQ = [[B,B,vector(N+1)]];
                    684:        for ( I = length(V)-1; I >= 0; I-- ) {
                    685:                NQ1 = [];
                    686:                for ( T = NQ; T != []; T = cdr(T) ) {
                    687:                        L = partial_qdecomp0(car(T),V,PV,Ord,I,Mod);
                    688:                        Q = append(L[0],Q);
                    689:                        NQ1 = append(L[1],NQ1);
                    690:                }
                    691:                NQ = NQ1;
                    692:        }
                    693:        return [Q,NQ];
                    694: }
                    695:
                    696: def partial_qdecomp0(GD,V,PV,Ord,I,Mod)
                    697: {
                    698:        GQ = GD[0]; GP = GD[1]; D = GD[2];
                    699:        N = length(V); PN = length(PV);
                    700:        W = append(V,PV);
                    701:        VI = V[I];
                    702:        M = gen_minipoly(GQ,V,PV,Ord,VI,Mod);
                    703:        M = ppart(M,VI,Mod);
                    704:        if ( Mod )
                    705:                MF = modfctr(M,Mod);
                    706:        else
                    707:                MF = fctr(M);
                    708:        Q = []; NQ = [];
                    709:        if ( length(MF) == 2 && MF[1][1] == 1 ) {
                    710:                D1 = D*1; D1[I] = M;
                    711:                GQelim = elim_gb(GQ,V,PV,Mod,Ord);
                    712:                GPelim = elim_gb(GP,V,PV,Mod,Ord);
                    713:                LD = ldim(GQelim,V);
                    714:                if ( deg(M,VI) == LD )
                    715:                        Q = cons([GQelim,GPelim,D1],Q);
                    716:                else
                    717:                        NQ = cons([GQelim,GPelim,D1],NQ);
                    718:                return [Q,NQ];
                    719:        }
                    720:        for ( T = cdr(MF); T != []; T = cdr(T) ) {
                    721:                S = car(T); Mt = S[0]; D1 = D*1; D1[I] = Mt;
                    722:
                    723:                GQ1 = fast_gb(cons(Mt^S[1],GQ),W,Mod,Ord);
                    724:                GQelim = elim_gb(GQ1,V,PV,Mod,Ord);
                    725:                GP1 = fast_gb(cons(Mt,GP),W,Mod,Ord);
                    726:                GPelim = elim_gb(GP1,V,PV,Mod,Ord);
                    727:
                    728:                D1[N] = LD = ldim(GPelim,V);
                    729:
                    730:                for ( J = 0; J < N; J++ )
                    731:                        if ( D1[J] && deg(D1[J],V[J]) == LD ) break;
                    732:                if ( J < N )
                    733:                        Q = cons([GQelim,GPelim,D1],Q);
                    734:                else
                    735:                        NQ = cons([GQelim,GPelim,D1],NQ);
                    736:        }
                    737:        return [Q,NQ];
                    738: }
                    739:
                    740: def complete_decomp(GD,V,Mod)
                    741: {
                    742:        G = GD[0]; D = GD[1];
                    743:        W = vars(G);
                    744:        PV = setminus(W,V);
                    745:        N = length(V); PN = length(PV);
                    746:        U = find_npos(GD,V,PV,Mod);
                    747:        NV = ttttt;
                    748:        M = gen_minipoly(cons(NV-U,G),cons(NV,V),PV,0,NV,Mod);
                    749:        M = ppart(M,NV,Mod);
                    750:        MF = Mod ? modfctr(M) : fctr(M);
                    751:        if ( length(MF) == 2 ) return [G];
                    752:        R = [];
                    753:        for ( T = cdr(MF); T != []; T = cdr(T) ) {
                    754:                Mt = subst(car(car(T)),NV,U);
                    755:                G1 = fast_gb(cons(Mt,G),W,Mod,0);
                    756:                if ( PV != [] ) G1 = elim_gb(G1,V,PV,Mod,[[0,N],[0,PN]]);
                    757:                R = cons(G1,R);
                    758:        }
                    759:        return R;
                    760: }
                    761:
                    762: def partial_decomp(B,V,Mod)
                    763: {
                    764:        Elim = (Elim=getopt(elim))&&type(Elim)!=-1 ? 1 : 0;
                    765:        N = length(V);
                    766:        W = vars(B);
                    767:        PV = setminus(W,V);
                    768:        NP = length(PV);
                    769:        W = append(V,PV);
                    770:        if ( Elim && PV != [] ) Ord = [[0,N],[0,NP]];
                    771:        else Ord = 0;
                    772:        if ( Mod )
                    773:                B = nd_f4(B,W,Mod,Ord);
                    774:        else
                    775:                B = nd_gr_trace(B,W,1,GBCheck,Ord);
                    776:        P = []; NP = [[B,vector(N+1)]];
                    777:        for ( I = length(V)-1; I >= 0; I-- ) {
                    778:                NP1 = [];
                    779:                for ( T = NP; T != []; T = cdr(T) ) {
                    780:                        L = partial_decomp0(car(T),V,PV,Ord,I,Mod);
                    781:                        P = append(L[0],P);
                    782:                        NP1 = append(L[1],NP1);
                    783:                }
                    784:                NP = NP1;
                    785:        }
                    786:        return [P,NP];
                    787: }
                    788:
                    789: def partial_decomp0(GD,V,PV,Ord,I,Mod)
                    790: {
                    791:        G = GD[0]; D = GD[1];
                    792:        N = length(V); PN = length(PV);
                    793:        W = append(V,PV);
                    794:        VI = V[I];
                    795:        M = gen_minipoly(G,V,PV,Ord,VI,Mod);
                    796:        M = ppart(M,VI,Mod);
                    797:        if ( Mod )
                    798:                MF = modfctr(M,Mod);
                    799:        else
                    800:                MF = fctr(M);
                    801:        if ( length(MF) == 2 && MF[1][1] == 1 ) {
                    802:                D1 = D*1;
                    803:                D1[I] = M;
                    804:                Gelim = elim_gb(G,V,PV,Mod,Ord);
                    805:                D1[N] = LD = ldim(Gelim,V);
                    806:                GD1 = [Gelim,D1];
                    807:                for ( J = 0; J < N; J++ )
                    808:                        if ( D1[J] && deg(D1[J],V[J]) == LD )
                    809:                                return [[GD1],[]];
                    810:                return [[],[GD1]];
                    811:        }
                    812:        P = []; NP = [];
                    813:        GI = elim_gb(G,V,PV,Mod,Ord);
                    814:        for ( T = cdr(MF); T != []; T = cdr(T) ) {
                    815:                Mt = car(car(T));
                    816:                D1 = D*1;
                    817:                D1[I] = Mt;
1.7       noro      818:                GIt = map(gen_nf,GI,[Mt],V,Ord,Mod);
1.1       noro      819:                G1 = cons(Mt,GIt);
                    820:                Gelim = elim_gb(G1,V,PV,Mod,Ord);
                    821:                D1[N] = LD = ldim(Gelim,V);
                    822:                for ( J = 0; J < N; J++ )
                    823:                        if ( D1[J] && deg(D1[J],V[J]) == LD ) break;
                    824:                if ( J < N )
                    825:                        P = cons([Gelim,D1],P);
                    826:                else
                    827:                        NP = cons([Gelim,D1],NP);
                    828:        }
                    829:        return [P,NP];
                    830: }
                    831:
                    832: /* prime/primary components over rational function field */
                    833:
                    834: def zprimacomp(G,V) {
1.7       noro      835:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                    836:        L = zprimadec(G,V,0|mod=Mod);
1.1       noro      837:        R = [];
                    838:        dp_ord(0);
                    839:        for ( T = L; T != []; T = cdr(T) ) {
                    840:                S = car(T);
1.7       noro      841:                UQ = contraction(S[0],V|mod=Mod);
                    842:                UP = contraction(S[1],V|mod=Mod);
1.1       noro      843:                R = cons([UQ,UP],R);
                    844:        }
                    845:        return R;
                    846: }
                    847:
                    848: def zprimecomp(G,V,Indep) {
1.7       noro      849:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                    850:        W = maxindep(G,V,0|mod=Mod);
1.1       noro      851:        V0 = setminus(V,W);
                    852:        V1 = append(V0,W);
                    853: #if 0
                    854:        O1 = [[0,length(V0)],[0,length(W)]];
1.7       noro      855:        G1 = fast_gb(G,V1,Mod,O1);
1.1       noro      856:        dp_ord(0);
                    857: #else
                    858:        G1 = G;
                    859: #endif
1.7       noro      860:        PD = zprimedec(G1,V0,Mod);
1.1       noro      861:        dp_ord(0);
                    862:        R = [];
                    863:        for ( T = PD; T != []; T = cdr(T) ) {
1.7       noro      864:                U = contraction(car(T),V0|mod=Mod);
1.1       noro      865:                R = cons(U,R);
                    866:        }
                    867:        if ( Indep ) return [R,W];
                    868:        else return R;
                    869: }
                    870:
                    871: def fast_gb(B,V,Mod,Ord)
                    872: {
1.7       noro      873:        if ( type(Block=getopt(gbblock)) == -1 ) Block = 0;
                    874:        if ( type(NoRA=getopt(nora)) == -1 ) NoRA = 0;
1.1       noro      875:        if ( Mod )
                    876:                G = nd_f4(B,V,Mod,Ord|nora=NoRA);
1.7       noro      877:        else if ( F4 )
                    878:                G = map(ptozp,f4_chrem(B,V,Ord));
                    879:        else if ( Block )
                    880:                G = nd_gr_trace(B,V,1,GBCheck,Ord|nora=NoRA,gbblock=Block);
                    881:        else
                    882:                G = nd_gr_trace(B,V,1,GBCheck,Ord|nora=NoRA);
1.1       noro      883:        return G;
                    884: }
                    885:
1.5       noro      886: def incremental_gb(A,V,Ord)
                    887: {
                    888:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                    889:        if ( type(Block=getopt(gbblock)) == -1 ) Block = 0;
1.7       noro      890:        if ( Mod ) {
                    891:                if ( Block )
                    892:                        G = nd_gr(A,V,Mod,Ord|gbblock=Block);
                    893:                else
                    894:                        G = nd_gr(A,V,Mod,Ord);
                    895:        } else if ( Procs ) {
1.5       noro      896:                Arg0 = ["nd_gr",A,V,0,Ord];
                    897:                Arg1 = ["nd_gr_trace",A,V,1,GBCheck,Ord];
                    898:                G = competitive_exec(Procs,Arg0,Arg1);
                    899:        } else if ( Block )
                    900:                G = nd_gr(A,V,0,Ord|gbblock=Block);
                    901:        else
                    902:                G = nd_gr(A,V,0,Ord);
                    903:        return G;
                    904: }
1.1       noro      905:
                    906: def elim_gb(G,V,PV,Mod,Ord)
                    907: {
                    908:        N = length(V); PN = length(PV);
                    909:        O1 = [[0,N],[0,PN]];
                    910:        if ( Ord == O1 )
                    911:                Ord = Ord[0][0];
1.7       noro      912:        if ( Mod ) /* XXX */ {
                    913:                for ( T = G, H = []; T != []; T = cdr(T) )
                    914:                        if ( car(T) ) H = cons(car(T),H);
                    915:                G = reverse(H);
1.1       noro      916:                G = dp_gr_mod_main(G,V,0,Mod,Ord);
1.7       noro      917:        } else if ( Procs ) {
1.1       noro      918:                Arg0 = ["nd_gr_trace",G,V,1,GBCheck,Ord];
                    919:                Arg1 = ["nd_gr_trace_rat",G,V,PV,1,GBCheck,O1,Ord];
                    920:                G = competitive_exec(Procs,Arg0,Arg1);
                    921:        } else
                    922:                G = nd_gr_trace(G,V,1,GBCheck,Ord);
                    923:        return G;
                    924: }
                    925:
                    926: def ldim(G,V)
                    927: {
                    928:        O0 = dp_ord(); dp_ord(0);
                    929:        D = length(dp_mbase(map(dp_ptod,G,V)));
                    930:        dp_ord(O0);
                    931:        return D;
                    932: }
                    933:
1.7       noro      934: /* over Q only */
                    935:
1.1       noro      936: def make_mod_subst(GD,V,PV,HC)
                    937: {
                    938:        N = length(V);
                    939:        PN = length(PV);
                    940:        G = GD[0]; D = GD[1];
                    941:        for ( I = 0; ; I = (I+1)%100 ) {
                    942:                Mod = lprime(I);
                    943:                S = [];
                    944:                for ( J = PN-1; J >= 0; J-- )
                    945:                        S = append([PV[J],random()%Mod],S);
                    946:                for ( T = HC; T != []; T = cdr(T) )
                    947:                        if ( !(subst(car(T),S)%Mod) ) break;
                    948:                if ( T != [] ) continue;
                    949:                for ( J = 0; J < N; J++ ) {
                    950:                        M = subst(D[J],S);
                    951:                        F = modsqfr(M,Mod);
                    952:                        if ( length(F) != 2 || F[1][1] != 1 ) break;
                    953:                }
                    954:                if ( J < N ) continue;
                    955:                G0 = map(subst,G,S);
                    956:                return [G0,Mod];
                    957:        }
                    958: }
                    959:
                    960: def rsgn()
                    961: {
                    962:        return random()%2 ? 1 : -1;
                    963: }
                    964:
                    965: def find_npos(GD,V,PV,Mod)
                    966: {
                    967:        N = length(V); PN = length(PV);
                    968:        G = GD[0]; D = GD[1]; LD = D[N];
                    969:        Ord0 = dp_ord(); dp_ord(0);
                    970:        HC = map(dp_hc,map(dp_ptod,G,V));
                    971:        dp_ord(Ord0);
                    972:        if ( !Mod ) {
                    973:                W = append(V,PV);
                    974:                G1 = nd_gr_trace(G,W,1,GBCheck,[[0,N],[0,PN]]);
                    975:                L = make_mod_subst([G1,D],V,PV,HC);
                    976:                return find_npos([L[0],D],V,[],L[1]);
                    977:        }
                    978:        N = length(V);
                    979:        NV = ttttt;
                    980:        for ( B = 2; ; B++ ) {
                    981:                for ( J = N-2; J >= 0; J-- ) {
                    982:                        for ( U = 0, K = J; K < N; K++ )
                    983:                                U += rsgn()*((random()%B+1))*V[K];
                    984:                        M = minipolym(G,V,0,U,NV,Mod);
                    985:                        if ( deg(M,NV) == LD ) return U;
                    986:                }
                    987:        }
                    988: }
                    989:
                    990: def gen_minipoly(G,V,PV,Ord,VI,Mod)
                    991: {
                    992:        if ( PV == [] ) {
                    993:                NV = ttttt;
                    994:                if ( Mod )
                    995:                        M = minipolym(G,V,Ord,VI,NV,Mod);
                    996:                else
                    997:                        M = minipoly(G,V,Ord,VI,NV);
                    998:                return subst(M,NV,VI);
                    999:        }
                   1000:        W = setminus(V,[VI]);
                   1001:        PV1 = cons(VI,PV);
                   1002: #if 0
                   1003:        while ( 1 ) {
                   1004:                V1 = append(W,PV1);
                   1005:                if ( Mod )
                   1006:                        G = nd_gr(G,V1,Mod,[[0,1],[0,length(V1)-1]]|nora=1);
                   1007:                else
                   1008:                        G = nd_gr_trace(G,V1,1,GBCheck,[[0,1],[0,length(V1)-1]]|nora=1);
                   1009:                if ( W == [] ) break;
                   1010:                else {
                   1011:                        W = cdr(W);
                   1012:                        G = elimination(G,cdr(V1));
                   1013:                }
                   1014:        }
                   1015: #elif 1
                   1016:        if ( Mod ) {
1.7       noro     1017:                V1 = append(W,PV1);
                   1018:                G = nd_gr(G,V1,Mod,[[0,length(W)],[0,length(PV1)]]);
1.1       noro     1019:                G = elimination(G,PV1);
                   1020:        } else {
                   1021:                PV2 = setminus(PV1,[PV1[length(PV1)-1]]);
                   1022:                V2 = append(W,PV2);
                   1023:                G = nd_gr_trace(G,V2,1,GBCheck,[[0,length(W)],[0,length(PV2)]]|nora=1);
                   1024:                G = elimination(G,PV1);
                   1025:        }
                   1026: #else
                   1027:        V1 = append(W,PV1);
                   1028:        if ( Mod )
                   1029:                G = nd_gr(G,V1,Mod,[[0,length(W)],[0,length(PV1)]]|nora=1);
                   1030:        else
                   1031:                G = nd_gr_trace(G,V1,1,GBCheck,[[0,length(W)],[0,length(PV1)]]|nora=1);
                   1032:        G = elimination(G,PV1);
                   1033: #endif
                   1034:        if ( Mod )
                   1035:                G = nd_gr(G,PV1,Mod,[[0,1],[0,length(PV)]]|nora=1);
                   1036:        else
                   1037:                G = nd_gr_trace(G,PV1,1,GBCheck,[[0,1],[0,length(PV)]]|nora=1);
                   1038:        for ( M = car(G), T = cdr(G); T != []; T = cdr(T) )
                   1039:                if ( deg(car(T),VI) < deg(M,VI) ) M = car(T);
                   1040:        return M;
                   1041: }
                   1042:
                   1043: def indepset(V,H)
                   1044: {
                   1045:        if ( H == [] ) return V;
                   1046:        N = -1;
                   1047:        for ( T = V; T != []; T = cdr(T) ) {
                   1048:                VI = car(T);
                   1049:                HI = [];
                   1050:                for ( S = H; S != []; S = cdr(S) )
                   1051:                        if ( !tdiv(car(S),VI) ) HI = cons(car(S),HI);
                   1052:                RI = indepset(setminus(V,[VI]),HI);
                   1053:                if ( length(RI) > N ) {
                   1054:                        R = RI; N = length(RI);
                   1055:                }
                   1056:        }
                   1057:        return R;
                   1058: }
                   1059:
                   1060: def maxindep(B,V,O)
                   1061: {
1.7       noro     1062:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                   1063:        G = fast_gb(B,V,Mod,O);
1.1       noro     1064:        Old = dp_ord();
                   1065:        dp_ord(O);
                   1066:        H = map(dp_dtop,map(dp_ht,map(dp_ptod,G,V)),V);
                   1067:        H = dp_mono_raddec(H,V);
                   1068:        N = length(V);
                   1069:        Dep = [];
                   1070:        for ( T = H, Len = N+1; T != []; T = cdr(T) ) {
                   1071:                M = length(car(T));
                   1072:                if ( M < Len ) {
                   1073:                        Dep = [car(T)];
                   1074:                        Len = M;
                   1075:                } else if ( M == Len )
                   1076:                        Dep = cons(car(T),Dep);
                   1077:        }
                   1078:        R = setminus(V,Dep[0]);
                   1079:        dp_ord(Old);
                   1080:        return R;
                   1081: }
                   1082:
                   1083: /* ideal operations */
                   1084: def contraction(G,V)
                   1085: {
1.7       noro     1086:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1.1       noro     1087:        C = [];
                   1088:        for ( T = G; T != []; T = cdr(T) ) {
                   1089:                C1 = dp_hc(dp_ptod(car(T),V));
1.7       noro     1090:                S = gen_fctr(C1,Mod);
1.1       noro     1091:                for ( S = cdr(S); S != []; S = cdr(S) )
                   1092:                        if ( !member(S[0][0],C) ) C = cons(S[0][0],C);
                   1093:        }
                   1094:        W = vars(G);
                   1095:        PV = setminus(W,V);
                   1096:        W = append(V,PV);
                   1097:        NV = ttttt;
                   1098:        for ( T = C, S = 1; T != []; T = cdr(T) )
                   1099:                S *= car(T);
1.7       noro     1100:        G = saturation([G,NV],S,W|mod=Mod);
1.1       noro     1101:        return G;
                   1102: }
                   1103:
                   1104: def ideal_list_intersection(L,V,Ord)
                   1105: {
                   1106:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                   1107:        N = length(L);
                   1108:        if ( N == 0 ) return [1];
                   1109:        if ( N == 1 ) return fast_gb(L[0],V,Mod,Ord);
                   1110:        N2 = idiv(N,2);
                   1111:        for ( L1 = [], I = 0; I < N2; I++ ) L1 = cons(L[I],L1);
                   1112:        for ( L2 = []; I < N; I++ ) L2 = cons(L[I],L2);
                   1113:        I1 = ideal_list_intersection(L1,V,Ord|mod=Mod);
                   1114:        I2 = ideal_list_intersection(L2,V,Ord|mod=Mod);
                   1115:        return ideal_intersection(I1,I2,V,Ord|mod=Mod,
                   1116:                gbblock=[[0,length(I1)],[length(I1),length(I2)]]);
                   1117: }
                   1118:
                   1119: def ideal_intersection(A,B,V,Ord)
                   1120: {
                   1121:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                   1122:        if ( type(Block=getopt(gbblock)) == -1 ) Block = 0;
                   1123:        T = ttttt;
1.7       noro     1124:        if ( Mod ) {
                   1125:                if ( Block )
                   1126:                        G = nd_gr(append(vtol(ltov(A)*T),vtol(ltov(B)*(1-T))),
                   1127:                                cons(T,V),Mod,[[0,1],[Ord,length(V)]]|gbblock=Block,nora=1);
                   1128:                else
                   1129:                        G = nd_gr(append(vtol(ltov(A)*T),vtol(ltov(B)*(1-T))),
                   1130:                                cons(T,V),Mod,[[0,1],[Ord,length(V)]]|nora=1);
                   1131:        } else
1.1       noro     1132:        if ( Procs ) {
                   1133:                Arg0 = ["nd_gr",
                   1134:                        append(vtol(ltov(A)*T),vtol(ltov(B)*(1-T))),
                   1135:                        cons(T,V),0,[[0,1],[Ord,length(V)]]];
                   1136:                Arg1 = ["nd_gr_trace",
                   1137:                        append(vtol(ltov(A)*T),vtol(ltov(B)*(1-T))),
                   1138:                        cons(T,V),1,GBCheck,[[0,1],[Ord,length(V)]]];
                   1139:                G = competitive_exec(Procs,Arg0,Arg1);
                   1140:        } else {
                   1141:                if ( Block )
                   1142:                        G = nd_gr(append(vtol(ltov(A)*T),vtol(ltov(B)*(1-T))),
1.7       noro     1143:                                cons(T,V),0,[[0,1],[Ord,length(V)]]|gbblock=Block,nora=0);
1.1       noro     1144:                else
                   1145:                        G = nd_gr(append(vtol(ltov(A)*T),vtol(ltov(B)*(1-T))),
1.7       noro     1146:                                cons(T,V),0,[[0,1],[Ord,length(V)]]|nora=0);
1.1       noro     1147:        }
                   1148:        G0 = elimination(G,V);
1.7       noro     1149:        if ( 0 && !Procs )
                   1150:                G0 = nd_gr_postproc(G0,V,Mod,Ord,0);
1.1       noro     1151:        return G0;
                   1152: }
                   1153:
                   1154: /* returns GB if F notin rad(G) */
                   1155:
                   1156: def radical_membership(F,G,V) {
1.7       noro     1157:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                   1158:        F = gen_nf(F,G,V,0,Mod);
1.1       noro     1159:        if ( !F ) return 0;
                   1160:        NV = ttttt;
1.7       noro     1161:        T = fast_gb(cons(NV*F-1,G),cons(NV,V),Mod,0);
1.1       noro     1162:        if ( type(car(T)) != 1 ) return [T,NV];
                   1163:        else return 0;
                   1164: }
                   1165:
1.7       noro     1166: def modular_radical_membership(F,G,V) {
                   1167:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                   1168:        if ( Mod )
                   1169:                return radical_membership(F,G,V|mod=Mod);
1.1       noro     1170:
1.7       noro     1171:        F = gen_nf(F,G,V,0,0);
1.1       noro     1172:        if ( !F ) return 0;
                   1173:        NV = ttttt;
                   1174:        for ( J = 0; ; J++ ) {
                   1175:                Mod = lprime(J);
                   1176:                H = map(dp_hc,map(dp_ptod,G,V));
                   1177:                for ( ; H != []; H = cdr(H) ) if ( !(car(H)%Mod) ) break;
                   1178:                if ( H != [] ) continue;
                   1179:
                   1180:                T = nd_f4(cons(NV*F-1,G),cons(NV,V),Mod,0);
                   1181:                if ( type(car(T)) == 1 ) {
                   1182:                        I = radical_membership_rep(F,G,V,-1,0,Mod);
                   1183:                        I1 = radical_membership_rep(F,G,V,I,0,0);
                   1184:                        if ( I1 > 0 ) return 0;
                   1185:                }
                   1186:                return radical_membership(F,G,V);
                   1187:        }
                   1188: }
                   1189:
                   1190: def radical_membership_rep(F,G,V,Max,Ord,Mod) {
                   1191:        Ft = F;
                   1192:        I = 1;
                   1193:        while ( Max < 0 || I <= Max ) {
1.7       noro     1194:                Ft = gen_nf(Ft,G,V,Ord,Mod);
1.1       noro     1195:                if ( !Ft ) return I;
                   1196:                Ft *= F;
                   1197:                I++;
                   1198:        }
                   1199:        return -1;
                   1200: }
                   1201:
                   1202: def ideal_product(A,B,V)
                   1203: {
1.7       noro     1204:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1.1       noro     1205:        dp_ord(0);
                   1206:        DA = map(dp_ptod,A,V);
                   1207:        DB = map(dp_ptod,B,V);
                   1208:        DegA = map(dp_td,DA);
                   1209:        DegB = map(dp_td,DB);
                   1210:        for ( PA = [], T = A, DT = DegA; T != []; T = cdr(T), DT = cdr(DT) )
                   1211:                PA = cons([car(T),car(DT)],PA);
                   1212:        PA = reverse(PA);
                   1213:        for ( PB = [], T = B, DT = DegB; T != []; T = cdr(T), DT = cdr(DT) )
                   1214:                PB = cons([car(T),car(DT)],PB);
                   1215:        PB = reverse(PB);
                   1216:        R = [];
                   1217:        for ( T = PA; T != []; T = cdr(T) )
                   1218:                for ( S = PB; S != []; S = cdr(S) )
                   1219:                        R = cons([car(T)[0]*car(S)[0],car(T)[1]+car(S)[1]],R);
1.12    ! ohara    1220:        T = qsort(R,noro_pd.comp_by_second);
1.1       noro     1221:        T = map(first_element,T);
                   1222:        Len = length(A)>length(B)?length(A):length(B);
                   1223:        Len *= 2;
                   1224:        L = sep_list(T,Len); B0 = L[0]; B1 = L[1];
1.7       noro     1225:        R = fast_gb(B0,V,Mod,0);
1.1       noro     1226:        while ( B1 != [] ) {
                   1227:                print(length(B1));
                   1228:                L = sep_list(B1,Len);
                   1229:                B0 = L[0]; B1 = L[1];
1.7       noro     1230:                R = fast_gb(append(R,B0),V,Mod,0|gbblock=[[0,length(R)]],nora=1);
1.1       noro     1231:        }
                   1232:        return R;
                   1233: }
                   1234:
                   1235: def saturation(GNV,F,V)
                   1236: {
1.7       noro     1237:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1.1       noro     1238:        G = GNV[0]; NV = GNV[1];
1.7       noro     1239:        if ( Mod )
                   1240:                G1 = nd_gr(cons(NV*F-1,G),cons(NV,V),Mod,[[0,1],[0,length(V)]]);
                   1241:        else if ( Procs ) {
1.1       noro     1242:                Arg0 = ["nd_gr_trace",
                   1243:                cons(NV*F-1,G),cons(NV,V),0,GBCheck,[[0,1],[0,length(V)]]];
                   1244:                Arg1 = ["nd_gr_trace",
                   1245:                cons(NV*F-1,G),cons(NV,V),1,GBCheck,[[0,1],[0,length(V)]]];
                   1246:                G1 = competitive_exec(Procs,Arg0,Arg1);
                   1247:        } else
                   1248:                G1 = nd_gr_trace(cons(NV*F-1,G),cons(NV,V),SatHomo,GBCheck,[[0,1],[0,length(V)]]);
                   1249:        return elimination(G1,V);
                   1250: }
                   1251:
                   1252: def sat(G,F,V)
                   1253: {
1.7       noro     1254:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1.5       noro     1255:        if ( type(IsGB=getopt(isgb)) == -1 ) IsGB = 0;
1.1       noro     1256:        NV = ttttt;
1.7       noro     1257:        if ( Mod )
                   1258:                G1 = nd_gr(cons(NV*F-1,G),cons(NV,V),Mod,[[0,1],[0,length(V)]]);
                   1259:        else if ( Procs ) {
1.1       noro     1260:                Arg0 = ["nd_gr_trace",
                   1261:                cons(NV*F-1,G),cons(NV,V),0,GBCheck,[[0,1],[0,length(V)]]];
                   1262:                Arg1 = ["nd_gr_trace",
                   1263:                cons(NV*F-1,G),cons(NV,V),1,GBCheck,[[0,1],[0,length(V)]]];
                   1264:                G1 = competitive_exec(Procs,Arg0,Arg1);
1.5       noro     1265:        } else {
                   1266:                B1 = append(G,[NV*F-1]);
                   1267:                V1 = cons(NV,V);
                   1268:                Ord1 = [[0,1],[0,length(V)]];
                   1269:                if ( IsGB )
                   1270:                        G1 = nd_gr_trace(B1,V1,SatHomo,GBCheck,Ord1|
                   1271:                                gbblock=[[0,length(G)]]);
                   1272:                else
                   1273:                        G1 = nd_gr_trace(B1,V1,SatHomo,GBCheck,Ord1);
                   1274:        }
1.1       noro     1275:        return elimination(G1,V);
                   1276: }
                   1277:
                   1278: def satind(G,F,V)
                   1279: {
1.7       noro     1280:        if ( type(Block=getopt(gbblock)) == -1 ) Block = 0;
                   1281:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1.1       noro     1282:        NV = ttttt;
                   1283:        N = length(V);
                   1284:        B = append(G,[NV*F-1]);
                   1285:        V1 = cons(NV,V);
1.7       noro     1286:        Ord1 = [[0,1],[0,N]];
                   1287:        if ( Mod )
                   1288:                if ( Block )
                   1289:                        D = nd_gr(B,V1,Mod,Ord1|nora=1,gentrace=1,gbblock=Block);
                   1290:                else
                   1291:                        D = nd_gr(B,V1,Mod,Ord1|nora=1,gentrace=1);
                   1292:        else
                   1293:                if ( Block )
                   1294:                        D = nd_gr_trace(B,V1,SatHomo,GBCheck,Ord1
                   1295:                                |nora=1,gentrace=1,gbblock=Block);
                   1296:                else
                   1297:                        D = nd_gr_trace(B,V1,SatHomo,GBCheck,Ord1
                   1298:                                |nora=1,gentrace=1);
1.1       noro     1299:        G1 = D[0];
                   1300:        Len = length(G1);
                   1301:        Deg = compute_deg(B,V1,NV,D);
                   1302:        D1 = 0;
                   1303:        R = [];
                   1304:        M = length(B);
                   1305:        for ( I = 0; I < Len; I++ ) {
                   1306:                if ( !member(NV,vars(G1[I])) ) {
                   1307:                        for ( J = 1; J < M; J++ )
                   1308:                                D1 = MAX(D1,Deg[I][J]);
                   1309:                        R = cons(G1[I],R);
                   1310:                }
                   1311:        }
                   1312:        return [reverse(R),D1];
                   1313: }
                   1314:
                   1315: def sat_ind(G,F,V)
                   1316: {
1.7       noro     1317:        if ( type(Ord=getopt(ord)) == -1 ) Ord = 0;
                   1318:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1.1       noro     1319:        NV = ttttt;
1.7       noro     1320:        F = gen_nf(F,G,V,Ord,Mod);
1.1       noro     1321:        for ( I = 0, GI = G; ; I++ ) {
1.7       noro     1322:                G1 = colon(GI,F,V|mod=Mod,ord=Ord);
                   1323:                if ( ideal_inclusion(G1,GI,V,Ord|mod=Mod) )  {
1.1       noro     1324:                        return [GI,I];
                   1325:                }
                   1326:                else GI = G1;
                   1327:        }
                   1328: }
                   1329:
                   1330: def colon(G,F,V)
                   1331: {
1.7       noro     1332:        if ( type(Ord=getopt(ord)) == -1 ) Ord = 0;
                   1333:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1.5       noro     1334:        if ( type(IsGB=getopt(isgb)) == -1 ) IsGB = 0;
1.7       noro     1335:        F = gen_nf(F,G,V,Ord,Mod);
1.1       noro     1336:        if ( !F ) return [1];
1.5       noro     1337:        if ( IsGB )
1.7       noro     1338:                T = ideal_intersection(G,[F],V,Ord|gbblock=[[0,length(G)]],mod=Mod);
1.5       noro     1339:        else
1.7       noro     1340:                T = ideal_intersection(G,[F],V,Ord|mod=Mod);
                   1341:        return Mod?map(sdivm,T,F,Mod):map(ptozp,map(sdiv,T,F));
1.1       noro     1342: }
                   1343:
                   1344: def ideal_colon(G,F,V)
                   1345: {
1.7       noro     1346:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                   1347:        G = nd_gr(G,V,Mod,0);
1.5       noro     1348:        for ( T = F, L = []; T != []; T = cdr(T) )
1.7       noro     1349:                L = cons(colon(G,car(T),V|isgb=1,mod=Mod),L);
1.5       noro     1350:        L = reverse(L);
1.7       noro     1351:        return ideal_list_intersection(L,V,0|mod=Mod);
1.1       noro     1352: }
                   1353:
1.2       noro     1354: def ideal_sat(G,F,V)
                   1355: {
1.7       noro     1356:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                   1357:        G = nd_gr(G,V,Mod,0);
                   1358:        for ( T = F, L = []; T != []; T = cdr(T) )
                   1359:                L = cons(sat(G,car(T),V|mod=Mod),L);
                   1360:        L = reverse(L);
                   1361:        return ideal_list_intersection(L,V,0|mod=Mod);
1.2       noro     1362: }
                   1363:
1.1       noro     1364: def ideal_inclusion(F,G,V,O)
                   1365: {
                   1366:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1.7       noro     1367:        for ( T = F; T != []; T = cdr(T) )
                   1368:                if ( gen_nf(car(T),G,V,O,Mod) ) return 0;
1.1       noro     1369:        return 1;
                   1370: }
                   1371:
                   1372: /* remove redundant components */
                   1373:
                   1374: def qd_simp_comp(QP,V)
                   1375: {
1.7       noro     1376:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1.1       noro     1377:        R = ltov(QP);
                   1378:        N = length(R);
                   1379:        for ( I = 0; I < N; I++ ) {
                   1380:                if ( R[I] ) {
                   1381:                        QI = R[I][0]; PI = R[I][1];
                   1382:                        for ( J = I+1; J < N; J++ )
1.7       noro     1383:                                if ( R[J] && gen_gb_comp(PI,R[J][1],Mod) ) {
                   1384:                                        QI = ideal_intersection(QI,R[J][0],V,0|mod=Mod);
1.1       noro     1385:                                        R[J] = 0;
                   1386:                                }
                   1387:                        R[I] = [QI,PI];
                   1388:                }
                   1389:        }
                   1390:        for ( I = N-1, S = []; I >= 0; I-- )
                   1391:                if ( R[I] ) S = cons(R[I],S);
                   1392:        return S;
                   1393: }
                   1394:
                   1395: def qd_remove_redundant_comp(G,Iso,Emb,V,Ord)
                   1396: {
1.7       noro     1397:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                   1398:        IsoInt = ideal_list_intersection(map(first_element,Iso),V,Ord|mod=Mod);
                   1399:        Emb = qd_simp_comp(Emb,V|mod=Mod);
1.6       noro     1400:        Emb = reverse(qsort(Emb));
                   1401:        A = ltov(Emb); N = length(A);
                   1402:        Pre = IsoInt; Post = vector(N+1);
1.7       noro     1403:        for ( Post[N] = IsoInt, I = N-1; I >= 1; I-- )
                   1404:                Post[I] = ideal_intersection(Post[I+1],A[I][0],V,Ord|mod=Mod);
1.1       noro     1405:        for ( I = 0; I < N; I++ ) {
1.7       noro     1406:                print(".",2);
                   1407:                Int = ideal_intersection(Pre,Post[I+1],V,Ord|mod=Mod);
                   1408:                if ( gen_gb_comp(Int,G,Mod) ) A[I] = 0;
1.6       noro     1409:                else
1.7       noro     1410:                        Pre = ideal_intersection(Pre,A[I][0],V,Ord|mod=Mod);
1.1       noro     1411:        }
                   1412:        for ( T = [], I = 0; I < N; I++ )
                   1413:                if ( A[I] ) T = cons(A[I],T);
                   1414:        return reverse(T);
                   1415: }
                   1416:
1.6       noro     1417: def pd_remove_redundant_comp(G,P,V,Ord)
1.1       noro     1418: {
1.7       noro     1419:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1.6       noro     1420:        if ( type(First=getopt(first)) == -1 ) First = 0;
                   1421:        A = ltov(P); N = length(A);
1.1       noro     1422:        for ( I = 0; I < N; I++ ) {
                   1423:                if ( !A[I] ) continue;
                   1424:                for ( J = I+1; J < N; J++ )
1.6       noro     1425:                        if ( A[J] &&
1.7       noro     1426:                                gen_gb_comp(First?A[I][0]:A[I],First?A[J][0]:A[J],Mod) ) A[J] = 0;
1.1       noro     1427:        }
1.6       noro     1428:        for ( I = 0, T = []; I < N; I++ ) if ( A[I] ) T = cons(A[I],T);
                   1429:        A = ltov(reverse(T)); N = length(A);
                   1430:        Pre = [1]; Post = vector(N+1);
                   1431:        for ( Post[N] = [1], I = N-1; I >= 1; I-- )
1.7       noro     1432:                Post[I] = ideal_intersection(Post[I+1],First?A[I][0]:A[I],V,Ord|mod=Mod);
1.1       noro     1433:        for ( I = 0; I < N; I++ ) {
1.7       noro     1434:                Int = ideal_intersection(Pre,Post[I+1],V,Ord|mod=Mod);
                   1435:                if ( gen_gb_comp(Int,G,Mod) ) A[I] = 0;
1.6       noro     1436:                else
1.7       noro     1437:                        Pre = ideal_intersection(Pre,First?A[I][0]:A[I],V,Ord|mod=Mod);
1.1       noro     1438:        }
1.6       noro     1439:        for ( T = [], I = 0; I < N; I++ ) if ( A[I] ) T = cons(A[I],T);
1.1       noro     1440:        return reverse(T);
                   1441: }
                   1442:
                   1443: /* polynomial operations */
                   1444:
                   1445: def ppart(F,V,Mod)
                   1446: {
                   1447:        if ( !Mod )
                   1448:                G = nd_gr([F],[V],0,0);
                   1449:        else
                   1450:                G = dp_gr_mod_main([F],[V],0,Mod,0);
                   1451:        return G[0];
                   1452: }
                   1453:
                   1454:
1.7       noro     1455: def sq(F,Mod)
1.1       noro     1456: {
                   1457:        if ( !F ) return 0;
1.7       noro     1458:        A = cdr(gen_fctr(F,Mod));
1.1       noro     1459:        for ( R = 1; A != []; A = cdr(A) )
                   1460:                R *= car(car(A));
                   1461:        return R;
                   1462: }
                   1463:
1.7       noro     1464: def lcfactor(G,V,O,Mod)
1.1       noro     1465: {
                   1466:        O0 = dp_ord(); dp_ord(O);
                   1467:        C = [];
                   1468:        for ( T = G; T != []; T = cdr(T) ) {
                   1469:                C1 = dp_hc(dp_ptod(car(T),V));
1.7       noro     1470:                S = gen_fctr(C1,Mod);
1.1       noro     1471:                for ( S = cdr(S); S != []; S = cdr(S) )
                   1472:                        if ( !member(S[0][0],C) ) C = cons(S[0][0],C);
                   1473:        }
                   1474:        dp_ord(O0);
                   1475:        return C;
                   1476: }
                   1477:
1.7       noro     1478: def gen_fctr(F,Mod)
                   1479: {
                   1480:        if ( Mod ) return modfctr(F,Mod);
                   1481:        else return fctr(F);
                   1482: }
                   1483:
                   1484: def gen_mptop(F)
                   1485: {
                   1486:        if ( !F ) return F;
                   1487:        else if ( type(F)==1 )
                   1488:                if ( ntype(F)==5 ) return mptop(F);
                   1489:                else return F;
                   1490:        else {
                   1491:                V = var(F);
                   1492:                D = deg(F,V);
                   1493:                for ( R = 0, I = 0; I <= D; I++ )
                   1494:                        if ( C = coef(F,I,V) ) R += gen_mptop(C)*V^I;
                   1495:                return R;
                   1496:        }
                   1497: }
                   1498:
                   1499: def gen_nf(F,G,V,Ord,Mod)
                   1500: {
                   1501:        if ( !Mod ) return p_nf(F,G,V,Ord);
                   1502:
                   1503:        setmod(Mod);
                   1504:        dp_ord(Ord); DF = dp_mod(dp_ptod(F,V),Mod,[]);
                   1505:        N = length(G); DG = newvect(N);
                   1506:        for ( I = N-1, IL = []; I >= 0; I-- ) {
                   1507:                DG[I] = dp_mod(dp_ptod(G[I],V),Mod,[]);
                   1508:                IL = cons(I,IL);
                   1509:        }
                   1510:        T = dp_nf_mod(IL,DF,DG,1,Mod);
                   1511:        for ( R = 0; T; T = dp_rest(T) )
                   1512:                R += gen_mptop(dp_hc(T))*dp_dtop(dp_ht(T),V);
                   1513:        return R;
                   1514: }
                   1515:
1.1       noro     1516: /* Ti = [D,I,M,C] */
                   1517:
                   1518: def compute_deg0(Ti,P,V,TV)
                   1519: {
                   1520:        N = length(P[0]);
                   1521:        Num = vector(N);
                   1522:        for ( I = 0; I < N; I++ ) Num[I] = -1;
                   1523:        for ( ; Ti != []; Ti = cdr(Ti) ) {
                   1524:                Sj = car(Ti);
                   1525:                Dj = Sj[0];
                   1526:                Ij =Sj[1];
                   1527:                Mj = deg(type(Sj[2])==9?dp_dtop(Sj[2],V):Sj[2],TV);
                   1528:                Pj = P[Ij];
                   1529:                if ( Dj )
                   1530:                        for ( I = 0; I < N; I++ )
                   1531:                                if ( Pj[I] >= 0 ) {
                   1532:                                        T = Mj+Pj[I];
                   1533:                                        Num[I] = MAX(Num[I],T);
                   1534:                                }
                   1535:        }
                   1536:        return Num;
                   1537: }
                   1538:
                   1539: def compute_deg(B,V,TV,Data)
                   1540: {
                   1541:        GB = Data[0];
                   1542:        Homo = Data[1];
                   1543:        Trace = Data[2];
                   1544:        IntRed = Data[3];
                   1545:        Ind = Data[4];
                   1546:        DB = map(dp_ptod,B,V);
                   1547:        if ( Homo ) {
                   1548:                DB = map(dp_homo,DB);
                   1549:                V0 = append(V,[hhh]);
                   1550:        } else
                   1551:                V0 = V;
                   1552:        Perm = Trace[0]; Trace = cdr(Trace);
                   1553:        for ( I = length(Perm)-1, T = Trace; T != []; T = cdr(T) )
                   1554:                if ( (J=car(T)[0]) > I ) I = J;
                   1555:        N = I+1;
                   1556:        N0 = length(B);
                   1557:        P = vector(N);
                   1558:        for ( T = Perm, I = 0; T != []; T = cdr(T), I++ ) {
                   1559:                Pi = car(T);
                   1560:                C = vector(N0);
                   1561:                for ( J = 0; J < N0; J++ ) C[J] = -1;
                   1562:                C[Pi[1]] = 0;
                   1563:                P[Pi[0]] = C;
                   1564:        }
                   1565:        for ( T = Trace; T != []; T = cdr(T) ) {
                   1566:                Ti = car(T); P[Ti[0]] = compute_deg0(Ti[1],P,V0,TV);
                   1567:        }
                   1568:        M = length(Ind);
                   1569:        for ( T = IntRed; T != []; T = cdr(T) ) {
                   1570:                Ti = car(T); P[Ti[0]] = compute_deg0(Ti[1],P,V,TV);
                   1571:        }
                   1572:        R = [];
                   1573:        for ( J = 0; J < M; J++ ) {
                   1574:                U = P[Ind[J]];
                   1575:                R = cons(U,R);
                   1576:        }
                   1577:        return reverse(R);
                   1578: }
                   1579:
                   1580: /* set theoretic functions */
                   1581:
                   1582: def member(A,S)
                   1583: {
                   1584:        for ( ; S != []; S = cdr(S) )
                   1585:                if ( car(S) == A ) return 1;
                   1586:        return 0;
                   1587: }
                   1588:
                   1589: def elimination(G,V) {
                   1590:        for ( R = [], T = G; T != []; T = cdr(T) )
                   1591:                if ( setminus(vars(car(T)),V) == [] ) R =cons(car(T),R);
                   1592:        return R;
                   1593: }
                   1594:
                   1595: def setintersection(A,B)
                   1596: {
                   1597:        for ( L = []; A != []; A = cdr(A) )
                   1598:                if ( member(car(A),B) )
                   1599:                        L = cons(car(A),L);
                   1600:        return L;
                   1601: }
                   1602:
                   1603: def setminus(A,B) {
                   1604:        for ( T = reverse(A), R = []; T != []; T = cdr(T) ) {
                   1605:                for ( S = B, M = car(T); S != []; S = cdr(S) )
                   1606:                        if ( car(S) == M ) break;
                   1607:                if ( S == [] ) R = cons(M,R);
                   1608:        }
                   1609:        return R;
                   1610: }
                   1611:
                   1612: def sep_list(L,N)
                   1613: {
                   1614:        if ( length(L) <= N ) return [L,[]];
                   1615:        R = [];
                   1616:        for ( T = L, I = 0; I < N; I++, T = cdr(T) )
                   1617:                R = cons(car(T),R);
                   1618:        return [reverse(R),T];
                   1619: }
                   1620:
                   1621: def first_element(L)
                   1622: {
                   1623:        return L[0];
                   1624: }
                   1625:
                   1626: def comp_tdeg(A,B)
                   1627: {
                   1628:        DA = tdeg(A);
                   1629:        DB = tdeg(B);
                   1630:        if ( DA > DB ) return 1;
                   1631:        else if ( DA < DB ) return -1;
                   1632:        else return 0;
                   1633: }
                   1634:
                   1635: def tdeg(P)
                   1636: {
                   1637:        dp_ord(0);
                   1638:        return dp_td(dp_ptod(P,vars(P)));
                   1639: }
                   1640:
                   1641: def comp_by_ord(A,B)
                   1642: {
                   1643:        if ( dp_ht(A) > dp_ht(B) ) return 1;
                   1644:        else if ( dp_ht(A) < dp_ht(B) ) return -1;
                   1645:        else return 0;
                   1646: }
                   1647:
                   1648: def comp_by_second(A,B)
                   1649: {
                   1650:        if ( A[1] > B[1] ) return 1;
                   1651:        else if ( A[1] < B[1] ) return -1;
                   1652:        else return 0;
                   1653: }
1.7       noro     1654:
                   1655: def gen_gb_comp(A,B,Mod)
                   1656: {
                   1657:        if ( !Mod ) return gb_comp(A,B);
                   1658:        LA = length(A); LB = length(B);
                   1659:        if ( LA != LB ) return 0;
                   1660:        A = qsort(A); B = qsort(B);
                   1661:        if ( A != B ) return 0;
                   1662:        return 1;
                   1663: }
                   1664:
1.1       noro     1665: endmodule$
                   1666: end$

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