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

Annotation of OpenXM/src/asir-contrib/testing/noro/new_pd.rr, Revision 1.6

1.6     ! noro        1: /* $OpenXM: OpenXM/src/asir-contrib/testing/noro/new_pd.rr,v 1.5 2011/06/03 04:51:15 noro Exp $ */
1.1       noro        2: import("gr")$
                      3: module noro_pd$
                      4: static GBCheck,F4,EProcs,Procs,SatHomo,GBRat$
                      5:
1.4       noro        6: localf witness$
                      7: localf get_lc,tomonic,aa,ideal_intersection_m,redbase$
1.1       noro        8: localf para_exec,nd_gr_rat,competitive_exec,call_func$
                      9: localf call_ideal_list_intersection$
1.3       noro       10: localf call_colon,call_prime_dec$
1.1       noro       11: localf first_second$
                     12: localf third$
                     13: localf locsat,iso_comp_para,extract_qj,colon_prime_dec,extract_comp$
                     14: localf separator$
1.4       noro       15: localf member,mingen,compute_gbsyz,redcoef,recompute_trace,dtop,topnum$
1.1       noro       16: localf prepost$
                     17: localf monodec0,monodec,prod$
                     18: localf extract_qd,primary_check$
                     19: localf second$
                     20: localf gbrat,comp_third_tdeg,comp_tord$
                     21: localf power$
                     22:
                     23: localf syci_dec, syc_dec$
                     24: localf syca_dec,syc0_dec$
                     25:
                     26: localf find_si0,find_si1,find_si2$
                     27: localf find_ssi0,find_ssi1,find_ssi2$
                     28:
                     29: localf init_pprocs, init_eprocs, init_procs, kill_procs$
                     30:
                     31: localf sy_dec, pseudo_dec, iso_comp, prima_dec$
                     32:
                     33: localf prime_dec, prime_dec_main, lex_predec1, zprimedec, zprimadec$
                     34: localf complete_qdecomp, partial_qdecomp, partial_qdecomp0, complete_decomp$
                     35: localf partial_decomp, partial_decomp0, zprimacomp, zprimecomp$
                     36: localf fast_gb, incremental_gb, elim_gb, ldim, make_mod_subst$
                     37: localf rsgn, find_npos, gen_minipoly, indepset$
                     38: localf maxindep, contraction, ideal_list_intersection, ideal_intersection$
                     39: localf radical_membership, modular_radical_membership$
                     40: localf radical_membership_rep, ideal_product, saturation$
1.4       noro       41: localf sat, satind, sat_ind, colon, isat$
1.1       noro       42: localf ideal_colon, ideal_sat, ideal_inclusion, qd_simp_comp, qd_remove_redundant_comp$
                     43: localf pd_simp_comp$
                     44: localf pd_remove_redundant_comp, ppart, sq, gen_fctr, gen_nf, gen_gb_comp$
                     45: localf gen_mptop, lcfactor, compute_deg0, compute_deg, member$
                     46: localf elimination, setintersection, setminus, sep_list$
                     47: localf first, comp_tdeg, comp_tdeg_first, tdeg, comp_by_ord, comp_by_second$
                     48: localf gbcheck,f4,sathomo,qd_check,qdb_check$
                     49:
                     50: SatHomo=0$
                     51: GBCheck=1$
                     52: GBRat=0$
                     53:
                     54: #define MAX(a,b) ((a)>(b)?(a):(b))
                     55: #define ACCUM_TIME(C,R) {T1 = time(); C += (T1[0]-T0[0])+(T1[1]-T0[1]); R += (T1[3]-T0[3]); }
                     56:
                     57: def gbrat(A)
                     58: {
                     59:        if ( A ) GBRat = 1;
                     60:        else GBRat = 0;
                     61: }
                     62:
                     63: def gbcheck(A)
                     64: {
                     65:        if ( A ) GBCheck = 1;
                     66:        else GBCheck = -1;
                     67: }
                     68:
                     69: def f4(A)
                     70: {
                     71:        if ( A ) F4 = 1;
                     72:        else F4 = 0;
                     73: }
                     74:
                     75: def sathomo(A)
                     76: {
                     77:        if ( A ) SatHomo = 1;
                     78:        else SatHomo = 0;
                     79: }
                     80:
                     81: def init_eprocs()
                     82: {
                     83:        if ( type(NoX=getopt(nox)) == -1 ) NoX = 0;
                     84:        if ( !EProcs ) {
                     85:                if ( NoX ) {
                     86:                        P0 = ox_launch_nox();
                     87:                        P1 = ox_launch_nox();
                     88:                } else {
                     89:                        P0 = ox_launch();
                     90:                        P1 = ox_launch();
                     91:                }
                     92:                EProcs = [P0,P1];
                     93:        }
                     94: }
                     95:
                     96: def init_pprocs(N)
                     97: {
                     98:        if ( type(NoX=getopt(nox)) == -1 ) NoX = 0;
                     99:        for ( R = [], I = 0; I < N; I++ ) {
                    100:                P = NoX ? ox_launch_nox() : ox_launch();
                    101:                R = cons(P,R);
                    102:        }
                    103:        return reverse(R);
                    104: }
                    105:
                    106: def init_procs()
                    107: {
                    108:        if ( type(NoX=getopt(nox)) == -1 ) NoX = 0;
                    109:        if ( !Procs ) {
                    110:                if ( NoX ) {
                    111:                        P0 = ox_launch_nox();
                    112:                        P1 = ox_launch_nox();
                    113:                } else {
                    114:                        P0 = ox_launch();
                    115:                        P1 = ox_launch();
                    116:                }
                    117:                Procs = [P0,P1];
                    118:        }
                    119: }
                    120:
                    121: def kill_procs()
                    122: {
                    123:        if ( Procs ) {
                    124:                ox_shutdown(Procs[0]);
                    125:                ox_shutdown(Procs[1]);
                    126:                Procs = 0;
                    127:        }
                    128:        if ( EProcs ) {
                    129:                ox_shutdown(EProcs[0]);
                    130:                ox_shutdown(EProcs[1]);
                    131:                EProcs = 0;
                    132:        }
                    133: }
                    134:
                    135: def qd_check(B,V,QD)
                    136: {
                    137:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                    138:        G = nd_gr(B,V,Mod,0);
                    139:        Iso = ideal_list_intersection(map(first,QD[0]),V,0|mod=Mod);
                    140:        Emb = ideal_list_intersection(map(first,QD[1]),V,0|mod=Mod);
                    141:        GG = ideal_intersection(Iso,Emb,V,0|mod=Mod);
                    142:        return gen_gb_comp(G,GG,Mod);
                    143: }
                    144:
                    145: def primary_check(B,V)
                    146: {
                    147:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                    148:        G = nd_gr(B,V,Mod,0);
                    149:        PL = prime_dec(G,V|indep=1,mod=Mod);
                    150:        if ( length(PL) > 1 ) return 0;
                    151:        P = PL[0][0]; Y = PL[0][1];
                    152:        Z = setminus(V,Y);
                    153:        H = elim_gb(G,Z,Y,Mod,[[0,length(Z)],[0,length(Y)]]);
                    154:        H = contraction(H,Z|mod=Mod);
                    155:        H = nd_gr(H,V,Mod,0);
                    156:        if ( gen_gb_comp(G,H,Mod) ) return nd_gr(P,V,Mod,0);
                    157:        else return 0;
                    158: }
                    159:
                    160: def qdb_check(B,V,QD)
                    161: {
                    162:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                    163:        G = nd_gr(B,V,Mod,0);
                    164:        N = length(QD);
                    165:        for ( I = 0, Q = [1]; I < N; I++ )
                    166:                for ( J = 0, QL = map(first,QD[I]), L = length(QL);
                    167:                        J < L; J++ )
                    168:                        Q = ideal_intersection(Q,QL[J],V,0|mod=Mod);
                    169:        if ( !gen_gb_comp(G,Q,Mod) )
                    170:                return 0;
                    171:        for ( I = 0; I < N; I++ ) {
                    172:                T = QD[I];
                    173:                M = length(T);
                    174:                for ( J = 0; J < M; J++ ) {
                    175:                        P = primary_check(T[J][0],V|mod=Mod);
                    176:                        if ( !P ) return 0;
                    177:                        PP = nd_gr(T[J][1],V,Mod,0);
                    178:                        if ( !gen_gb_comp(P,PP,Mod) ) return 0;
                    179:                }
                    180:        }
                    181:        return 1;
                    182: }
                    183:
                    184: def extract_qd(QD,V,Ind)
                    185: {
                    186:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                    187:        N = length(Ind);
                    188:        for ( I = 0, Q = [1]; I < N; I++ )
                    189:                for ( J = 0, QL = map(first,QD[Ind[I]]), L = length(QL);
                    190:                        J < L; J++ )
                    191:                        Q = ideal_intersection(Q,QL[J],V,0|mod=Mod);
                    192:        return Q;
                    193: }
                    194:
                    195: /* SYC primary decomositions */
                    196:
                    197: def syc_dec(B,V)
                    198: {
                    199:        if ( type(SI=getopt(si)) == -1 ) SI = 2;
                    200:        SIFList=[find_ssi0, find_ssi1,find_ssi2];
                    201:        if ( SI<0 || SI>2 ) error("sycb_dec : si should be 0,1,2");
                    202:        SIF = SIFList[SI];
                    203:
                    204:        if ( type(MaxLevel=getopt(level)) == -1 ) MaxLevel = -1;
                    205:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                    206:        if ( type(Lexdec=getopt(lexdec)) == -1 ) Lexdec = 0;
                    207:        if ( type(Time=getopt(time)) == -1 ) Time = 0;
                    208:        if ( type(Iso=getopt(iso)) == -1 ) Iso = 0;
                    209:        if ( type(Colon=getopt(colon)) == -1 ) Colon = 1;
                    210:        Ord = 0;
                    211:        Tall = time();
                    212:        C = Gt = G = fast_gb(B,V,Mod,Ord|trace=1);
                    213:        Q = []; IntQ = [1]; First = 1;
                    214:        Tpd = Tiso = Tsep = 0;
                    215:        RTpd = RTiso = RTsep = 0;
                    216:        for ( Level = 0; MaxLevel < 0 || Level <= MaxLevel; Level++ ) {
                    217:                if ( type(Gt[0])==1 ) break;
                    218: T3 = T2 = T1 = T0 = time();
                    219:                if ( First ) {
                    220:                        PtR = prime_dec(C,V|indep=1,lexdec=Lexdec,mod=Mod,radical=1);
                    221:                        Pt = PtR[0]; IntPt = PtR[1];
                    222:                        if ( gen_gb_comp(Gt,IntPt,Mod) ) {
                    223:                                /* Gt is radical and Gt = cap Pt */
                    224:                                for ( T = Pt, Qt = []; T != []; T = cdr(T) )
                    225:                                        Qt = cons([car(T)[0],car(T)[0]],Qt);
                    226:                                return append(Q,[Qt]);
                    227:                        }
                    228:                }
                    229: T1 = time(); Tpd += (T1[0]-T0[0])+(T1[1]-T0[1]); RTpd += (T1[3]-T0[3]);
                    230:                Qt = iso_comp(Gt,Pt,V,Ord|mod=Mod,first=First,iso=Iso);
                    231:                Q = append(Q,[Qt]);
                    232:                for ( T = Qt; T != []; T = cdr(T) )
                    233:                        IntQ = ideal_intersection(IntQ,car(T)[0],V,Ord
                    234:                                |mod=Mod,
                    235:                                 gbblock=[[0,length(IntQ)],[length(IntQ),length(car(T)[0])]]);
                    236:                if ( First ) { IntP = IntPt; First = 0; }
                    237:                if ( gen_gb_comp(IntQ,G,Mod) ) break;
                    238:
                    239:                M = mingen(IntQ,V);
                    240:                for ( Pt = [], C = [1], T = M; T != []; T = cdr(T) ) {
                    241:                        Ci = colon(G,car(T),V|isgb=1);
                    242:                        if ( type(Ci[0]) != 1 ) {
                    243:                                Pi = prime_dec(Ci,V|indep=1,lexdec=Lexdec,radical=1,mod=Mod);
                    244:                                C = ideal_intersection(C,Pi[1],V,Ord);
                    245:                                Pt = append(Pt,Pi[0]);
                    246:                        }
                    247:                }
                    248:                Pt = pd_simp_comp(Pt,V|first=1,mod=Mod);
                    249:                if ( Colon ) C = ideal_colon(G,IntQ,V|mod=Mod);
                    250: T2 = time(); Tiso += (T2[0]-T1[0])+(T2[1]-T1[1]); RTiso += (T2[3]-T1[3]);
                    251:                Ok = (*SIF)(C,G,IntQ,IntP,V,Ord|mod=Mod);
                    252:                Gt = append(Ok,G);
                    253: T3 = time(); Tsep += (T3[0]-T2[0])+(T3[1]-T2[1]); RTsep += (T3[3]-T2[3]);
                    254:        }
                    255:        T4 = time(); RTall = (T4[3]-Tall[3]); Tall = (T4[0]-Tall[0])+(T3[1]-Tall[1]);
                    256:        if ( Time ) {
                    257:                print(["cpu","total",Tall,"pd",Tpd,"iso",Tiso,"sep",Tsep]);
                    258:                print(["elapsed","total",RTall,"pd",RTpd,"iso",RTiso,"sep",RTsep]);
                    259:        }
                    260:        return Q;
                    261: }
                    262:
                    263: static Tint2, RTint2$
                    264:
                    265: def syci_dec(B,V)
                    266: {
                    267:        if ( type(SI=getopt(si)) == -1 ) SI = 1;
                    268:        if ( SI<0 || SI>2 ) error("sycb_assdec : si should be 0,1,2");
                    269:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                    270:        if ( type(Lexdec=getopt(lexdec)) == -1 ) Lexdec = 0;
                    271:        if ( type(Time=getopt(time)) == -1 ) Time = 0;
                    272:        if ( type(Iso=getopt(iso)) == -1 ) Iso = 0;
                    273:        if ( type(Ass=getopt(ass)) == -1 ) Ass = 0;
                    274:        if ( type(Colon=getopt(colon)) == -1 ) Colon = 0;
                    275:        if ( type(Para=getopt(para)) == -1 ) Para = 0;
                    276:        Ord = 0;
                    277:        Tiso = Tint = Tpd = Text = Tint2 = 0;
                    278:        RTiso = RTint = RTpd = RText = RTint2 = 0;
                    279: T00 = time();
                    280:        G = fast_gb(B,V,Mod,Ord|trace=1);
                    281:        IntQ = [1]; QL = RL = []; First = 1;
                    282:        for ( Level = 0; ; Level++ ) {
                    283: T0 = time();
                    284:                if ( First ) {
                    285:                        PtR = prime_dec(G,V|indep=1,lexdec=Lexdec,mod=Mod,radical=1);
                    286:                        Pt = PtR[0]; IntPt = PtR[1]; Rad = IntPt;
1.2       noro      287:                        if ( gen_gb_comp(G,Rad,Mod) ) {
                    288:                                /* Gt is radical and Gt = cap Pt */
                    289:                                for ( T = Pt, Qt = []; T != []; T = cdr(T) )
                    290:                                        Qt = cons([car(T)[0],car(T)[0],car(T)[1]],Qt);
                    291:                                return [reverse(Qt)];
                    292:                        }
1.1       noro      293:                } else
                    294:                        Pt = colon_prime_dec(G,IntQ,V|lexdec=Lexdec,mod=Mod,para=Para);
                    295: ACCUM_TIME(Tpd,RTpd)
                    296: T0 = time();
                    297:                Rt = iso_comp(G,Pt,V,Ord|mod=Mod,iso=Iso,para=Para,intq=IntQ);
                    298: ACCUM_TIME(Tiso,RTiso)
                    299: T0 = time();
1.4       noro      300:                if ( Iso != 3 ) {
                    301:                        IntQ = ideal_list_intersection(map(first,Rt),V,Ord|mod=Mod,para=Para,isgb=1);
                    302:                        RL = append(RL,[Rt]);
                    303:                } else {
                    304:                        NI = length(Rt);
                    305:                        Q = IntQ;
                    306:                        for ( J = 0, T = []; J < NI; J++ ) {
                    307:                                TJ = extract_qj(Q,V,Rt[J],Rad,Mod,SI,Colon,-1);
                    308:                                T = cons(TJ,T);
                    309:                                IntQ = ideal_intersection_m(IntQ,TJ[0],V,Ord|mod=Mod);
                    310:                        }
                    311:                        print("");
                    312:                        IntQ = nd_gr(IntQ,V,Mod,Ord);
                    313:                        T = reverse(T); RL = append(RL,[T]);
                    314:                }
1.1       noro      315:                QL = append(QL,[IntQ]);
                    316: ACCUM_TIME(Tint,RTint)
                    317:                if ( gen_gb_comp(IntQ,G,Mod) ) break;
                    318:                First = 0;
                    319:        }
                    320: T0 = time();
1.4       noro      321:        if ( Iso != 3 && !Ass )
1.1       noro      322:                RL = extract_comp(QL,RL,V,Rad|mod=Mod,para=Para,si=SI,colon=Colon,ass=Ass);
                    323: ACCUM_TIME(Text,RText)
                    324:        if ( Time ) {
                    325:                T1 = time();
                    326:                Tall = T1[0]-T00[0]+T1[1]-T00[1]; RTall += T1[3]-T00[3];
                    327:                Tass = Tall-Text; RTass = RTall-RText;
                    328:                print(["total",Tall,"ass",Tass,"pd",Tpd,"iso",Tiso,"int",Tint,"ext",Text]);
                    329:                print(["elapsed",RTall,"ass",RTass,"pd",RTpd,"iso",RTiso,"int",RTint,"ext",RText]);
                    330:        }
                    331:        return  RL;
                    332: }
                    333:
                    334: def extract_comp(QL,RL,V,Rad) {
                    335:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                    336:        if ( type(Para=getopt(para)) == -1 ) Para = 0;
                    337:        if ( type(Colon=getopt(colon)) == -1 ) Colon = 0;
                    338:        if ( type(SI=getopt(si)) == -1 ) SI = 1;
                    339:        if ( type(Ass=getopt(ass)) == -1 ) Ass = 0;
                    340:
                    341:        L = length(QL);
                    342:        if ( Para ) {
                    343:                for ( Task = [], I = 1; I < L; I++ ) {
                    344:                        QI = QL[I-1]; RI = RL[I]; NI = length(RI);
                    345:                        for ( J = 0, TI = []; J < NI; J++ ) {
                    346:                                T = ["noro_pd.extract_qj",QI,V,RI[J],Rad,Mod,SI,Colon,I];
                    347:                                Task = cons(T,Task);
                    348:                        }
                    349:                }
                    350:                print("comps:",2); print(length(Task),2); print("");
                    351:                R = para_exec(Para,Task);
                    352:                S = vector(L);
                    353:                for ( I = 1; I < L; I++ ) S[I] = [];
                    354:                S[0] = RL[0];
                    355:                for ( T = R; T != []; T = cdr(T) ) {
                    356:                        U = car(T); Level = U[0]; Body = U[1];
                    357:                        S[Level] = cons(Body,S[Level]);
                    358:                }
                    359:                return vtol(S);
                    360:        } else {
                    361:                TL = [RL[0]];
                    362:                for ( I = 1; I < L; I++ ) {
                    363:                        print("level:",2); print(I,2);
                    364:                        print(" comps:",2); print(length(RL[I]),2); print("");
                    365:                        QI = QL[I-1]; RI = RL[I]; NI = length(RI);
                    366:                        for ( J = 0, TI = []; J < NI; J++ ) {
                    367:                                TIJ = extract_qj(QI,V,RI[J],Rad,Mod,SI,Colon,-1);
                    368:                                TI = cons(TIJ,TI);
                    369:                        }
                    370:                        TI = reverse(TI); TL = cons(TI,TL);
                    371:                }
                    372:                TL = reverse(TL);
                    373:        }
                    374:        return TL;
                    375: }
                    376:
                    377: def colon_prime_dec(G,IntQ,V) {
                    378:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                    379:        if ( type(Lexdec=getopt(lexdec)) == -1 ) Lexdec = 0;
                    380:        if ( type(Para=getopt(para)) == -1 ) Para = 0;
1.3       noro      381:        if ( !Para ) {
                    382:                print("colon_pd:",2); print(length(IntQ),2);
                    383:        }
1.1       noro      384:        if ( !Mod ) M = mingen(IntQ,V);
                    385:        else M = IntQ;
                    386:        if ( Para ) {
                    387:                L = length(M);
1.3       noro      388:                for ( Task = [], J = 0; J < L; J++ )
1.1       noro      389:                        if ( gen_nf(M[J],G,V,Ord,Mod) ) {
1.3       noro      390:                                T = ["noro_pd.call_colon",G,M[J],V,Mod,1];
1.1       noro      391:                                Task = cons(T,Task);
                    392:                        }
                    393:                Task = reverse(Task);
                    394:                R = para_exec(Para,Task);
1.3       noro      395:                R = pd_simp_comp(R,V|mod=Mod); L = length(R);
                    396:
                    397:                for ( Task = [], J = 0; J < L; J++ ) {
                    398:                        T = ["noro_pd.call_prime_dec",R[J],V,1,Lexdec,Mod];
                    399:                        Task = cons(T,Task);
                    400:                }
                    401:                Task = reverse(Task);
                    402:                R = para_exec(Para,Task);
                    403:
1.1       noro      404:                for ( Pt = [], T = R; T != []; T = cdr(T) ) Pt = append(Pt,car(T));
                    405:        } else {
1.3       noro      406:                for ( R = [], T = M; T != []; T = cdr(T) ) {
                    407:                        Ci = colon(G,car(T),V|isgb=1,mod=Mod);
                    408:                        R = cons(Ci,R);
                    409:                }
                    410:                print("->",2); print(length(M),2);
                    411:                R = pd_simp_comp(R,V|mod=Mod);
                    412:                print("->",2); print(length(R));
                    413:                for ( Pt = [], T = R; T != []; T = cdr(T) ) {
                    414:                        Pi = prime_dec(car(T),V|indep=1,lexdec=Lexdec,mod=Mod);
1.1       noro      415:                        Pt = append(Pt,Pi);
                    416:                }
                    417:        }
                    418:        Pt = pd_simp_comp(Pt,V|first=1,mod=Mod);
                    419:        return Pt;
                    420: }
                    421:
1.3       noro      422: def call_colon(G,F,V,Mod,IsGB)
                    423: {
                    424:        return colon(G,F,V|isgb=1,mod=Mod);
                    425: }
                    426:
                    427: def call_prime_dec(G,V,Indep,Lexdec,Mod)
1.1       noro      428: {
1.3       noro      429:        if ( type(G[0]) != 1 )
                    430:                Pi = prime_dec(G,V|indep=Indep,lexdec=Lexdec,mod=Mod);
1.1       noro      431:        else
                    432:                Pi = [];
                    433:        return Pi;
                    434: }
                    435:
                    436: def extract_qj(Q,V,QL,Rad,Mod,SI,Colon,Level)
                    437: {
                    438:        SIFList=[find_ssi0, find_ssi1,find_ssi2];
                    439:        SIF = SIFList[SI];
                    440:        G = QL[0]; P = QL[1]; PV = QL[2];
1.4       noro      441:        if ( Q != [1] ) {
                    442:                C = Colon ? ideal_colon(G,Q,V|mod=Mod) : P;
                    443:                Ok = (*SIF)(C,G,Q,Rad,V,0|mod=Mod);
                    444:        } else
                    445:                Ok = [];
1.1       noro      446:        V0 = setminus(V,PV);
                    447:        HJ = elim_gb(append(Ok,G),V0,PV,Mod,[[0,length(V0)],[0,length(PV)]]);
                    448:        HJ = contraction(HJ,V0|mod=Mod);
                    449:        IJ = nd_gr(HJ,V,Mod,Ord);
                    450:        return Level >= 0 ? [Level,[IJ,P]] : [IJ,P];
                    451: }
                    452:
                    453: def syca_dec(B,V)
                    454: {
                    455: T00 = time();
                    456:        if ( type(SI=getopt(si)) == -1 ) SI = 2;
                    457:        SIFList=[find_si0, find_si1,find_si2]; SIF = SIFList[SI];
                    458:        if ( !SIF ) error("syca_dec : si should be 0,1,2");
                    459:
                    460:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                    461:        if ( type(Lexdec=getopt(lexdec)) == -1 ) Lexdec = 0;
                    462:        if ( type(NoSimp=getopt(nosimp)) == -1 ) NoSimp = 0;
                    463:        if ( type(Time=getopt(time)) == -1 ) Time = 0;
                    464:        if ( type(Iso=getopt(iso)) == -1 ) Iso = 0;
                    465:        Ord = 0;
                    466:        Gt = G0 = G = fast_gb(B,V,Mod,Ord|trace=1);
                    467:        Q0 = Q = []; IntQ0 = IntQ = [1]; First = 1;
                    468:        C = 0;
                    469:
                    470:        Tass = Tiso = Tcolon = Tsep = Tirred = 0;
                    471:        Rass = Riso = Rcolon = Rsep = Rirred = 0;
                    472:        while ( 1 ) {
                    473:                if ( type(Gt[0])==1 ) break;
                    474:                T0 = time();
                    475:                PtR = prime_dec(Gt,V|indep=1,lexdec=Lexdec,mod=Mod,radical=1);
                    476:                T1 = time(); Tass += T1[0]-T0[0]+T1[1]-T0[1]; Rass += T1[3]-T0[3];
                    477:                Pt = PtR[0]; IntPt = PtR[1];
                    478:                if ( gen_gb_comp(Gt,IntPt,Mod) ) {
                    479:                        /* Gt is radical and Gt = cap Pt */
                    480:                        for ( T = Pt, Qt = []; T != []; T = cdr(T) )
                    481:                                Qt = cons([car(T)[0],car(T)[0]],Qt);
                    482:                        if ( First )
                    483:                                return [Qt,[]];
                    484:                        else
                    485:                                Q0 = append(Qt,Q0);
                    486:                        break;
                    487:                }
                    488:                T0 = time();
                    489:                Qt = iso_comp(Gt,Pt,V,Ord|mod=Mod,isgb=1,iso=Iso);
                    490:                T1 = time(); Tiso += T1[0]-T0[0]+T1[1]-T0[1]; Riso += T1[3]-T0[3];
                    491:                IntQt = ideal_list_intersection(map(first,Qt),V,Ord|mod=Mod);
                    492:                if ( First ) {
                    493:                        IntQ0 = IntQ = IntQt; IntP = IntPt; Qi = Qt; First = 0;
                    494:                } else {
                    495:                        IntQ1 = ideal_intersection(IntQ,IntQt,V,Ord|mod=Mod);
                    496:                        if ( gen_gb_comp(IntQ,IntQ1,Mod) ) {
                    497:                                G = Gt; IntP = IntPt; Q = []; IntQ = [1]; C = 0;
                    498:                                continue;
                    499:                        } else {
                    500:                                IntQ = IntQ1;
                    501:                                IntQ1 = ideal_intersection(IntQ0,IntQt,V,Ord|mod=Mod);
                    502:                                if ( !gen_gb_comp(IntQ0,IntQ1,Mod) ) {
                    503:                                        Q = append(Qt,Q);
                    504:                                        for ( T = Qt; T != []; T = cdr(T) )
                    505:                                                if ( !ideal_inclusion(IntQ0,car(T)[0],V,Ord|mod=Mod) )
                    506:                                                        Q0 = append(Q0,[car(T)]);
                    507:                                        IntQ0 = IntQ1;
                    508:                                }
                    509:                        }
                    510:                }
                    511:                if ( gen_gb_comp(IntQt,Gt,Mod) || gen_gb_comp(IntQ,G,Mod) || gen_gb_comp(IntQ0,G0,Mod) ) break;
                    512:                T0 = time();
                    513:                C1 = ideal_colon(G,IntQ,V|mod=Mod);
                    514:                T1 = time(); Tcolon += T1[0]-T0[0]+T1[1]-T0[1]; Rcolon += T1[3]-T0[3];
                    515:                if ( C && gen_gb_comp(C,C1,Mod) ) {
                    516:                        G = Gt; IntP = IntPt; Q = []; IntQ = [1]; C = 0;
                    517:                        continue;
                    518:                } else C = C1;
                    519:                T0 = time();
                    520:                Ok = (*SIF)(C,G,IntQ,IntP,V,Ord|mod=Mod);
                    521:                G1 = append(Ok,G);
                    522:                Gt1 = incremental_gb(G1,V,Ord|mod=Mod);
                    523:                T1 = time(); Tsep += T1[0]-T0[0]+T1[1]-T0[1]; Rsep += T1[3]-T0[3];
                    524:                Gt = Gt1;
                    525:        }
                    526:        T0 = time();
                    527:        if ( !NoSimp ) Q1 = qd_remove_redundant_comp(G0,Qi,Q0,V,Ord|mod=Mod);
                    528:        else Q1 = Q0;
                    529:        if ( Time ) {
                    530:                T1 = time(); Tirred += T1[0]-T0[0]+T1[1]-T0[1]; Rirred += T1[3]-T0[3];
                    531:                Tall = T1[0]-T00[0]+T1[1]-T00[1]; Rall += T1[3]-T00[3];
                    532:                print(["total",Tall,"ass",Tass,"iso",Tiso, "colon",Tcolon,"sep",Tsep,"irred",Tirred]);
                    533:                print(["Rtotal",Rall,"Rass",Rass,"Riso",Riso, "Rcolon",Rcolon,"Rsep",Rsep,"Rirred",Rirred]);
                    534:                print(["iso",length(Qi),"emb",length(Q0),"->",length(Q1)]);
                    535:        }
                    536:        return [Qi,Q1];
                    537: }
                    538:
                    539: def syc0_dec(B,V)
                    540: {
                    541: T00 = time();
                    542:        if ( type(SI=getopt(si)) == -1 ) SI = 1;
                    543:        SIFList=[find_si0, find_si1,find_si2,find_ssi0,find_ssi1,find_ssi2]; SIF = SIFList[SI];
                    544:        if ( !SIF ) error("syc0_dec : si should be 0,1,2");
                    545:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                    546:        if ( type(Lexdec=getopt(lexdec)) == -1 ) Lexdec = 0;
                    547:        if ( type(NoSimp=getopt(nosimp)) == -1 ) NoSimp = 0;
                    548:        if ( type(Time=getopt(time)) == -1 ) Time = 0;
                    549:        Ord = 0;
                    550:        G = fast_gb(B,V,Mod,Ord);
                    551:        Q = []; IntQ = [1]; Gt = G; First = 1;
                    552:        Tass = Tiso = Tcolon = Tsep = Tirred = 0;
                    553:        Rass = Riso = Rcolon = Rsep = Rirred = 0;
                    554:        while ( 1 ) {
                    555:                if ( type(Gt[0])==1 ) break;
                    556:                T0 = time();
                    557:                PtR = prime_dec(Gt,V|indep=1,lexdec=Lexdec,mod=Mod,radical=1);
                    558:                T1 = time(); Tass += T1[0]-T0[0]+T1[1]-T0[1]; Rass += T1[3]-T0[3];
                    559:                Pt = PtR[0]; IntPt = PtR[1];
                    560:                if ( gen_gb_comp(Gt,IntPt,Mod) ) {
                    561:                        /* Gt is radical and Gt = cap Pt */
                    562:                        for ( T = Pt, Qt = []; T != []; T = cdr(T) )
                    563:                                Qt = cons([car(T)[0],car(T)[0]],Qt);
                    564:                        if ( First )
                    565:                                return [Qt,[]];
                    566:                        else
                    567:                                Q = append(Qt,Q);
                    568:                        break;
                    569:                }
                    570:
                    571:                T0 = time();
                    572:                Qt = iso_comp(Gt,Pt,V,Ord|mod=Mod,isgb=1);
                    573:                T1 = time(); Tiso += T1[0]-T0[0]+T1[1]-T0[1]; Riso += T1[3]-T0[3];
                    574:                IntQt = ideal_list_intersection(map(first,Qt),V,Ord|mod=Mod);
                    575:                if ( First ) {
                    576:                        IntQ = IntQt; Qi = Qt; First = 0;
                    577:                } else {
                    578:                        IntQ1 = ideal_intersection(IntQ,IntQt,V,Ord|mod=Mod);
                    579:                        if ( !gen_gb_comp(IntQ1,IntQ,Mod) )
                    580:                                Q = append(Qt,Q);
                    581:                }
                    582:                if ( gen_gb_comp(IntQ,G,Mod) || gen_gb_comp(IntQt,Gt,Mod) )
                    583:                        break;
                    584:                T0 = time();
                    585:                C = ideal_colon(Gt,IntQt,V|mod=Mod);
                    586:                T1 = time(); Tcolon += T1[0]-T0[0]+T1[1]-T0[1]; Rcolon += T1[3]-T0[3];
                    587:                T0 = time();
                    588:                Ok = (*SIF)(C,Gt,IntQt,IntPt,V,Ord|mod=Mod);
                    589:                G1 = append(Ok,Gt);
                    590:                Gt = incremental_gb(G1,V,Ord|mod=Mod);
                    591:                T1 = time(); Tsep += T1[0]-T0[0]+T1[1]-T0[1]; Rsep += T1[3]-T0[3];
                    592:        }
                    593:        T0 = time();
                    594:        if ( !NoSimp ) Q1 = qd_remove_redundant_comp(G,Qi,Q,V,Ord|mod=Mod);
                    595:        else Q1 = Q;
                    596:        T1 = time(); Tirred += T1[0]-T0[0]+T1[1]-T0[1]; Rirred += T1[3]-T0[3];
                    597:        Tall = T1[0]-T00[0]+T1[1]-T00[1]; Rall += T1[3]-T00[3];
                    598:        if ( Time ) {
                    599:                print(["total",Tall,"ass",Tass,"iso",Tiso, "colon",Tcolon,"sep",Tsep,"irred",Tirred]);
                    600:                print(["Rtotal",Rall,"Rass",Rass,"Riso",Riso, "Rcolon",Rcolon,"Rsep",Rsep,"Rirred",Rirred]);
                    601:                print(["iso",length(Qi),"emb",length(Q),"->",length(Q1)]);
                    602:        }
                    603:        return [Qi,Q1];
                    604: }
                    605:
                    606: def power(A,I) { return A^I; }
                    607:
                    608:
                    609: /* functions for computating a separing ideal  */
                    610: /* C=G:Q, Rad=rad(Q), return J s.t. Q cap (G+J) = G */
                    611:
                    612: def find_si0(C,G,Q,Rad,V,Ord) {
                    613:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                    614:        for ( CI = C, I = 1; ; I++ ) {
                    615:                for ( T = CI, S = []; T != []; T = cdr(T) )
                    616:                        if ( gen_nf(car(T),Q,V,Ord,Mod) ) S = cons(car(T),S);
                    617:                if ( S == [] )
                    618:                        error("find_si0 : cannot happen");
                    619:                G1 = append(S,G);
                    620:                Int = ideal_intersection(G1,Q,V,Ord|mod=Mod);
                    621:                /* check whether (Q cap (G+S)) = G */
                    622:                if ( gen_gb_comp(Int,G,Mod) ) { print([0]); return reverse(S); }
                    623:                CI = ideal_product(CI,C,V|mod=Mod);
                    624:        }
                    625: }
                    626:
                    627: def find_si1(C,G,Q,Rad,V,Ord) {
                    628:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                    629:        for ( T = C, S = []; T != []; T = cdr(T) )
                    630:                if ( gen_nf(car(T),Q,V,Ord,Mod) ) S = cons(car(T),S);
                    631:        if ( S == [] )
                    632:                error("find_si1 : cannot happen");
                    633:        G1 = append(S,G);
                    634:        Int = ideal_intersection(G1,Q,V,Ord|mod=Mod);
                    635:        /* check whether (Q cap (G+S)) = G */
                    636:        if ( gen_gb_comp(Int,G,Mod) ) { print([0]); return reverse(S); }
                    637:
                    638:        C = qsort(C,comp_tdeg);
                    639:
                    640:        Tmp = ttttt; TV = cons(Tmp,V); Ord1 = [[0,1],[Ord,length(V)]];
                    641:        Int0 = incremental_gb(append(vtol(ltov(G)*Tmp),vtol(ltov(Q)*(1-Tmp))),
                    642:                TV,Ord1|gbblock=[[0,length(G)]],mod=Mod);
                    643:        Dp = dp_gr_print(); dp_gr_print(0);
                    644:        for ( T = C, S = []; T != []; T = cdr(T) ) {
                    645:                if ( !gen_nf(car(T),Rad,V,Ord,Mod) ) continue;
                    646:                Ui = U = car(T);
                    647:                for ( I = 1; ; I++ ) {
                    648:                        G1 = cons(Ui,G);
                    649:                        Int = ideal_intersection(G1,Q,V,Ord|mod=Mod);
                    650:                        if ( gen_gb_comp(Int,G,Mod) ) break;
                    651:                        else
                    652:                                Ui = gen_nf(Ui*U,G,V,Ord,Mod);
                    653:                }
                    654:                print([length(T),I],2);
                    655:                Int1 = incremental_gb(append(Int0,[Tmp*Ui]),TV,Ord1
                    656:                        |gbblock=[[0,length(Int0)]],mod=Mod);
                    657:                Int = elimination(Int1,V);
                    658:                if ( !gen_gb_comp(Int,G,Mod) ) {
                    659:                        break;
                    660:                } else {
                    661:                        Int0 = Int1;
                    662:                        S = cons(Ui,S);
                    663:                }
                    664:        }
                    665:        print("");
                    666:        dp_gr_print(Dp);
                    667:        return reverse(S);
                    668: }
                    669:
                    670: def find_si2(C,G,Q,Rad,V,Ord) {
                    671:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                    672:        for ( T = C, S = []; T != []; T = cdr(T) )
                    673:                if ( gen_nf(car(T),Q,V,Ord,Mod) ) S = cons(car(T),S);
                    674:        if ( S == [] )
                    675:                error("find_si2 : cannot happen");
                    676:        G1 = append(S,G);
                    677:        Int = ideal_intersection(G1,Q,V,Ord|mod=Mod);
                    678:        /* check whether (Q cap (G+S)) = G */
                    679:        if ( gen_gb_comp(Int,G,Mod) ) { print([0]); return reverse(S); }
                    680:
                    681:        C = qsort(C,comp_tdeg);
                    682:
                    683:        Dp = dp_gr_print(); dp_gr_print(0);
                    684:        Tmp = ttttt; TV = cons(Tmp,V); Ord1 = [[0,1],[Ord,length(V)]];
                    685:        Int0 = incremental_gb(append(vtol(ltov(G)*Tmp),vtol(ltov(Q)*(1-Tmp))),
                    686:                TV,Ord1|gbblock=[[0,length(G)]],mod=Mod);
                    687:        for ( T = C, S = []; T != []; T = cdr(T) ) {
                    688:                if ( !gen_nf(car(T),Rad,V,Ord,Mod) ) continue;
                    689:                Ui = U = car(T);
                    690:                for ( I = 1; ; I++ ) {
                    691:                        Int1 = incremental_gb(append(Int0,[Tmp*Ui]),TV,Ord1
                    692:                                        |gbblock=[[0,length(Int0)]],mod=Mod);
                    693:                        Int = elimination(Int1,V);
                    694:                        if ( gen_gb_comp(Int,G,Mod) ) break;
                    695:                        else
                    696:                                Ui = gen_nf(Ui*U,G,V,Ord,Mod);
                    697:                }
                    698:                print([length(T),I],2);
                    699:                S = cons(Ui,S);
                    700:        }
                    701:        S = qsort(S,comp_tdeg);
                    702:        print("");
                    703:        End = Len = length(S);
                    704:
                    705:        Tmp = ttttt; TV = cons(Tmp,V); Ord1 = [[0,1],[Ord,length(V)]];
                    706:        Prev = 1;
                    707:        G1 = append(G,[S[0]]);
                    708:        Int0 = incremental_gb(append(vtol(ltov(G1)*Tmp),vtol(ltov(Q)*(1-Tmp))),
                    709:                TV,Ord1|gbblock=[[0,length(G)]],mod=Mod);
                    710:        if ( End > 1 ) {
                    711:                Cur = 2;
                    712:                while ( Prev < Cur ) {
                    713:                        for ( St = [], I = Prev; I < Cur; I++ ) St = cons(Tmp*S[I],St);
                    714:                        Int1 = incremental_gb(append(Int0,St),TV,Ord1
                    715:                                |gbblock=[[0,length(Int0)]],mod=Mod);
                    716:                        Int = elimination(Int1,V);
                    717:                        if ( gen_gb_comp(Int,G,Mod) ) {
                    718:                                print([Cur],2);
                    719:                                Prev = Cur;
                    720:                                Cur = Cur+idiv(End-Cur+1,2);
                    721:                                Int0 = Int1;
                    722:                        } else {
                    723:                                End = Cur;
                    724:                                Cur = Prev + idiv(Cur-Prev,2);
                    725:                        }
                    726:                }
                    727:                for ( St = [], I = 0; I < Prev; I++ ) St = cons(S[I],St);
                    728:        } else
                    729:                St = [S[0]];
                    730:        print("");
                    731:        for ( I = Prev; I < Len; I++ ) {
                    732:                Int1 = incremental_gb(append(Int0,[Tmp*S[I]]),TV,Ord1
                    733:                        |gbblock=[[0,length(Int0)]],mod=Mod);
                    734:                Int = elimination(Int1,V);
                    735:                if ( gen_gb_comp(Int,G,Mod) ) {
                    736:                        print([I],2);
                    737:                        St = cons(S[I],St);
                    738:                        Int0 = Int1;
                    739:                }
                    740:        }
                    741:        Ok = reverse(St);
                    742:        print("");
                    743:        print([length(S),length(Ok)]);
                    744:        dp_gr_print(Dp);
                    745:        return Ok;
                    746: }
                    747:
                    748: /* functions for computing a saturated separating ideal */
                    749:
                    750: def find_ssi0(C,G,Q,Rad,V,Ord) {
                    751:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                    752:        if ( type(Reduce=getopt(red)) == -1 ) Reduce = 0;
                    753:        for ( T = C, S = []; T != []; T = cdr(T) )
                    754:                if ( gen_nf(car(T),Q,V,Ord,Mod) ) S = cons(car(T),S);
                    755:        if ( S == [] )
                    756:                error("find_ssi0 : cannot happen");
                    757:        G1 = append(S,G);
                    758:        Int = ideal_intersection(G1,Q,V,Ord|mod=Mod);
                    759:        /* check whether (Q cap (G+S)) = G */
                    760:        if ( gen_gb_comp(Int,G,Mod) ) { print([0]); return reverse(S); }
                    761:
                    762:        if ( Reduce ) {
                    763:                for ( T = C, U = []; T != []; T = cdr(T) )
                    764:                        if ( gen_nf(car(T),Rad,V,Ord,Mod) ) U = cons(car(T),U);
                    765:                U = reverse(U);
                    766:        } else
                    767:                U = C;
                    768:
                    769:        for ( I = 1; ; I++ ) {
                    770:                print([I],2);
                    771:                S = map(power,U,I);
                    772:                G1 = append(S,G);
                    773:                Int = ideal_intersection(G1,Q,V,Ord|mod=Mod);
                    774:                /* check whether (Q cap (G+S)) = G */
                    775:                if ( gen_gb_comp(Int,G,Mod) ) { print(""); return reverse(S); }
                    776:        }
                    777: }
                    778:
                    779: def find_ssi1(C,G,Q,Rad,V,Ord) {
                    780:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                    781:        if ( type(Reduce=getopt(red)) == -1 ) Reduce = 0;
                    782:        for ( T = C, S = []; T != []; T = cdr(T) )
                    783:                if ( gen_nf(car(T),Q,V,Ord,Mod) ) S = cons(car(T),S);
                    784:        if ( S == [] )
                    785:                error("find_ssi1 : cannot happen");
                    786:        G1 = append(S,G);
                    787:        Int = ideal_intersection(G1,Q,V,Ord|mod=Mod);
                    788:        /* check whether (Q cap (G+S)) = G */
                    789:        if ( gen_gb_comp(Int,G,Mod) ) { print([0]); return reverse(S); }
                    790:
                    791:        dp_ord(Ord); DC = map(dp_ptod,C,V);
                    792:        DC = qsort(DC,comp_tord); C = map(dp_dtop,DC,V);
                    793:        print(length(C),2);
                    794:        if ( Reduce ) {
                    795:                SC = map(sq,C,Mod);
                    796:                SC = reverse(SC); C = reverse(C);
                    797:                for ( T = C, C1 = [],  R1 = append(SC,Rad); T != []; T = cdr(T) ) {
                    798:                        R0 = car(R1); R1 = cdr(R1);
                    799:                        if ( !gen_nf(car(T),Rad,V,Ord,Mod) ) continue;
                    800:                        if ( radical_membership(R0,R1,V|mod=Mod)  ) {
                    801:                                C1 = cons(car(T),C1);
                    802:                                R1 = append(R1,[R0]);
                    803:                        }
                    804:                }
                    805:                print("->",0); print(length(C1),2);
                    806:                C = C1;
                    807:        }
                    808:        print(" ",2);
                    809:
                    810:        Tmp = ttttt; TV = cons(Tmp,V); Ord1 = [[0,1],[Ord,length(V)]];
                    811:        Int0 = incremental_gb(append(vtol(ltov(G)*Tmp),vtol(ltov(Q)*(1-Tmp))),
                    812:                TV,Ord1|gbblock=[[0,length(G)]],mod=Mod);
                    813:        Dp = dp_gr_print(); dp_gr_print(0);
                    814:        for ( J = 0, T = C, S = [], GS = G; T != []; T = cdr(T), J++ ) {
                    815:                if ( !gen_nf(car(T),Rad,V,Ord,Mod) ) continue;
                    816:                Ui = U = car(T);
                    817:                for ( I = 1; ; I++ ) {
                    818:                        Int1 = nd_gr(append(Int0,[Tmp*Ui]),TV,Mod,Ord1
                    819:                                |gbblock=[[0,length(Int0)]],newelim=1);
                    820:                        if ( Int1 ) {
                    821:                                Int = elimination(Int1,V);
                    822:                                if ( gen_gb_comp(Int,G,Mod) ) break;
                    823:                        }
                    824:                        print("x",2);
                    825:                        Ui = gen_nf(Ui*U,G,V,Ord,Mod);
                    826:                }
                    827:                print(J,2);
                    828:                Int0 = Int1;
                    829:                S = cons(Ui,S);
                    830:        }
                    831:        print("");
                    832:        dp_gr_print(Dp);
                    833:        return reverse(S);
                    834: }
                    835:
                    836: def find_ssi2(C,G,Q,Rad,V,Ord) {
                    837:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                    838:        if ( type(Reduce=getopt(red)) == -1 ) Reduce = 0;
                    839:        for ( T = C, S = []; T != []; T = cdr(T) )
                    840:                if ( gen_nf(car(T),Q,V,Ord,Mod) ) S = cons(car(T),S);
                    841:        if ( S == [] )
                    842:                error("find_ssi2 : cannot happen");
                    843:        G1 = append(S,G);
                    844:        Int = ideal_intersection(G1,Q,V,Ord|mod=Mod);
                    845:        /* check whether (Q cap (G+S)) = G */
                    846:        if ( gen_gb_comp(Int,G,Mod) ) { print([0]); return reverse(S); }
                    847:
                    848: #if 0
                    849:        dp_ord(Ord); DC = map(dp_ptod,C,V);
                    850:        DC = qsort(DC,comp_tord); C = map(dp_dtop,DC,V);
                    851: #else
                    852:        C = qsort(C,comp_tdeg);
                    853: #endif
                    854:        if ( Reduce ) {
                    855:                for ( T = C, C1 = [], R1 = Rad; T != []; T = cdr(T) ) {
                    856:                        if ( !gen_nf(car(T),Rad,V,Ord,Mod) ) continue;
1.4       noro      857:                        if ( radical_membership(car(T),R1,V|mod=Mod)  ) {
1.1       noro      858:                                C1 = cons(car(T),C1);
                    859:                                R1 = cons(sq(car(T),Mod),R1);
                    860:                        }
                    861:                }
                    862:                print(["C",length(C),"->",length(C1)]);
                    863:                C = reverse(C1);
                    864:        }
                    865:        for ( T = C, S = []; T != []; T = cdr(T) ) {
                    866:                if ( !gen_nf(car(T),Rad,V,Ord,Mod) ) continue;
                    867:                Ui = U = car(T);
                    868:                S = cons([Ui,U],S);
                    869:        }
                    870:        S = qsort(S,comp_tdeg_first);
                    871:        print("");
                    872:
                    873:        Dp = dp_gr_print(); dp_gr_print(0);
                    874:        Tmp = ttttt; TV = cons(Tmp,V); Ord1 = [[0,1],[Ord,length(V)]];
                    875:        Int0 = incremental_gb(append(vtol(ltov(G)*Tmp),vtol(ltov(Q)*(1-Tmp))),
                    876:                TV,Ord1|gbblock=[[0,length(G)]],mod=Mod);
                    877:        OK = [];
                    878:        while ( S != [] ) {
                    879:                Len = length(S); print("remaining gens : ",0); print(Len);
                    880:                S1 = [];
                    881:                for ( Start = Prev = 0; Start < Len; Start = Prev ) {
                    882:                        Cur = Start+1;
                    883:                        print(Start,2);
                    884:                        while ( Prev < Len ) {
                    885:                                for ( St = [], I = Prev; I < Cur; I++ ) St = cons(Tmp*S[I][0],St);
                    886:                                Int1 = nd_gr(append(Int0,St),TV,Mod,Ord1|gbblock=[[0,length(Int0)]],newelim=1);
                    887:                                if ( !Int1 ) {
                    888:                                        print("x",0); break;
                    889:                                }
                    890:                                Int = elimination(Int1,V);
                    891:                                if ( gen_gb_comp(Int,G,Mod) ) {
                    892:                                        print([Prev,Cur-1],2);
                    893:                                        Prev = Cur;
                    894:                                        Cur += (Prev-Start)+1;
                    895:                                        if ( Cur > Len ) Cur = Len;
                    896:                                        Int0 = Int1;
                    897:                                } else
                    898:                                        break;
                    899:                        }
                    900:                        for ( I = Start; I < Prev; I++ ) OK = cons(S[I][0],OK);
                    901:                        if ( Prev == Start ) {
                    902:                                Ui = S[I][0]; U = S[I][1];
                    903:                                Ui = gen_nf(Ui*U,G,V,Ord,Mod);
                    904:                                S1 = cons([Ui,U],S1);
                    905:                                Prev++;
                    906:                        }
                    907:                }
                    908:                S = reverse(S1);
                    909:                print("");
                    910:        }
                    911:        print("");
                    912:        OK = reverse(OK);
                    913:        dp_gr_print(Dp);
                    914:        return OK;
                    915: }
                    916:
                    917: /* SY primary decompsition */
                    918:
                    919: def sy_dec(B,V)
                    920: {
                    921:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                    922:        if ( type(Lexdec=getopt(lexdec)) == -1 ) Lexdec = 0;
                    923:        Ord = 0;
                    924:        G = fast_gb(B,V,Mod,Ord);
                    925:        Q = [];
                    926:        IntQ = [1];
                    927:        Gt = G;
                    928:        First = 1;
                    929:        while ( 1 ) {
                    930:                if ( type(Gt[0]) == 1 ) break;
                    931:                Pt = prime_dec(Gt,V|indep=1,lexdec=Lexdec,mod=Mod);
                    932:                L = pseudo_dec(Gt,Pt,V,Ord|mod=Mod);
                    933:                Qt = L[0]; Rt = L[1]; St = L[2];
                    934:                IntQt = ideal_list_intersection(map(first,Qt),V,Ord|mod=Mod);
                    935:                if ( First ) {
                    936:                        IntQ = IntQt;
                    937:                        Qi = Qt;
                    938:                        First = 0;
                    939:                } else {
                    940:                        IntQ = ideal_intersection(IntQ,IntQt,V,Ord|mod=Mod);
                    941:                        Q = append(Qt,Q);
                    942:                }
                    943:                if ( gen_gb_comp(IntQ,G,Mod) ) break;
                    944:                for ( T = Rt; T != []; T = cdr(T) ) {
                    945:                        if ( type(car(T)[0]) == 1 ) continue;
                    946:                        U = sy_dec(car(T),V|lexdec=Lexdec,mod=Mod);
                    947:                        IntQ = ideal_list_intersection(cons(IntQ,map(first,U)),
                    948:                                V,Ord|mod=Mod);
                    949:                        Q = append(U,Q);
                    950:                        if ( gen_gb_comp(IntQ,G,Mod) ) break;
                    951:                }
                    952:                Gt = fast_gb(append(Gt,St),V,Mod,Ord);
                    953:        }
                    954:        Q = qd_remove_redundant_comp(G,Qi,Q,V,Ord|mod=Mod);
                    955:        return append(Qi,Q);
                    956: }
                    957:
                    958: def pseudo_dec(G,L,V,Ord)
                    959: {
                    960:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                    961:        N = length(L);
                    962:        S = vector(N);
                    963:        Q = vector(N);
                    964:        R = vector(N);
                    965:        L0 = map(first,L);
                    966:        for ( I = 0; I < N; I++ ) {
                    967:                LI = setminus(L0,[L0[I]]);
                    968:                PI = ideal_list_intersection(LI,V,Ord|mod=Mod);
                    969:                PI = qsort(PI,comp_tdeg);
                    970:                for ( T = PI; T != []; T = cdr(T) )
                    971:                        if ( gen_nf(car(T),L0[I],V,Ord,Mod) ) break;
                    972:                if ( T == [] ) error("separator : cannot happen");
                    973:                SI = satind(G,car(T),V|mod=Mod);
                    974:                QI = SI[0];
                    975:                S[I] = car(T)^SI[1];
                    976:                PV = L[I][1];
                    977:                V0 = setminus(V,PV);
                    978: #if 0
                    979:                GI = fast_gb(QI,append(V0,PV),Mod,
                    980:                        [[Ord,length(V0)],[Ord,length(PV)]]);
                    981: #else
                    982:                GI = fast_gb(QI,append(V0,PV),Mod,
                    983:                        [[2,length(V0)],[Ord,length(PV)]]);
                    984: #endif
                    985:                LCFI = lcfactor(GI,V0,Ord,Mod);
                    986:                for ( F = 1, T = LCFI, Gt = QI; T != []; T = cdr(T) ) {
                    987:                        St = satind(Gt,T[0],V|mod=Mod);
                    988:                        Gt = St[0]; F *= T[0]^St[1];
                    989:                }
                    990:                Q[I] = [Gt,L0[I]];
                    991:                R[I] = fast_gb(cons(F,QI),V,Mod,Ord);
                    992:        }
                    993:        return [vtol(Q),vtol(R),vtol(S)];
                    994: }
                    995:
                    996: def iso_comp(G,L,V,Ord)
                    997: {
                    998:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                    999:        if ( type(IsGB=getopt(isgb)) == -1 ) IsGB = 0;
                   1000:        if ( type(Iso=getopt(iso)) == -1 ) Iso = 0;
                   1001:        if ( type(Para=getopt(para)) == -1 ) Para = 0;
                   1002:        if ( type(Q=getopt(intq)) == -1 ) Q = 0;
1.4       noro     1003:        if ( type(S=getopt(sep)) == -1 ) S = 0;
1.1       noro     1004:
1.4       noro     1005:        if ( !S ) S = separator(L,V|mod=Mod);
1.1       noro     1006:        N = length(L);
                   1007:        print("comps : ",2); print(N); print("",2);
                   1008:        if ( Para ) {
                   1009:                Task = [];
                   1010:                for ( I = 0; I < N; I++ ) {
                   1011:                        T = ["noro_pd.locsat",G,V,L[I],S[I],Mod,IsGB,Iso,Q];
                   1012:                        Task = cons(T,Task);
                   1013:                }
                   1014:                Task = reverse(Task);
                   1015:                R = para_exec(Para,Task);
                   1016:                return R;
                   1017:        } else {
                   1018:                for ( I = 0, R = []; I < N; I++ ) {
                   1019:                        QI = locsat(G,V,L[I],S[I],Mod,IsGB,Iso,Q);
                   1020:                        if ( type(QI[0][0])==1 )
                   1021:                                error("iso_comp : cannot happen");
                   1022:                        print(".",2);
                   1023:                        R = cons(QI,R);
                   1024:                }
                   1025:                print("");
                   1026:                return reverse(R);
                   1027:        }
                   1028: }
                   1029:
                   1030: def locsat(G,V,L,S,Mod,IsGB,Iso,Q)
                   1031: {
                   1032:        P = L[0]; PV = L[1]; V0 = setminus(V,PV);
                   1033:        if ( Iso==1 ) {
                   1034:                QI = sat(G,S,V|isgb=IsGB,mod=Mod);
                   1035:                GI = elim_gb(QI,V0,PV,Mod,[[0,length(V0)],[0,length(PV)]]);
                   1036:                GI = nd_gr(contraction(GI,V0|mod=Mod),V,Mod,0);
                   1037:        } else if ( Iso==0 ) {
                   1038:                HI = elim_gb(G,V0,PV,Mod,[[0,length(V0)],[0,length(PV)]]);
                   1039:                GI = nd_gr(contraction(HI,V0|mod=Mod),V,Mod,0);
                   1040:                GI = sat(GI,S,V|isgb=IsGB,mod=Mod);
                   1041:        } else if ( Iso==2 ) {
                   1042:                HI = elim_gb(G,V0,PV,Mod,[[0,length(V0)],[0,length(PV)]]);
                   1043:                TV = ttttt;
                   1044:                if ( Mod )
                   1045:                        GI = nd_gr(cons(TV*S-1,HI),cons(TV,V0),Mod,[[0,1],[0,length(V0)]]);
                   1046:                else
                   1047:                        GI = nd_gr_trace(append(HI,[TV*S-1]),cons(TV,V0),
                   1048:                                1,1,[[0,1],[0,length(V0)]]|gbblock=[[0,length(HI)]]);
                   1049:                GI = elimination(GI,V);
                   1050:                GI = nd_gr(contraction(GI,V0|mod=Mod),V,Mod,0);
1.4       noro     1051:        } else if ( Iso==3 ) {
                   1052:                GI = sat(G,S,V|isgb=IsGB,mod=Mod);
1.1       noro     1053:        }
                   1054:        if ( Q )
                   1055:                GI = ideal_intersection(Q,GI,V,0|mod=Mod);
                   1056:        return [GI,P,PV];
                   1057: }
                   1058:
                   1059: /* GTZ primary decompsition */
                   1060:
                   1061: def prima_dec(B,V)
                   1062: {
                   1063:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                   1064:        if ( type(Ord=getopt(ord)) == -1 ) Ord = 0;
                   1065:        G0 = fast_gb(B,V,Mod,0);
                   1066:        G = fast_gb(G0,V,Mod,Ord);
                   1067:        IntP = [1];
                   1068:        QD = [];
                   1069:        while ( 1 ) {
                   1070:                if ( type(G[0])==1 || ideal_inclusion(IntP,G0,V,0|mod=Mod) )
                   1071:                        break;
                   1072:                W = maxindep(G,V,Ord); NP = length(W);
                   1073:                V0 = setminus(V,W); N = length(V0);
                   1074:                V1 = append(V0,W);
                   1075:                G1 = fast_gb(G,V1,Mod,[[Ord,N],[Ord,NP]]);
                   1076:                LCF = lcfactor(G1,V0,Ord,Mod);
                   1077:                L = zprimacomp(G,V0|mod=Mod);
                   1078:                F = 1;
                   1079:                for ( T = LCF, G2 = G; T != []; T = cdr(T) ) {
                   1080:                        S = satind(G2,T[0],V1|mod=Mod);
                   1081:                        G2 = S[0]; F *= T[0]^S[1];
                   1082:                }
                   1083:                for ( T = L, QL = []; T != []; T = cdr(T) )
                   1084:                        QL = cons(car(T)[0],QL);
                   1085:                Int = ideal_list_intersection(QL,V,0|mod=Mod);
                   1086:                IntP = ideal_intersection(IntP,Int,V,0|mod=Mod);
                   1087:                QD = append(QD,L);
                   1088:                F = gen_nf(F,G,V,0,Mod);
                   1089:                G = fast_gb(cons(F,G),V,Mod,Ord);
                   1090:        }
                   1091:        QD = qd_remove_redundant_comp(G0,[],QD,V,0);
                   1092:        return QD;
                   1093: }
                   1094:
                   1095: /* SL prime decomposition */
                   1096:
                   1097: def prime_dec(B,V)
                   1098: {
                   1099:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                   1100:        if ( type(Indep=getopt(indep)) == -1 ) Indep = 0;
                   1101:        if ( type(NoLexDec=getopt(lexdec)) == -1 ) LexDec = 0;
                   1102:        if ( type(Rad=getopt(radical)) == -1 ) Rad = 0;
                   1103:        B = map(sq,B,Mod);
                   1104:        if ( LexDec )
                   1105:                PD = lex_predec1(B,V|mod=Mod);
                   1106:        else
                   1107:                PD = [B];
                   1108:        if ( length(PD) > 1 ) {
                   1109:                G = ideal_list_intersection(PD,V,0|mod=Mod);
                   1110:                PD = pd_remove_redundant_comp(G,PD,V,0|mod=Mod);
                   1111:        }
                   1112:        R = [];
                   1113:        for ( T = PD; T != []; T = cdr(T) )
                   1114:                R = append(prime_dec_main(car(T),V|indep=Indep,mod=Mod),R);
                   1115:        if ( Indep ) {
                   1116:                G = ideal_list_intersection(map(first,R),V,0|mod=Mod);
                   1117:                if ( LexDec ) R = pd_simp_comp(R,V|first=1,mod=Mod);
                   1118:        } else {
                   1119:                G = ideal_list_intersection(R,V,0|mod=Mod);
                   1120:                if ( LexDec ) R = pd_simp_comp(R,V|first=1,mod=Mod);
                   1121:        }
                   1122:        return Rad ? [R,G] : R;
                   1123: }
                   1124:
                   1125: def prime_dec_main(B,V)
                   1126: {
                   1127:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                   1128:        if ( type(Indep=getopt(indep)) == -1 ) Indep = 0;
                   1129:        G = fast_gb(B,V,Mod,0);
                   1130:        IntP = [1];
                   1131:        PD = [];
1.4       noro     1132:        DG = ltov(map(dp_ptod,G,V));
                   1133:        for ( Ind = [], I = length(G)-1; I >= 0; I-- ) Ind = cons(I,Ind);
                   1134:        if ( Mod ) DG = map(dp_mod,DG,Mod,[]);
1.1       noro     1135:        while ( 1 ) {
                   1136:                /* rad(G) subset IntP */
                   1137:                /* check if IntP subset rad(G) */
1.4       noro     1138:                /* print([length(PD),length(IntP)],2); */
1.1       noro     1139:                for ( T = IntP; T != []; T = cdr(T) ) {
1.4       noro     1140:                        if ( (GNV = radical_membership(car(T),G,V|mod=Mod,isgb=1,dg=[DG,Ind])) ) {
1.1       noro     1141:                                F = car(T);
                   1142:                                break;
                   1143:                        }
                   1144:                }
                   1145:                if ( T == [] ) return PD;
                   1146:
                   1147:                /* GNV = [GB(<NV*F-1,G>),NV] */
                   1148:                G1 = fast_gb(GNV[0],cons(GNV[1],V),Mod,[[0,1],[0,length(V)]]);
                   1149:                G0 = elimination(G1,V);
                   1150:                PD0 = zprimecomp(G0,V,Indep|mod=Mod);
                   1151:                if ( Indep ) {
                   1152:                        Int = ideal_list_intersection(PD0[0],V,0|mod=Mod);
                   1153:                        IndepSet = PD0[1];
                   1154:                        for ( PD1 = [], T = PD0[0]; T != []; T = cdr(T) )
                   1155:                                PD1 = cons([car(T),IndepSet],PD1);
                   1156:                        PD = append(PD,reverse(PD1));
                   1157:                } else {
                   1158:                        Int = ideal_list_intersection(PD0,V,0|mod=Mod);
                   1159:                        PD = append(PD,PD0);
                   1160:                }
1.4       noro     1161: #if 0
                   1162:                IntP = ideal_intersection_m(IntP,Int,V,0|mod=Mod);
                   1163: #else
                   1164:                IntP = ideal_intersection(IntP,Int,V,0
                   1165:                        |mod=Mod,gbblock=[[0,length(IntP)]]);
                   1166: #endif
1.1       noro     1167:        }
                   1168: }
                   1169:
                   1170: /* pre-decomposition */
                   1171:
                   1172: def lex_predec1(B,V)
                   1173: {
                   1174:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                   1175:        G = fast_gb(B,V,Mod,2);
                   1176:        for ( T = G; T != []; T = cdr(T) ) {
                   1177:                F = gen_fctr(car(T),Mod);
                   1178:                if ( length(F) > 2 || length(F) == 2 && F[1][1] > 1 ) {
                   1179:                        for ( R = [], S = cdr(F); S != []; S = cdr(S) ) {
                   1180:                                Ft = car(S)[0];
                   1181:                                Gt = map(ptozp,map(gen_nf,G,[Ft],V,0,Mod));
                   1182:                                R1 = fast_gb(cons(Ft,Gt),V,Mod,0);
                   1183:                                R = cons(R1,R);
                   1184:                        }
                   1185:                        return R;
                   1186:                }
                   1187:        }
                   1188:        return [G];
                   1189: }
                   1190:
                   1191: /* zero-dimensional prime/primary decomosition */
                   1192:
                   1193: def zprimedec(B,V,Mod)
                   1194: {
                   1195:        L = partial_decomp(B,V,Mod);
                   1196:        P = L[0]; NP = L[1];
                   1197:        R = [];
                   1198:        for ( ; P != []; P = cdr(P) ) R = cons(car(car(P)),R);
                   1199:        for ( T = NP; T != []; T = cdr(T) ) {
                   1200:                R1 = complete_decomp(car(T),V,Mod);
                   1201:                R = append(R1,R);
                   1202:        }
                   1203:        return R;
                   1204: }
                   1205:
                   1206: def zprimadec(B,V,Mod)
                   1207: {
                   1208:        L = partial_qdecomp(B,V,Mod);
                   1209:        Q = L[0]; NQ = L[1];
                   1210:        R = [];
                   1211:        for ( ; Q != []; Q = cdr(Q) ) {
                   1212:                T = car(Q); R = cons([T[0],T[1]],R);
                   1213:        }
                   1214:        for ( T = NQ; T != []; T = cdr(T) ) {
                   1215:                R1 = complete_qdecomp(car(T),V,Mod);
                   1216:                R = append(R1,R);
                   1217:        }
                   1218:        return R;
                   1219: }
                   1220:
                   1221: def complete_qdecomp(GD,V,Mod)
                   1222: {
                   1223:        GQ = GD[0]; GP = GD[1]; D = GD[2];
                   1224:        W = vars(GP);
                   1225:        PV = setminus(W,V);
                   1226:        N = length(V); PN = length(PV);
                   1227:        U = find_npos([GP,D],V,PV,Mod);
                   1228:        NV = ttttt;
                   1229:        M = gen_minipoly(cons(NV-U,GQ),cons(NV,V),PV,0,NV,Mod);
                   1230:        M = ppart(M,NV,Mod);
1.6     ! noro     1231:        MF = Mod ? modfctr(M,Mod) : fctr(M);
1.1       noro     1232:        R = [];
                   1233:        for ( T = cdr(MF); T != []; T = cdr(T) ) {
                   1234:                S = car(T);
                   1235:                Mt = subst(S[0],NV,U);
                   1236:                GP1 = fast_gb(cons(Mt,GP),W,Mod,0);
                   1237:                GQ1 = fast_gb(cons(Mt^S[1],GQ),W,Mod,0);
                   1238:                if ( PV != [] ) {
                   1239:                        GP1 = elim_gb(GP1,V,PV,Mod,[[0,N],[0,PN]]);
                   1240:                        GQ1 = elim_gb(GQ1,V,PV,Mod,[[0,N],[0,PN]]);
                   1241:                }
                   1242:                R = cons([GQ1,GP1],R);
                   1243:        }
                   1244:        return R;
                   1245: }
                   1246:
                   1247: def partial_qdecomp(B,V,Mod)
                   1248: {
                   1249:        Elim = (Elim=getopt(elim))&&type(Elim)!=-1 ? 1 : 0;
                   1250:        N = length(V);
                   1251:        W = vars(B);
                   1252:        PV = setminus(W,V);
                   1253:        NP = length(PV);
                   1254:        W = append(V,PV);
                   1255:        if ( Elim && PV != [] ) Ord = [[0,N],[0,NP]];
                   1256:        else Ord = 0;
                   1257:        if ( Mod )
                   1258:                B = nd_f4(B,W,Mod,Ord);
                   1259:        else
                   1260:                B = nd_gr_trace(B,W,1,GBCheck,Ord);
                   1261:        Q = []; NQ = [[B,B,vector(N+1)]];
                   1262:        for ( I = length(V)-1; I >= 0; I-- ) {
                   1263:                NQ1 = [];
                   1264:                for ( T = NQ; T != []; T = cdr(T) ) {
                   1265:                        L = partial_qdecomp0(car(T),V,PV,Ord,I,Mod);
                   1266:                        Q = append(L[0],Q);
                   1267:                        NQ1 = append(L[1],NQ1);
                   1268:                }
                   1269:                NQ = NQ1;
                   1270:        }
                   1271:        return [Q,NQ];
                   1272: }
                   1273:
                   1274: def partial_qdecomp0(GD,V,PV,Ord,I,Mod)
                   1275: {
                   1276:        GQ = GD[0]; GP = GD[1]; D = GD[2];
                   1277:        N = length(V); PN = length(PV);
                   1278:        W = append(V,PV);
                   1279:        VI = V[I];
                   1280:        M = gen_minipoly(GQ,V,PV,Ord,VI,Mod);
                   1281:        M = ppart(M,VI,Mod);
                   1282:        if ( Mod )
                   1283:                MF = modfctr(M,Mod);
                   1284:        else
                   1285:                MF = fctr(M);
                   1286:        Q = []; NQ = [];
                   1287:        if ( length(MF) == 2 && MF[1][1] == 1 ) {
                   1288:                D1 = D*1; D1[I] = M;
                   1289:                GQelim = elim_gb(GQ,V,PV,Mod,Ord);
                   1290:                GPelim = elim_gb(GP,V,PV,Mod,Ord);
                   1291:                LD = ldim(GQelim,V);
                   1292:                if ( deg(M,VI) == LD )
                   1293:                        Q = cons([GQelim,GPelim,D1],Q);
                   1294:                else
                   1295:                        NQ = cons([GQelim,GPelim,D1],NQ);
                   1296:                return [Q,NQ];
                   1297:        }
                   1298:        for ( T = cdr(MF); T != []; T = cdr(T) ) {
                   1299:                S = car(T); Mt = S[0]; D1 = D*1; D1[I] = Mt;
                   1300:
                   1301:                GQ1 = fast_gb(cons(Mt^S[1],GQ),W,Mod,Ord);
                   1302:                GQelim = elim_gb(GQ1,V,PV,Mod,Ord);
                   1303:                GP1 = fast_gb(cons(Mt,GP),W,Mod,Ord);
                   1304:                GPelim = elim_gb(GP1,V,PV,Mod,Ord);
                   1305:
                   1306:                D1[N] = LD = ldim(GPelim,V);
                   1307:
                   1308:                for ( J = 0; J < N; J++ )
                   1309:                        if ( D1[J] && deg(D1[J],V[J]) == LD ) break;
                   1310:                if ( J < N )
                   1311:                        Q = cons([GQelim,GPelim,D1],Q);
                   1312:                else
                   1313:                        NQ = cons([GQelim,GPelim,D1],NQ);
                   1314:        }
                   1315:        return [Q,NQ];
                   1316: }
                   1317:
                   1318: def complete_decomp(GD,V,Mod)
                   1319: {
                   1320:        G = GD[0]; D = GD[1];
                   1321:        W = vars(G);
                   1322:        PV = setminus(W,V);
                   1323:        N = length(V); PN = length(PV);
                   1324:        U = find_npos(GD,V,PV,Mod);
                   1325:        NV = ttttt;
                   1326:        M = gen_minipoly(cons(NV-U,G),cons(NV,V),PV,0,NV,Mod);
                   1327:        M = ppart(M,NV,Mod);
1.6     ! noro     1328:        MF = Mod ? modfctr(M,Mod) : fctr(M);
1.1       noro     1329:        if ( length(MF) == 2 ) return [G];
                   1330:        R = [];
                   1331:        for ( T = cdr(MF); T != []; T = cdr(T) ) {
                   1332:                Mt = subst(car(car(T)),NV,U);
                   1333:                G1 = fast_gb(cons(Mt,G),W,Mod,0);
                   1334:                if ( PV != [] ) G1 = elim_gb(G1,V,PV,Mod,[[0,N],[0,PN]]);
                   1335:                R = cons(G1,R);
                   1336:        }
                   1337:        return R;
                   1338: }
                   1339:
                   1340: def partial_decomp(B,V,Mod)
                   1341: {
                   1342:        Elim = (Elim=getopt(elim))&&type(Elim)!=-1 ? 1 : 0;
                   1343:        N = length(V);
                   1344:        W = vars(B);
                   1345:        PV = setminus(W,V);
                   1346:        NP = length(PV);
                   1347:        W = append(V,PV);
                   1348:        if ( Elim && PV != [] ) Ord = [[0,N],[0,NP]];
                   1349:        else Ord = 0;
                   1350:        if ( Mod )
                   1351:                B = nd_f4(B,W,Mod,Ord);
                   1352:        else
                   1353:                B = nd_gr_trace(B,W,1,GBCheck,Ord);
                   1354:        P = []; NP = [[B,vector(N+1)]];
                   1355:        for ( I = length(V)-1; I >= 0; I-- ) {
                   1356:                NP1 = [];
                   1357:                for ( T = NP; T != []; T = cdr(T) ) {
                   1358:                        L = partial_decomp0(car(T),V,PV,Ord,I,Mod);
                   1359:                        P = append(L[0],P);
                   1360:                        NP1 = append(L[1],NP1);
                   1361:                }
                   1362:                NP = NP1;
                   1363:        }
                   1364:        return [P,NP];
                   1365: }
                   1366:
                   1367: def partial_decomp0(GD,V,PV,Ord,I,Mod)
                   1368: {
                   1369:        G = GD[0]; D = GD[1];
                   1370:        N = length(V); PN = length(PV);
                   1371:        W = append(V,PV);
                   1372:        VI = V[I];
                   1373:        M = gen_minipoly(G,V,PV,Ord,VI,Mod);
                   1374:        M = ppart(M,VI,Mod);
                   1375:        if ( Mod )
                   1376:                MF = modfctr(M,Mod);
                   1377:        else
                   1378:                MF = fctr(M);
                   1379:        if ( length(MF) == 2 && MF[1][1] == 1 ) {
                   1380:                D1 = D*1;
                   1381:                D1[I] = M;
                   1382:                Gelim = elim_gb(G,V,PV,Mod,Ord);
                   1383:                D1[N] = LD = ldim(Gelim,V);
                   1384:                GD1 = [Gelim,D1];
                   1385:                for ( J = 0; J < N; J++ )
                   1386:                        if ( D1[J] && deg(D1[J],V[J]) == LD )
                   1387:                                return [[GD1],[]];
                   1388:                return [[],[GD1]];
                   1389:        }
                   1390:        P = []; NP = [];
                   1391:        GI = elim_gb(G,V,PV,Mod,Ord);
                   1392:        for ( T = cdr(MF); T != []; T = cdr(T) ) {
                   1393:                Mt = car(car(T));
                   1394:                D1 = D*1;
                   1395:                D1[I] = Mt;
                   1396:                GIt = map(gen_nf,GI,[Mt],V,Ord,Mod);
                   1397:                G1 = cons(Mt,GIt);
                   1398:                Gelim = elim_gb(G1,V,PV,Mod,Ord);
                   1399:                D1[N] = LD = ldim(Gelim,V);
                   1400:                for ( J = 0; J < N; J++ )
                   1401:                        if ( D1[J] && deg(D1[J],V[J]) == LD ) break;
                   1402:                if ( J < N )
                   1403:                        P = cons([Gelim,D1],P);
                   1404:                else
                   1405:                        NP = cons([Gelim,D1],NP);
                   1406:        }
                   1407:        return [P,NP];
                   1408: }
                   1409:
                   1410: /* prime/primary components over rational function field */
                   1411:
                   1412: def zprimacomp(G,V) {
                   1413:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                   1414:        L = zprimadec(G,V,0|mod=Mod);
                   1415:        R = [];
                   1416:        dp_ord(0);
                   1417:        for ( T = L; T != []; T = cdr(T) ) {
                   1418:                S = car(T);
                   1419:                UQ = contraction(S[0],V|mod=Mod);
                   1420:                UP = contraction(S[1],V|mod=Mod);
                   1421:                R = cons([UQ,UP],R);
                   1422:        }
                   1423:        return R;
                   1424: }
                   1425:
                   1426: def zprimecomp(G,V,Indep) {
                   1427:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                   1428:        W = maxindep(G,V,0|mod=Mod);
                   1429:        V0 = setminus(V,W);
                   1430:        V1 = append(V0,W);
                   1431: #if 0
                   1432:        O1 = [[0,length(V0)],[0,length(W)]];
                   1433:        G1 = fast_gb(G,V1,Mod,O1);
                   1434:        dp_ord(0);
                   1435: #else
                   1436:        G1 = G;
                   1437: #endif
                   1438:        PD = zprimedec(G1,V0,Mod);
                   1439:        dp_ord(0);
                   1440:        R = [];
                   1441:        for ( T = PD; T != []; T = cdr(T) ) {
                   1442:                U = contraction(car(T),V0|mod=Mod);
                   1443:                U = nd_gr(U,V,Mod,0);
                   1444:                R = cons(U,R);
                   1445:        }
                   1446:        if ( Indep ) return [R,W];
                   1447:        else return R;
                   1448: }
                   1449:
                   1450: def fast_gb(B,V,Mod,Ord)
                   1451: {
                   1452:        if ( type(Block=getopt(gbblock)) == -1 ) Block = 0;
                   1453:        if ( type(NoRA=getopt(nora)) == -1 ) NoRA = 0;
                   1454:        if ( type(Trace=getopt(trace)) == -1 ) Trace = 0;
                   1455:        if ( Mod )
                   1456:                G = nd_f4(B,V,Mod,Ord|nora=NoRA);
                   1457:        else if ( F4 )
                   1458:                G = map(ptozp,f4_chrem(B,V,Ord));
                   1459:        else if ( Trace ) {
                   1460:                if ( Block )
                   1461:                        G = nd_gr_trace(B,V,1,1,Ord|nora=NoRA,gbblock=Block);
                   1462:                else
                   1463:                        G = nd_gr_trace(B,V,1,1,Ord|nora=NoRA);
                   1464:        } else {
                   1465:                if ( Block )
                   1466:                        G = nd_gr(B,V,0,Ord|nora=NoRA,gbblock=Block);
                   1467:                else
                   1468:                        G = nd_gr(B,V,0,Ord|nora=NoRA);
                   1469:        }
                   1470:        return G;
                   1471: }
                   1472:
                   1473: def incremental_gb(A,V,Ord)
                   1474: {
                   1475:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                   1476:        if ( type(Block=getopt(gbblock)) == -1 ) Block = 0;
                   1477:        if ( Mod ) {
                   1478:                if ( Block )
                   1479:                        G = nd_gr(A,V,Mod,Ord|gbblock=Block);
                   1480:                else
                   1481:                        G = nd_gr(A,V,Mod,Ord);
                   1482:        } else if ( Procs ) {
                   1483:                Arg0 = ["nd_gr",A,V,0,Ord];
                   1484:                Arg1 = ["nd_gr_trace",A,V,1,GBCheck,Ord];
                   1485:                G = competitive_exec(Procs,Arg0,Arg1);
                   1486:        } else if ( Block )
                   1487:                G = nd_gr(A,V,0,Ord|gbblock=Block);
                   1488:        else
                   1489:                G = nd_gr(A,V,0,Ord);
                   1490:        return G;
                   1491: }
                   1492:
                   1493: def elim_gb(G,V,PV,Mod,Ord)
                   1494: {
                   1495:        N = length(V); PN = length(PV);
                   1496:        O1 = [[0,N],[0,PN]];
                   1497:        if ( Ord == O1 )
                   1498:                Ord = Ord[0][0];
                   1499:        if ( Mod ) /* XXX */ {
                   1500:                for ( T = G, H = []; T != []; T = cdr(T) )
                   1501:                        if ( car(T) ) H = cons(car(T),H);
                   1502:                G = reverse(H);
                   1503:                G = dp_gr_mod_main(G,V,0,Mod,Ord);
                   1504:        } else if ( EProcs ) {
                   1505: #if 1
                   1506:                Arg0 = ["dp_gr_main",G,V,0,0,Ord];
                   1507: #else
                   1508:                Arg0 = ["nd_gr",G,V,0,Ord];
                   1509: #endif
                   1510:                Arg1 = ["noro_pd.nd_gr_rat",G,V,PV,O1,Ord];
                   1511:                G = competitive_exec(EProcs,Arg0,Arg1);
                   1512:        } else if ( GBRat ) {
                   1513:                G1 = nd_gr(G,append(V,PV),0,O1);
                   1514:            G1 = nd_gr_postproc(G1,V,0,Ord,0);
                   1515:                return G1;
                   1516:        } else
                   1517: #if 1
1.2       noro     1518: #if 0
1.1       noro     1519:                G = dp_gr_main(G,V,0,0,Ord);
                   1520: #else
                   1521:                G = nd_gr_trace(G,V,1,1,Ord);
                   1522: #endif
                   1523: #else
                   1524:                G = nd_gr(G,V,0,Ord);
                   1525: #endif
                   1526:        return G;
                   1527: }
                   1528:
                   1529: def ldim(G,V)
                   1530: {
                   1531:        O0 = dp_ord(); dp_ord(0);
                   1532:        D = length(dp_mbase(map(dp_ptod,G,V)));
                   1533:        dp_ord(O0);
                   1534:        return D;
                   1535: }
                   1536:
                   1537: /* over Q only */
                   1538:
                   1539: def make_mod_subst(GD,V,PV,HC)
                   1540: {
                   1541:        N = length(V);
                   1542:        PN = length(PV);
                   1543:        G = GD[0]; D = GD[1];
                   1544:        for ( I = 0; ; I = (I+1)%100 ) {
                   1545:                Mod = lprime(I);
                   1546:                S = [];
                   1547:                for ( J = PN-1; J >= 0; J-- )
                   1548:                        S = append([PV[J],random()%Mod],S);
                   1549:                for ( T = HC; T != []; T = cdr(T) )
                   1550:                        if ( !(subst(car(T),S)%Mod) ) break;
                   1551:                if ( T != [] ) continue;
                   1552:                for ( J = 0; J < N; J++ ) {
                   1553:                        M = subst(D[J],S);
                   1554:                        F = modsqfr(M,Mod);
                   1555:                        if ( length(F) != 2 || F[1][1] != 1 ) break;
                   1556:                }
                   1557:                if ( J < N ) continue;
                   1558:                G0 = map(subst,G,S);
                   1559:                return [G0,Mod];
                   1560:        }
                   1561: }
                   1562:
                   1563: def rsgn()
                   1564: {
                   1565:        return random()%2 ? 1 : -1;
                   1566: }
                   1567:
                   1568: def find_npos(GD,V,PV,Mod)
                   1569: {
                   1570:        N = length(V); PN = length(PV);
                   1571:        G = GD[0]; D = GD[1]; LD = D[N];
1.5       noro     1572:        DH = map(dp_dtop,map(dp_ht,map(dp_ptod,D,V)),V);
1.1       noro     1573:        Ord0 = dp_ord(); dp_ord(0);
                   1574:        HC = map(dp_hc,map(dp_ptod,G,V));
                   1575:        dp_ord(Ord0);
                   1576:        if ( !Mod ) {
                   1577:                W = append(V,PV);
                   1578:                G1 = nd_gr_trace(G,W,1,GBCheck,[[0,N],[0,PN]]);
                   1579:                L = make_mod_subst([G1,D],V,PV,HC);
                   1580:                return find_npos([L[0],D],V,[],L[1]);
                   1581:        }
                   1582:        N = length(V);
                   1583:        NV = ttttt;
                   1584:        for ( B = 2; ; B++ ) {
                   1585:                for ( J = N-2; J >= 0; J-- ) {
1.5       noro     1586:                        for ( U = 0, K = J; K < N; K++ ) {
                   1587:                                if ( DH[K] == V[K] ) continue;
1.1       noro     1588:                                U += rsgn()*((random()%B+1))*V[K];
1.5       noro     1589:                        }
1.6     ! noro     1590: #if 0
1.1       noro     1591:                        M = minipolym(G,V,0,U,NV,Mod);
1.6     ! noro     1592: #else
        !          1593:                        M = gen_minipoly(cons(NV-U,G),cons(NV,V),PV,0,NV,Mod);
        !          1594: #endif
1.1       noro     1595:                        if ( deg(M,NV) == LD ) return U;
                   1596:                }
                   1597:        }
                   1598: }
                   1599:
                   1600: def gen_minipoly(G,V,PV,Ord,VI,Mod)
                   1601: {
1.6     ! noro     1602:        O0 = dp_ord();
1.1       noro     1603:        if ( PV == [] ) {
                   1604:                NV = sssss;
                   1605:                if ( Mod )
                   1606:                        M = minipolym(G,V,Ord,VI,NV,Mod);
                   1607:                else
                   1608:                        M = minipoly(G,V,Ord,VI,NV);
1.6     ! noro     1609:                dp_ord(O0);
1.1       noro     1610:                return subst(M,NV,VI);
                   1611:        }
                   1612:        W = setminus(V,[VI]);
                   1613:        PV1 = cons(VI,PV);
                   1614: #if 0
                   1615:        while ( 1 ) {
                   1616:                V1 = append(W,PV1);
                   1617:                if ( Mod )
                   1618:                        G = nd_gr(G,V1,Mod,[[0,1],[0,length(V1)-1]]|nora=1);
                   1619:                else
                   1620:                        G = nd_gr_trace(G,V1,1,GBCheck,[[0,1],[0,length(V1)-1]]|nora=1);
                   1621:                if ( W == [] ) break;
                   1622:                else {
                   1623:                        W = cdr(W);
                   1624:                        G = elimination(G,cdr(V1));
                   1625:                }
                   1626:        }
                   1627: #elif 1
                   1628:        if ( Mod ) {
                   1629:                V1 = append(W,PV1);
                   1630:                G = nd_gr(G,V1,Mod,[[0,length(W)],[0,length(PV1)]]);
                   1631:                G = elimination(G,PV1);
                   1632:        } else {
                   1633:                PV2 = setminus(PV1,[PV1[length(PV1)-1]]);
                   1634:                V2 = append(W,PV2);
                   1635:                G = nd_gr_trace(G,V2,1,GBCheck,[[0,length(W)],[0,length(PV2)]]|nora=1);
                   1636:                G = elimination(G,PV1);
                   1637:        }
                   1638: #else
                   1639:        V1 = append(W,PV1);
                   1640:        if ( Mod )
                   1641:                G = nd_gr(G,V1,Mod,[[0,length(W)],[0,length(PV1)]]|nora=1);
                   1642:        else
                   1643:                G = nd_gr_trace(G,V1,1,GBCheck,[[0,length(W)],[0,length(PV1)]]|nora=1);
                   1644:        G = elimination(G,PV1);
                   1645: #endif
                   1646:        if ( Mod )
                   1647:                G = nd_gr(G,PV1,Mod,[[0,1],[0,length(PV)]]|nora=1);
                   1648:        else
                   1649:                G = nd_gr_trace(G,PV1,1,GBCheck,[[0,1],[0,length(PV)]]|nora=1);
                   1650:        for ( M = car(G), T = cdr(G); T != []; T = cdr(T) )
                   1651:                if ( deg(car(T),VI) < deg(M,VI) ) M = car(T);
1.6     ! noro     1652:        dp_ord(O0);
1.1       noro     1653:        return M;
                   1654: }
                   1655:
                   1656: def indepset(V,H)
                   1657: {
                   1658:        if ( H == [] ) return V;
                   1659:        N = -1;
                   1660:        for ( T = V; T != []; T = cdr(T) ) {
                   1661:                VI = car(T);
                   1662:                HI = [];
                   1663:                for ( S = H; S != []; S = cdr(S) )
                   1664:                        if ( !tdiv(car(S),VI) ) HI = cons(car(S),HI);
                   1665:                RI = indepset(setminus(V,[VI]),HI);
                   1666:                if ( length(RI) > N ) {
                   1667:                        R = RI; N = length(RI);
                   1668:                }
                   1669:        }
                   1670:        return R;
                   1671: }
                   1672:
                   1673: def maxindep(B,V,O)
                   1674: {
                   1675:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                   1676:        G = fast_gb(B,V,Mod,O);
                   1677:        Old = dp_ord();
                   1678:        dp_ord(O);
                   1679:        H = map(dp_dtop,map(dp_ht,map(dp_ptod,G,V)),V);
                   1680:        H = map(sq,H,0);
                   1681:        H = nd_gr(H,V,0,0);
                   1682:        H = monodec0(H,V);
                   1683:        N = length(V);
                   1684:        Dep = [];
                   1685:        for ( T = H, Len = N+1; T != []; T = cdr(T) ) {
                   1686:                M = length(car(T));
                   1687:                if ( M < Len ) {
                   1688:                        Dep = [car(T)];
                   1689:                        Len = M;
                   1690:                } else if ( M == Len )
                   1691:                        Dep = cons(car(T),Dep);
                   1692:        }
                   1693:        R = setminus(V,Dep[0]);
                   1694:        dp_ord(Old);
                   1695:        return R;
                   1696: }
                   1697:
                   1698: /* ideal operations */
                   1699: def contraction(G,V)
                   1700: {
                   1701:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                   1702:        C = [];
                   1703:        for ( T = G; T != []; T = cdr(T) ) {
                   1704:                C1 = dp_hc(dp_ptod(car(T),V));
                   1705:                S = gen_fctr(C1,Mod);
                   1706:                for ( S = cdr(S); S != []; S = cdr(S) )
                   1707:                        if ( !member(S[0][0],C) ) C = cons(S[0][0],C);
                   1708:        }
                   1709:        W = vars(G);
                   1710:        PV = setminus(W,V);
                   1711:        W = append(V,PV);
                   1712:        NV = ttttt;
                   1713:        for ( T = C, S = 1; T != []; T = cdr(T) )
                   1714:                S *= car(T);
                   1715:        G = saturation([G,NV],S,W|mod=Mod);
                   1716:        return G;
                   1717: }
                   1718:
                   1719: def ideal_list_intersection(L,V,Ord)
                   1720: {
                   1721:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1.4       noro     1722:        if ( type(IsGB=getopt(isgb)) == -1 ) IsGB = 0;
1.1       noro     1723:        if ( type(Para=getopt(para)) == -1 || type(Para) != 4 ) Para = [];
                   1724:        N = length(L);
                   1725:        if ( N == 0 ) return [1];
1.4       noro     1726:        if ( N == 1 )
                   1727:                return IsGB ? L[0] : fast_gb(L[0],V,Mod,Ord);
1.2       noro     1728:        if ( N > 2 && (Len = length(Para)) >= 2 ) {
                   1729:                Div = N >= 2*Len ? Len : 2;
                   1730:                QR = iqr(N,Div); Q = QR[0]; R = QR[1];
                   1731:                T = []; K = 0;
                   1732:                for ( I = 0; I < Div; I++ ) {
                   1733:                        LenI = I<R? Q+1 : Q;
                   1734:                        if ( LenI ) {
                   1735:                                for ( LI = [], J = 0; J < LenI; J++ ) LI = cons(L[K++],LI);
1.4       noro     1736:                                TI = ["noro_pd.call_ideal_list_intersection",LI,V,Mod,Ord,IsGB];
1.2       noro     1737:                                T = cons(TI,T);
                   1738:                        }
                   1739:                }
                   1740:                Tint = para_exec(Para,T);
1.4       noro     1741:                return ideal_list_intersection(Tint,V,Ord|mod=Mod,para=Para,isgb=IsGB);
1.1       noro     1742:        } else {
1.4       noro     1743:                for ( I = 0, T = [1]; I < N; I++ )
                   1744:                        T = ideal_intersection_m(T,L[I],V,Ord|mod=Mod);
                   1745:                T = nd_gr(T,V,Mod,Ord);
                   1746:                return T;
1.1       noro     1747:        }
                   1748: }
                   1749:
1.4       noro     1750: def call_ideal_list_intersection(L,V,Mod,Ord,IsGB)
1.1       noro     1751: {
1.4       noro     1752:        return ideal_list_intersection(L,V,Ord|mod=Mod,isgb=IsGB);
1.1       noro     1753: }
                   1754:
                   1755: def ideal_intersection(A,B,V,Ord)
                   1756: {
                   1757:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                   1758:        if ( type(Block=getopt(gbblock)) == -1 ) Block = 0;
                   1759:        T = ttttt;
                   1760:        if ( Mod ) {
                   1761:                if ( Block )
                   1762:                        G = nd_gr(append(vtol(ltov(A)*T),vtol(ltov(B)*(1-T))),
                   1763:                                cons(T,V),Mod,[[0,1],[Ord,length(V)]]|gbblock=Block,nora=0);
                   1764:                else
                   1765:                        G = nd_gr(append(vtol(ltov(A)*T),vtol(ltov(B)*(1-T))),
                   1766:                                cons(T,V),Mod,[[0,1],[Ord,length(V)]]|nora=0);
                   1767:        } else
                   1768:        if ( Procs ) {
                   1769:                Arg0 = ["nd_gr",
                   1770:                        append(vtol(ltov(A)*T),vtol(ltov(B)*(1-T))),
                   1771:                        cons(T,V),0,[[0,1],[Ord,length(V)]]];
                   1772:                Arg1 = ["nd_gr_trace",
                   1773:                        append(vtol(ltov(A)*T),vtol(ltov(B)*(1-T))),
                   1774:                        cons(T,V),1,GBCheck,[[0,1],[Ord,length(V)]]];
                   1775:                G = competitive_exec(Procs,Arg0,Arg1);
                   1776:        } else {
                   1777:                if ( Block )
                   1778:                        G = nd_gr(append(vtol(ltov(A)*T),vtol(ltov(B)*(1-T))),
                   1779:                                cons(T,V),0,[[0,1],[Ord,length(V)]]|gbblock=Block,nora=0);
                   1780:                else
                   1781:                        G = nd_gr(append(vtol(ltov(A)*T),vtol(ltov(B)*(1-T))),
                   1782:                                cons(T,V),0,[[0,1],[Ord,length(V)]]|nora=0);
                   1783:        }
                   1784:        G0 = elimination(G,V);
                   1785:        if ( 0 && !Procs )
                   1786:                G0 = nd_gr_postproc(G0,V,Mod,Ord,0);
                   1787:        return G0;
                   1788: }
                   1789:
1.4       noro     1790:
                   1791: def aa(A) { return [A,A]; }
                   1792:
                   1793: def ideal_intersection_m(A,B,V,Ord)
                   1794: {
                   1795:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                   1796:
                   1797:        dp_ord(Ord);
                   1798:        DA = map(dp_ptod,A,V); DB = ltov(map(dp_ptod,B,V));
                   1799:        if ( Mod ) {
                   1800:                DA = map(dp_mod,DA,Mod,[]); DB = map(dp_mod,DB,Mod,[]);
                   1801:                setmod(Mod);
                   1802:        }
                   1803:        N = length(B);
                   1804:        for ( Ind = [], I = N-1; I >= 0; I-- ) Ind = cons(I,Ind);
                   1805:        for ( T = DA, C = []; T != []; T = cdr(T) ) {
                   1806:                L = Mod?dp_true_nf_mod(Ind,car(T),DB,1,Mod):dp_true_nf(Ind,car(T),DB,1);
                   1807:                R = dp_dtop(L[0],V); Q = dp_dtop(car(T)*L[1]-L[0],V);
                   1808:                C = cons([R,-Q],C);
                   1809:        }
                   1810:        G = nd_gr(append(C,map(aa,B)),V,Mod,[1,Ord]|intersect=1);
                   1811:        G = map(second,G);
                   1812:        return G;
                   1813: }
                   1814:
1.1       noro     1815: /* returns GB if F notin rad(G) */
                   1816:
                   1817: def radical_membership(F,G,V) {
                   1818:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                   1819:        if ( type(IsGB=getopt(isgb)) == -1 ) IsGB = 0;
1.4       noro     1820:        if ( type(L=getopt(dg)) == -1 ) L = 0;
                   1821:        dp_ord(0);
                   1822:        if ( L ) { DG = L[0]; Ind = L[1]; }
                   1823:        else {
                   1824:                DG = ltov(map(dp_ptod,G,V));
                   1825:                if ( Mod ) DG = map(dp_mod,DG,Mod,[]);
                   1826:                for ( Ind = [], I = length(G)-1; I >= 0; I-- ) Ind = cons(I,Ind);
                   1827:        }
                   1828:        DF = dp_ptod(F,V); DFI = dp_ptod(1,V);
                   1829:        if ( Mod ) {
                   1830:                DF = dp_mod(DF,Mod,[]); DFI = dp_mod(DFI,Mod,[]);
                   1831:                setmod(Mod);
                   1832:        }
                   1833:        for ( I = 0; I < 3; I++ ) {
                   1834:                DFI = Mod?dp_nf_mod(Ind,DF*DFI,DG,0,Mod):dp_nf(Ind,DF*DFI,DG,0);
                   1835:                if ( !DFI ) return 0;
                   1836:        }
1.1       noro     1837:        NV = ttttt;
                   1838:        if ( IsGB )
                   1839:                T = nd_gr(append(G,[NV*F-1]),cons(NV,V),Mod,0
                   1840:                        |gbblock=[[0,length(G)]]);
                   1841:        else
                   1842:                T = nd_gr(append(G,[NV*F-1]),cons(NV,V),Mod,0);
                   1843:        if ( type(car(T)) != 1 ) return [T,NV];
                   1844:        else return 0;
                   1845: }
                   1846:
                   1847: def modular_radical_membership(F,G,V) {
                   1848:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                   1849:        if ( Mod )
                   1850:                return radical_membership(F,G,V|mod=Mod);
                   1851:
                   1852:        F = gen_nf(F,G,V,0,0);
                   1853:        if ( !F ) return 0;
                   1854:        NV = ttttt;
                   1855:        for ( J = 0; ; J++ ) {
                   1856:                Mod = lprime(J);
                   1857:                H = map(dp_hc,map(dp_ptod,G,V));
                   1858:                for ( ; H != []; H = cdr(H) ) if ( !(car(H)%Mod) ) break;
                   1859:                if ( H != [] ) continue;
                   1860:
                   1861:                T = nd_f4(cons(NV*F-1,G),cons(NV,V),Mod,0);
                   1862:                if ( type(car(T)) == 1 ) {
                   1863:                        I = radical_membership_rep(F,G,V,-1,0,Mod);
                   1864:                        I1 = radical_membership_rep(F,G,V,I,0,0);
                   1865:                        if ( I1 > 0 ) return 0;
                   1866:                }
                   1867:                return radical_membership(F,G,V);
                   1868:        }
                   1869: }
                   1870:
                   1871: def radical_membership_rep(F,G,V,Max,Ord,Mod) {
                   1872:        Ft = F;
                   1873:        I = 1;
                   1874:        while ( Max < 0 || I <= Max ) {
                   1875:                Ft = gen_nf(Ft,G,V,Ord,Mod);
                   1876:                if ( !Ft ) return I;
                   1877:                Ft *= F;
                   1878:                I++;
                   1879:        }
                   1880:        return -1;
                   1881: }
                   1882:
                   1883: def ideal_product(A,B,V)
                   1884: {
                   1885:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                   1886:        dp_ord(0);
                   1887:        DA = map(dp_ptod,A,V);
                   1888:        DB = map(dp_ptod,B,V);
                   1889:        DegA = map(dp_td,DA);
                   1890:        DegB = map(dp_td,DB);
                   1891:        for ( PA = [], T = A, DT = DegA; T != []; T = cdr(T), DT = cdr(DT) )
                   1892:                PA = cons([car(T),car(DT)],PA);
                   1893:        PA = reverse(PA);
                   1894:        for ( PB = [], T = B, DT = DegB; T != []; T = cdr(T), DT = cdr(DT) )
                   1895:                PB = cons([car(T),car(DT)],PB);
                   1896:        PB = reverse(PB);
                   1897:        R = [];
                   1898:        for ( T = PA; T != []; T = cdr(T) )
                   1899:                for ( S = PB; S != []; S = cdr(S) )
                   1900:                        R = cons([car(T)[0]*car(S)[0],car(T)[1]+car(S)[1]],R);
                   1901:        T = qsort(R,comp_by_second);
                   1902:        T = map(first,T);
                   1903:        Len = length(A)>length(B)?length(A):length(B);
                   1904:        Len *= 2;
                   1905:        L = sep_list(T,Len); B0 = L[0]; B1 = L[1];
                   1906:        R = fast_gb(B0,V,Mod,0);
                   1907:        while ( B1 != [] ) {
                   1908:                print(length(B1));
                   1909:                L = sep_list(B1,Len);
                   1910:                B0 = L[0]; B1 = L[1];
                   1911:                R = fast_gb(append(R,B0),V,Mod,0|gbblock=[[0,length(R)]],nora=1);
                   1912:        }
                   1913:        return R;
                   1914: }
                   1915:
                   1916: def saturation(GNV,F,V)
                   1917: {
                   1918:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                   1919:        G = GNV[0]; NV = GNV[1];
                   1920:        if ( Mod )
                   1921:                G1 = nd_gr(cons(NV*F-1,G),cons(NV,V),Mod,[[0,1],[0,length(V)]]);
                   1922:        else if ( Procs ) {
                   1923:                Arg0 = ["nd_gr_trace",
                   1924:                cons(NV*F-1,G),cons(NV,V),0,GBCheck,[[0,1],[0,length(V)]]];
                   1925:                Arg1 = ["nd_gr_trace",
                   1926:                cons(NV*F-1,G),cons(NV,V),1,GBCheck,[[0,1],[0,length(V)]]];
                   1927:                G1 = competitive_exec(Procs,Arg0,Arg1);
                   1928:        } else
                   1929:                G1 = nd_gr(cons(NV*F-1,G),cons(NV,V),0,[[0,1],[0,length(V)]]);
                   1930:        return elimination(G1,V);
                   1931: }
                   1932:
                   1933: def sat(G,F,V)
                   1934: {
                   1935:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                   1936:        if ( type(IsGB=getopt(isgb)) == -1 ) IsGB = 0;
                   1937:        NV = ttttt;
                   1938:        if ( Mod )
                   1939:                G1 = nd_gr(cons(NV*F-1,G),cons(NV,V),Mod,[[0,1],[0,length(V)]]);
                   1940:        else if ( Procs ) {
                   1941:                Arg0 = ["nd_gr_trace",
                   1942:                cons(NV*F-1,G),cons(NV,V),0,GBCheck,[[0,1],[0,length(V)]]];
                   1943:                Arg1 = ["nd_gr_trace",
                   1944:                cons(NV*F-1,G),cons(NV,V),1,GBCheck,[[0,1],[0,length(V)]]];
                   1945:                G1 = competitive_exec(Procs,Arg0,Arg1);
                   1946:        } else {
                   1947:                B1 = append(G,[NV*F-1]);
                   1948:                V1 = cons(NV,V);
                   1949:                Ord1 = [[0,1],[0,length(V)]];
                   1950:                if ( IsGB )
                   1951:                        G1 = nd_gr(B1,V1,0,Ord1|gbblock=[[0,length(G)]]);
                   1952:                else
                   1953:                        G1 = nd_gr(B1,V1,0,Ord1);
                   1954:        }
                   1955:        return elimination(G1,V);
                   1956: }
                   1957:
1.4       noro     1958: def isat(B,S,V)
                   1959: {
                   1960:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                   1961:        if ( type(IsGB=getopt(isgb)) == -1 ) IsGB = 0;
                   1962:        F = cdr(fctr(S));
                   1963:        R = B;
                   1964:        for ( T = F; T != []; T = cdr(T) )
                   1965:                R = sat(R,car(T)[0],V|mod=Mod,isgb=IsGB);
                   1966:        return R;
                   1967: }
                   1968:
1.1       noro     1969: def satind(G,F,V)
                   1970: {
                   1971:        if ( type(Block=getopt(gbblock)) == -1 ) Block = 0;
                   1972:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                   1973:        NV = ttttt;
                   1974:        N = length(V);
                   1975:        B = append(G,[NV*F-1]);
                   1976:        V1 = cons(NV,V);
                   1977:        Ord1 = [[0,1],[0,N]];
                   1978:        if ( Mod )
                   1979:                if ( Block )
                   1980:                        D = nd_gr(B,V1,Mod,Ord1|nora=1,gentrace=1,gbblock=Block);
                   1981:                else
                   1982:                        D = nd_gr(B,V1,Mod,Ord1|nora=1,gentrace=1);
                   1983:        else
                   1984:                if ( Block )
                   1985:                        D = nd_gr_trace(B,V1,SatHomo,GBCheck,Ord1
                   1986:                                |nora=1,gentrace=1,gbblock=Block);
                   1987:                else
                   1988:                        D = nd_gr_trace(B,V1,SatHomo,GBCheck,Ord1
                   1989:                                |nora=1,gentrace=1);
                   1990:        G1 = D[0];
                   1991:        Len = length(G1);
                   1992:        Deg = compute_deg(B,V1,NV,D);
                   1993:        D1 = 0;
                   1994:        R = [];
                   1995:        M = length(B);
                   1996:        for ( I = 0; I < Len; I++ ) {
                   1997:                if ( !member(NV,vars(G1[I])) ) {
                   1998:                        for ( J = 1; J < M; J++ )
                   1999:                                D1 = MAX(D1,Deg[I][J]);
                   2000:                        R = cons(G1[I],R);
                   2001:                }
                   2002:        }
                   2003:        return [reverse(R),D1];
                   2004: }
                   2005:
                   2006: def sat_ind(G,F,V)
                   2007: {
                   2008:        if ( type(Ord=getopt(ord)) == -1 ) Ord = 0;
                   2009:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                   2010:        NV = ttttt;
                   2011:        F = gen_nf(F,G,V,Ord,Mod);
                   2012:        for ( I = 0, GI = G; ; I++ ) {
                   2013:                G1 = colon(GI,F,V|mod=Mod,ord=Ord);
                   2014:                if ( ideal_inclusion(G1,GI,V,Ord|mod=Mod) )  {
                   2015:                        return [GI,I];
                   2016:                }
                   2017:                else GI = G1;
                   2018:        }
                   2019: }
                   2020:
                   2021: def colon(G,F,V)
                   2022: {
                   2023:        if ( type(Ord=getopt(ord)) == -1 ) Ord = 0;
                   2024:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                   2025:        if ( type(IsGB=getopt(isgb)) == -1 ) IsGB = 0;
                   2026:        F = gen_nf(F,G,V,Ord,Mod);
                   2027:        if ( !F ) return [1];
                   2028:        if ( IsGB )
                   2029:                T = ideal_intersection(G,[F],V,Ord|gbblock=[[0,length(G)]],mod=Mod);
                   2030:        else
                   2031:                T = ideal_intersection(G,[F],V,Ord|mod=Mod);
1.4       noro     2032:        Gen = Mod?map(sdivm,T,F,Mod):map(ptozp,map(sdiv,T,F));
                   2033:        return nd_gr(Gen,V,Mod,Ord);
1.1       noro     2034: }
                   2035:
                   2036: #if 1
                   2037: def ideal_colon(G,F,V)
                   2038: {
                   2039:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                   2040:        G = nd_gr(G,V,Mod,0);
                   2041:        C = [1];
                   2042:        TV = ttttt;
                   2043:        F = qsort(F,comp_tdeg);
                   2044:        for ( T = F; T != []; T = cdr(T) ) {
                   2045:                S = colon(G,car(T),V|isgb=1,mod=Mod);
                   2046:                if ( type(S[0])!= 1 ) {
                   2047:                        C = nd_gr(append(vtol(ltov(C)*TV),vtol(ltov(S)*(1-TV))),
                   2048:                                cons(TV,V),Mod,[[0,1],[Ord,length(V)]]|gbblock=[[0,length(C)]]);
                   2049:                        C = elimination(C,V);
                   2050:                }
                   2051:        }
                   2052:        return C;
                   2053: }
                   2054: #else
                   2055: def ideal_colon(G,F,V)
                   2056: {
                   2057:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                   2058:        G = nd_gr(G,V,Mod,0);
                   2059:        for ( T = F, L = []; T != []; T = cdr(T) ) {
                   2060:                C = colon(G,car(T),V|isgb=1,mod=Mod);
                   2061:                if ( type(C[0]) != 1 ) L = cons(C,L);
                   2062:        }
                   2063:        L = reverse(L);
                   2064:        return ideal_list_intersection(L,V,0|mod=Mod);
                   2065: }
                   2066:
                   2067: #endif
                   2068:
                   2069: def member(A,L)
                   2070: {
                   2071:        for ( ; L != []; L = cdr(L) )
                   2072:                if ( car(L) == A ) return 1;
                   2073:        return 0;
                   2074: }
                   2075:
                   2076: def mingen(B,V) {
                   2077:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                   2078:        Data = nd_gr(B,V,Mod,O|gentrace=1,gensyz=1);
1.4       noro     2079:     G = Data[0]; STrace = Data[6];
1.1       noro     2080:        N = length(G);
1.4       noro     2081:        S = compute_gbsyz(N,V,STrace,Mod);
                   2082:        for ( T = S, R = []; T != []; T = cdr(T) ) {
                   2083:                for ( A = car(T); A1 = dp_rest(A); A = A1);
                   2084:                if ( type(dp_hc(A)) ==1 ) R = cons(dp_etov(A)[0],R);
                   2085:        }
                   2086:        for ( I = 0, U = []; I < N; I++ ) if ( !member(I,R) ) U = cons(G[I],U);
1.1       noro     2087:        return U;
                   2088: }
                   2089:
1.4       noro     2090: def compute_gbsyz(N,V,Trace,Mod)
1.1       noro     2091: {
                   2092:        P = vector(N);
1.4       noro     2093:        for ( I = 0; I < N; I++ ) P[I] = dp_ptod(x^I,[x]);
                   2094:        for ( U = [], T = Trace; T != []; T = cdr(T) ) {
1.1       noro     2095:                Ti = car(T);
                   2096:                if ( Ti[0] != -1 ) error("Input is not a GB");
1.4       noro     2097:                R = recompute_trace(Ti[1],P,V,Mod);
                   2098:                U = cons(R,U);
1.1       noro     2099:        }
                   2100:        return reverse(U);
                   2101: }
                   2102:
1.4       noro     2103: def recompute_trace(Ti,P,V,Mod)
1.1       noro     2104: {
                   2105:   for ( Num = 0, Den = 1; Ti != []; Ti = cdr(Ti) ) {
1.4       noro     2106:     Sj = car(Ti); Dj = Sj[0]; Ij =Sj[1]; Mj = dp_dtop(Sj[2],V); Cj = Sj[3];
1.1       noro     2107:     /* Num/Den <- (Dj*Num+Den*Mj*P[Ij])/(Den*Cj) */
1.4       noro     2108:     if ( Dj ) Num = (Dj*Num+Den*Mj*P[Ij]);
1.1       noro     2109:     Den *= Cj;
                   2110:   }
1.4       noro     2111:   return Num;
1.1       noro     2112: }
                   2113:
                   2114: def ideal_sat(G,F,V)
                   2115: {
                   2116:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                   2117:        G = nd_gr(G,V,Mod,0);
                   2118:        for ( T = F, L = []; T != []; T = cdr(T) )
                   2119:                L = cons(sat(G,car(T),V|mod=Mod),L);
                   2120:        L = reverse(L);
                   2121:        return ideal_list_intersection(L,V,0|mod=Mod);
                   2122: }
                   2123:
                   2124: def ideal_inclusion(F,G,V,O)
                   2125: {
                   2126:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                   2127:        for ( T = F; T != []; T = cdr(T) )
                   2128:                if ( gen_nf(car(T),G,V,O,Mod) ) return 0;
                   2129:        return 1;
                   2130: }
                   2131:
                   2132: /* remove redundant components */
                   2133:
                   2134: def qd_simp_comp(QP,V)
                   2135: {
                   2136:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                   2137:        R = ltov(QP);
                   2138:        N = length(R);
                   2139:        for ( I = 0; I < N; I++ ) {
                   2140:                if ( R[I] ) {
                   2141:                        QI = R[I][0]; PI = R[I][1];
                   2142:                        for ( J = I+1; J < N; J++ )
                   2143:                                if ( R[J] && gen_gb_comp(PI,R[J][1],Mod) ) {
                   2144:                                        QI = ideal_intersection(QI,R[J][0],V,0|mod=Mod);
                   2145:                                        R[J] = 0;
                   2146:                                }
                   2147:                        R[I] = [QI,PI];
                   2148:                }
                   2149:        }
                   2150:        for ( I = N-1, S = []; I >= 0; I-- )
                   2151:                if ( R[I] ) S = cons(R[I],S);
                   2152:        return S;
                   2153: }
                   2154:
                   2155: def qd_remove_redundant_comp(G,Iso,Emb,V,Ord)
                   2156: {
                   2157:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                   2158:        IsoInt = ideal_list_intersection(map(first,Iso),V,Ord|mod=Mod);
                   2159:        Emb = qd_simp_comp(Emb,V|mod=Mod);
                   2160:        Emb = reverse(qsort(Emb));
                   2161:        A = ltov(Emb); N = length(A);
                   2162:        Pre = IsoInt; Post = vector(N+1);
                   2163:        for ( Post[N] = IsoInt, I = N-1; I >= 1; I-- )
                   2164:                Post[I] = ideal_intersection(Post[I+1],A[I][0],V,Ord|mod=Mod);
                   2165:        for ( I = 0; I < N; I++ ) {
                   2166:                print(".",2);
                   2167:                Int = ideal_intersection(Pre,Post[I+1],V,Ord|mod=Mod);
                   2168:                if ( gen_gb_comp(Int,G,Mod) ) A[I] = 0;
                   2169:                else
                   2170:                        Pre = ideal_intersection(Pre,A[I][0],V,Ord|mod=Mod);
                   2171:        }
                   2172:        for ( T = [], I = 0; I < N; I++ )
                   2173:                if ( A[I] ) T = cons(A[I],T);
                   2174:        return reverse(T);
                   2175: }
                   2176:
                   2177: def pd_simp_comp(PL,V)
                   2178: {
                   2179:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                   2180:        if ( type(First=getopt(first)) == -1 ) First = 0;
                   2181:        A = ltov(PL); N = length(A);
                   2182:        if ( N == 1 )  return PL;
                   2183:        for ( I = 0; I < N; I++ ) {
                   2184:                if ( !A[I] ) continue;
                   2185:                AI = First?A[I][0]:A[I];
                   2186:                for ( J = 0; J < N; J++ ) {
                   2187:                        if ( J == I || !A[J] ) continue;
                   2188:                        AJ = First?A[J][0]:A[J];
                   2189:                        if ( gen_gb_comp(AI,AJ,Mod) || ideal_inclusion(AI,AJ,V,Ord|mod=Mod) )
                   2190:                                A[J] = 0;
                   2191:                }
                   2192:        }
                   2193:        for ( I = 0, T = []; I < N; I++ ) if ( A[I] ) T = cons(A[I],T);
                   2194:        return reverse(T);
                   2195: }
                   2196:
                   2197: def pd_remove_redundant_comp(G,P,V,Ord)
                   2198: {
                   2199:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                   2200:        if ( type(First=getopt(first)) == -1 ) First = 0;
                   2201:        if ( length(P) == 1 )  return P;
                   2202:
                   2203:        A = ltov(P); N = length(A);
                   2204:        for ( I = 0; I < N; I++ ) {
                   2205:                if ( !A[I] ) continue;
                   2206:                for ( J = I+1; J < N; J++ )
                   2207:                        if ( A[J] &&
                   2208:                                gen_gb_comp(First?A[I][0]:A[I],First?A[J][0]:A[J],Mod) ) A[J] = 0;
                   2209:        }
                   2210:        for ( I = 0, T = []; I < N; I++ ) if ( A[I] ) T = cons(A[I],T);
                   2211:        A = ltov(reverse(T)); N = length(A);
                   2212:        Pre = [1]; Post = vector(N+1);
                   2213:        for ( Post[N] = [1], I = N-1; I >= 1; I-- )
                   2214:                Post[I] = ideal_intersection(Post[I+1],First?A[I][0]:A[I],V,Ord|mod=Mod);
                   2215:        for ( I = 0; I < N; I++ ) {
                   2216:                Int = ideal_intersection(Pre,Post[I+1],V,Ord|mod=Mod);
                   2217:                if ( gen_gb_comp(Int,G,Mod) ) A[I] = 0;
                   2218:                else
                   2219:                        Pre = ideal_intersection(Pre,First?A[I][0]:A[I],V,Ord|mod=Mod);
                   2220:        }
                   2221:        for ( T = [], I = 0; I < N; I++ ) if ( A[I] ) T = cons(A[I],T);
                   2222:        return reverse(T);
                   2223: }
                   2224:
                   2225: /* polynomial operations */
                   2226:
                   2227: def ppart(F,V,Mod)
                   2228: {
                   2229:        if ( !Mod )
                   2230:                G = nd_gr([F],[V],0,0);
                   2231:        else
                   2232:                G = dp_gr_mod_main([F],[V],0,Mod,0);
                   2233:        return G[0];
                   2234: }
                   2235:
                   2236:
                   2237: def sq(F,Mod)
                   2238: {
                   2239:        if ( !F ) return 0;
                   2240:        A = cdr(gen_fctr(F,Mod));
                   2241:        for ( R = 1; A != []; A = cdr(A) )
                   2242:                R *= car(car(A));
                   2243:        return R;
                   2244: }
                   2245:
                   2246: def lcfactor(G,V,O,Mod)
                   2247: {
                   2248:        O0 = dp_ord(); dp_ord(O);
                   2249:        C = [];
                   2250:        for ( T = G; T != []; T = cdr(T) ) {
                   2251:                C1 = dp_hc(dp_ptod(car(T),V));
                   2252:                S = gen_fctr(C1,Mod);
                   2253:                for ( S = cdr(S); S != []; S = cdr(S) )
                   2254:                        if ( !member(S[0][0],C) ) C = cons(S[0][0],C);
                   2255:        }
                   2256:        dp_ord(O0);
                   2257:        return C;
                   2258: }
                   2259:
                   2260: def gen_fctr(F,Mod)
                   2261: {
                   2262:        if ( Mod ) return modfctr(F,Mod);
                   2263:        else return fctr(F);
                   2264: }
                   2265:
                   2266: def gen_mptop(F)
                   2267: {
                   2268:        if ( !F ) return F;
                   2269:        else if ( type(F)==1 )
                   2270:                if ( ntype(F)==5 ) return mptop(F);
                   2271:                else return F;
                   2272:        else {
                   2273:                V = var(F);
                   2274:                D = deg(F,V);
                   2275:                for ( R = 0, I = 0; I <= D; I++ )
                   2276:                        if ( C = coef(F,I,V) ) R += gen_mptop(C)*V^I;
                   2277:                return R;
                   2278:        }
                   2279: }
                   2280:
                   2281: def gen_nf(F,G,V,Ord,Mod)
                   2282: {
                   2283:        if ( !Mod ) return p_nf(F,G,V,Ord);
                   2284:
                   2285:        setmod(Mod);
                   2286:        dp_ord(Ord); DF = dp_mod(dp_ptod(F,V),Mod,[]);
                   2287:        N = length(G); DG = newvect(N);
                   2288:        for ( I = N-1, IL = []; I >= 0; I-- ) {
                   2289:                DG[I] = dp_mod(dp_ptod(G[I],V),Mod,[]);
                   2290:                IL = cons(I,IL);
                   2291:        }
                   2292:        T = dp_nf_mod(IL,DF,DG,1,Mod);
                   2293:        for ( R = 0; T; T = dp_rest(T) )
                   2294:                R += gen_mptop(dp_hc(T))*dp_dtop(dp_ht(T),V);
                   2295:        return R;
                   2296: }
                   2297:
                   2298: /* Ti = [D,I,M,C] */
                   2299:
                   2300: def compute_deg0(Ti,P,V,TV)
                   2301: {
                   2302:        N = length(P[0]);
                   2303:        Num = vector(N);
                   2304:        for ( I = 0; I < N; I++ ) Num[I] = -1;
                   2305:        for ( ; Ti != []; Ti = cdr(Ti) ) {
                   2306:                Sj = car(Ti);
                   2307:                Dj = Sj[0];
                   2308:                Ij =Sj[1];
                   2309:                Mj = deg(type(Sj[2])==9?dp_dtop(Sj[2],V):Sj[2],TV);
                   2310:                Pj = P[Ij];
                   2311:                if ( Dj )
                   2312:                        for ( I = 0; I < N; I++ )
                   2313:                                if ( Pj[I] >= 0 ) {
                   2314:                                        T = Mj+Pj[I];
                   2315:                                        Num[I] = MAX(Num[I],T);
                   2316:                                }
                   2317:        }
                   2318:        return Num;
                   2319: }
                   2320:
                   2321: def compute_deg(B,V,TV,Data)
                   2322: {
                   2323:        GB = Data[0];
                   2324:        Homo = Data[1];
                   2325:        Trace = Data[2];
                   2326:        IntRed = Data[3];
                   2327:        Ind = Data[4];
                   2328:        DB = map(dp_ptod,B,V);
                   2329:        if ( Homo ) {
                   2330:                DB = map(dp_homo,DB);
                   2331:                V0 = append(V,[hhh]);
                   2332:        } else
                   2333:                V0 = V;
                   2334:        Perm = Trace[0]; Trace = cdr(Trace);
                   2335:        for ( I = length(Perm)-1, T = Trace; T != []; T = cdr(T) )
                   2336:                if ( (J=car(T)[0]) > I ) I = J;
                   2337:        N = I+1;
                   2338:        N0 = length(B);
                   2339:        P = vector(N);
                   2340:        for ( T = Perm, I = 0; T != []; T = cdr(T), I++ ) {
                   2341:                Pi = car(T);
                   2342:                C = vector(N0);
                   2343:                for ( J = 0; J < N0; J++ ) C[J] = -1;
                   2344:                C[Pi[1]] = 0;
                   2345:                P[Pi[0]] = C;
                   2346:        }
                   2347:        for ( T = Trace; T != []; T = cdr(T) ) {
                   2348:                Ti = car(T); P[Ti[0]] = compute_deg0(Ti[1],P,V0,TV);
                   2349:        }
                   2350:        M = length(Ind);
                   2351:        for ( T = IntRed; T != []; T = cdr(T) ) {
                   2352:                Ti = car(T); P[Ti[0]] = compute_deg0(Ti[1],P,V,TV);
                   2353:        }
                   2354:        R = [];
                   2355:        for ( J = 0; J < M; J++ ) {
                   2356:                U = P[Ind[J]];
                   2357:                R = cons(U,R);
                   2358:        }
                   2359:        return reverse(R);
                   2360: }
                   2361:
                   2362: /* set theoretic functions */
                   2363:
                   2364: def member(A,S)
                   2365: {
                   2366:        for ( ; S != []; S = cdr(S) )
                   2367:                if ( car(S) == A ) return 1;
                   2368:        return 0;
                   2369: }
                   2370:
                   2371: def elimination(G,V) {
                   2372:        for ( R = [], T = G; T != []; T = cdr(T) )
                   2373:                if ( setminus(vars(car(T)),V) == [] ) R =cons(car(T),R);
                   2374:        return R;
                   2375: }
                   2376:
                   2377: def setintersection(A,B)
                   2378: {
                   2379:        for ( L = []; A != []; A = cdr(A) )
                   2380:                if ( member(car(A),B) )
                   2381:                        L = cons(car(A),L);
                   2382:        return L;
                   2383: }
                   2384:
                   2385: def setminus(A,B) {
                   2386:        for ( T = reverse(A), R = []; T != []; T = cdr(T) ) {
                   2387:                for ( S = B, M = car(T); S != []; S = cdr(S) )
                   2388:                        if ( car(S) == M ) break;
                   2389:                if ( S == [] ) R = cons(M,R);
                   2390:        }
                   2391:        return R;
                   2392: }
                   2393:
                   2394: def sep_list(L,N)
                   2395: {
                   2396:        if ( length(L) <= N ) return [L,[]];
                   2397:        R = [];
                   2398:        for ( T = L, I = 0; I < N; I++, T = cdr(T) )
                   2399:                R = cons(car(T),R);
                   2400:        return [reverse(R),T];
                   2401: }
                   2402:
                   2403: def first(L)
                   2404: {
                   2405:        return L[0];
                   2406: }
                   2407:
                   2408: def second(L)
                   2409: {
                   2410:        return L[1];
                   2411: }
                   2412:
                   2413: def third(L)
                   2414: {
                   2415:        return L[2];
                   2416: }
                   2417:
                   2418: def first_second(L)
                   2419: {
                   2420:        return [L[0],L[1]];
                   2421: }
                   2422:
                   2423: def comp_tord(A,B)
                   2424: {
                   2425:        DA = dp_ht(A);
                   2426:        DB = dp_ht(B);
                   2427:        if ( DA > DB ) return 1;
                   2428:        else if ( DA < DB ) return -1;
                   2429:        else return 0;
                   2430: }
                   2431:
                   2432: def comp_tdeg(A,B)
                   2433: {
                   2434:        DA = tdeg(A);
                   2435:        DB = tdeg(B);
                   2436:        if ( DA > DB ) return 1;
                   2437:        else if ( DA < DB ) return -1;
                   2438:        else return 0;
                   2439: }
                   2440:
                   2441: def comp_tdeg_first(A,B)
                   2442: {
                   2443:        DA = tdeg(A[0]);
                   2444:        DB = tdeg(B[0]);
                   2445:        if ( DA > DB ) return 1;
                   2446:        else if ( DA < DB ) return -1;
                   2447:        else return 0;
                   2448: }
                   2449:
                   2450: def comp_third_tdeg(A,B)
                   2451: {
                   2452:        if ( A[2] > B[2] ) return 1;
                   2453:        if ( A[2] < B[2] ) return -1;
                   2454:        DA = tdeg(A[0]);
                   2455:        DB = tdeg(B[0]);
                   2456:        if ( DA > DB ) return 1;
                   2457:        else if ( DA < DB ) return -1;
                   2458:        else return 0;
                   2459: }
                   2460:
                   2461: def tdeg(P)
                   2462: {
                   2463:        dp_ord(0);
                   2464:        return dp_td(dp_ptod(P,vars(P)));
                   2465: }
                   2466:
                   2467: def comp_by_ord(A,B)
                   2468: {
                   2469:        if ( dp_ht(A) > dp_ht(B) ) return 1;
                   2470:        else if ( dp_ht(A) < dp_ht(B) ) return -1;
                   2471:        else return 0;
                   2472: }
                   2473:
                   2474: def comp_by_second(A,B)
                   2475: {
                   2476:        if ( A[1] > B[1] ) return 1;
                   2477:        else if ( A[1] < B[1] ) return -1;
                   2478:        else return 0;
                   2479: }
                   2480:
                   2481: def get_lc(F)
                   2482: {
                   2483:        if ( type(F)==1 ) return F;
                   2484:        V = var(F);
                   2485:        D = deg(F,V);
                   2486:        return get_lc(coef(F,D,V));
                   2487: }
                   2488:
                   2489: def tomonic(F,Mod)
                   2490: {
                   2491:        C = get_lc(F);
                   2492:        IC = inv(C,Mod);
                   2493:        return (IC*F)%Mod;
                   2494: }
                   2495:
                   2496: def gen_gb_comp(A,B,Mod)
                   2497: {
                   2498:        if ( !Mod ) return gb_comp(A,B);
                   2499:        LA = length(A); LB = length(B);
                   2500:        if ( LA != LB ) return 0;
                   2501:        A = map(tomonic,A,Mod);
                   2502:        B = map(tomonic,B,Mod);
                   2503:        A = qsort(A); B = qsort(B);
                   2504:        if ( A != B ) return 0;
                   2505:        return 1;
                   2506: }
                   2507:
                   2508: def prod(L)
                   2509: {
                   2510:        for ( R = 1; L != []; L = cdr(L) )
                   2511:                R *= car(L);
                   2512:        return R;
                   2513: }
                   2514:
                   2515: def monodec0(B,V)
                   2516: {
                   2517:        M = monodec(B,V);
                   2518:        return map(vars,M);
                   2519: }
                   2520:
                   2521: def monodec(B,V)
                   2522: {
                   2523:        B = map(sq,B,0);
                   2524:        G = nd_gr_postproc(B,V,0,0,0);
                   2525:        V = vars(G);
                   2526:        N = length(V);
                   2527:        if ( N == 0 ) return G == [] ? [[]] : [];
                   2528:        if ( N == 1 ) return G;
                   2529:        if ( N < 20 ) {
                   2530:                T = dp_mono_raddec(G,V);
                   2531:                return map(prod,T);
                   2532:        }
                   2533:        X = car(V); W = cdr(V);
                   2534:        D0 = monodec(map(subst,B,X,0),W);
                   2535:        T0 = map(dp_ptod,D0,W);
                   2536:        D1 = monodec(map(subst,B,X,1),W);
                   2537:        T1 = map(dp_ptod,D1,W);
1.4       noro     2538: #if 0
1.1       noro     2539:        for ( T = T1; T != []; T = cdr(T) ) {
                   2540:                for ( M = car(T), S1 = [], S = T0; S != []; S = cdr(S) )
                   2541:                        if ( !dp_redble(car(S),M) ) S1= cons(car(S),S1);
                   2542:                T0 = S1;
                   2543:        }
1.4       noro     2544: #else
                   2545:        T0 = dp_mono_reduce(T0,T1);
                   2546: #endif
1.1       noro     2547:        D0 = map(dp_dtop,T0,W);
                   2548:        D0 = vtol(X*ltov(D0));
                   2549:        return append(D0,D1);
                   2550: }
                   2551:
                   2552: def separator(P,V)
                   2553: {
                   2554:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
                   2555:        N = length(P);
1.4       noro     2556:        dp_ord(0);
                   2557:        DP = vector(N);
                   2558:        for ( I = 0; I < N; I++ ) DP[I] = qsort(ltov(map(dp_ptod,P[I][0],V)),comp_tord);
                   2559:        if ( Mod )
                   2560:                for ( I = 0; I < N; I++ ) DP[I] = map(dp_mod,DP[I],Mod,[]);
                   2561:        Ind = vector(N);
                   2562:        for ( I = 0; I < N; I++ ) {
                   2563:                for ( K = [], J = length(DP[I])-1; J >= 0; J-- ) K = cons(J,K);
                   2564:                Ind[I] = K;
                   2565:        }
                   2566:        S = vector(N);
                   2567:        for ( I = 0; I < N; I++ ) S[I] = 1;
1.1       noro     2568:        for ( I = 0; I < N; I++ ) {
1.4       noro     2569:                print(".",2);
1.1       noro     2570:                for ( J = 0; J < N; J++ ) {
                   2571:                        if ( J == I ) continue;
1.4       noro     2572:                        T = DP[I]; L = length(T);
                   2573:                        if ( Mod ) {
                   2574:                                for ( K = 0; K < L; K++ )
                   2575:                                        if ( dp_nf_mod(Ind[J],T[K],DP[J],0,Mod) ) break;
                   2576:                        } else {
                   2577:                                for ( K = 0; K < L; K++ )
                   2578:                                        if ( dp_nf(Ind[J],T[K],DP[J],0) ) break;
                   2579:                        }
                   2580:                        S[J] = lcm(S[J],dp_dtop(T[K],V));
1.1       noro     2581:                }
                   2582:        }
1.4       noro     2583:        print("");
1.1       noro     2584:        return S;
                   2585: }
                   2586:
                   2587: def prepost(PL,V)
1.4       noro     2588: {
                   2589:        if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1.1       noro     2590:        A = ltov(PL); N = length(A);
                   2591:        Pre = vector(N);
                   2592:        Post = vector(N);
                   2593:        R = vector(N);
                   2594:        Pre[0] = [1];
                   2595:        print("pre ",2);
                   2596:        for ( I = 1; I < N; I++, print(".",2) )
1.4       noro     2597:                Pre[I] = ideal_intersection_m(Pre[I-1],A[I-1],V,0|mod=Mod);
1.1       noro     2598:        print("done");
                   2599:        print("post ",2);
                   2600:        Post[N-1] = [1];
                   2601:        for ( I = N-2; I >= 0; I--, print(".",2) )
1.4       noro     2602:                Post[I] = ideal_intersection_m(Post[I+1],A[I+1],V,0|mod=Mod);
1.1       noro     2603:        print("done");
                   2604:        print("int ",2);
                   2605:        for ( I = 0; I < N; I++, print(".",2) )
1.4       noro     2606:                R[I] = ideal_intersection_m(Pre[I],Post[I],V,0|mod=Mod);
1.1       noro     2607:        print("done");
                   2608:        return R;
                   2609: }
                   2610:
                   2611: /* XXX */
                   2612:
                   2613: def call_func(Arg)
                   2614: {
                   2615:        F = car(Arg);
                   2616:        return call(strtov(F),cdr(Arg));
                   2617: }
                   2618:
                   2619: def competitive_exec(P,Arg0,Arg1)
                   2620: {
                   2621:        P0 = P[0]; P1 = P[1];
                   2622:        ox_cmo_rpc(P0,"noro_pd.call_func",Arg0|sync=1);
                   2623:        ox_cmo_rpc(P1,"noro_pd.call_func",Arg1|sync=1);
                   2624:        F = ox_select(P);
                   2625:        R = ox_get(F[0]);
                   2626:        if ( length(F) == 2 ) {
                   2627:                ox_get(F[1]);
                   2628:        } else {
                   2629:                U = setminus(P,F);
                   2630:                ox_reset(U[0]);
                   2631:        }
                   2632:        return R;
                   2633: }
                   2634:
                   2635:
                   2636: def nd_gr_rat(B,V,PV,Ord1,Ord)
                   2637: {
                   2638:        G = nd_gr(B,append(V,PV),0,Ord1);
                   2639:        G1 = nd_gr_postproc(G,V,0,Ord,0);
                   2640:        return G1;
                   2641: }
                   2642:
                   2643: /* Task[i] = [fname,[arg0,...,argn]] */
                   2644:
                   2645: def para_exec(Proc,Task) {
                   2646:        Free = Proc;
                   2647:        N = length(Task);
                   2648:        R = [];
                   2649:        while ( N ) {
                   2650:                while ( Task != [] && Free != [] ) {
                   2651:                        T = car(Task); Task = cdr(Task);
                   2652:                        ox_cmo_rpc(car(Free),"noro_pd.call_func",T);
                   2653:                        ox_push_cmd(car(Free),258); Free = cdr(Free);
                   2654:                }
                   2655:                Finish0 = Finish = ox_select(Proc);
                   2656:                for ( ; Finish != []; Finish = cdr(Finish) ) {
                   2657:                        print(".",2);
                   2658:                        L = ox_get(car(Finish));
                   2659:                        R = cons(L,R);
                   2660:                        N--;
                   2661:                }
                   2662:                Free = append(Free,Finish0);
                   2663:        }
                   2664:        print("");
                   2665:        return reverse(R);
                   2666: }
1.4       noro     2667:
                   2668: def redbase(B,V,Mod,Ord)
                   2669: {
                   2670:        M = nd_gr_postproc(B,V,Mod,Ord,0);
                   2671:        dp_ord(Ord);
                   2672:        DM = ltov(map(dp_ptod,M,V));
                   2673:        if ( Mod ) DM = map(dp_mod,DM,Mod,[]);
                   2674:        N = length(DM);
                   2675:        for ( Ind = [], I = N-1; I >= 0; I-- ) Ind = cons(I,Ind);
                   2676:        for ( T = B, R = vtol(DM); T != []; T = cdr(T) ) {
                   2677:                D = dp_ptod(car(T),V);
                   2678:                if ( Mod ) D = dp_mod(D,Mod,[]);
                   2679:                D = Mod?dp_nf_mod(Ind,D,DM,1,Mod):dp_nf(Ind,D,DM,1);
                   2680:                if ( D ) R = cons(D,R);
                   2681:        }
                   2682:        D = qsort(R,comp_tord);
                   2683:        return map(dp_dtop,D,V);
                   2684: }
                   2685:
                   2686: def witness(A,B,V)
                   2687: {
                   2688:        G = nd_gr(B,V,0,Mod);
                   2689:        L = length(A);
                   2690:        QL = []; PL = [];
                   2691:        for ( I = L-1; I >= 0; I-- ) {
                   2692:                QL = append(map(first,A[I]),QL);
                   2693:                PL = append(map(second,A[I]),PL);
                   2694:        }
                   2695:        N = length(QL);
                   2696:        Qhat = prepost(QL,V);
                   2697:        for ( I = 0, W = []; I < N; I++ ) {
                   2698:                for ( T = Qhat[I]; T != []; T = cdr(T) )
                   2699:                        if ( gen_nf(car(T),QL[I],V,0,Mod) ) break;
                   2700:                Ai = car(T);
                   2701:                Ji = colon(G,Ai,V|isgb=1,mod=Mod);
                   2702:                Ji = nd_gr(Ji,V,Mod,0);
                   2703:                if ( gen_gb_comp(Ji,PL[I],Mod) ) Bi = 1;
                   2704:                else {
                   2705:                        Ki = ideal_colon(Ji,PL[I],V|mod=Mod);
                   2706:                        for ( T = Ki; T != []; T = cdr(T) )
                   2707:                                if ( gen_nf(car(T),Ji,V,0,Mod) ) break;
                   2708:                        Bi = car(T);
                   2709:                }
                   2710:                W = cons(Ai*Bi,W);
                   2711:                Li = colon(G,W[0],V|isgb=1,mod=Mod);
                   2712:                Li = nd_gr(Li,V,Mod,0);
                   2713:                if ( !gen_gb_comp(Li,PL[I],Mod) )
                   2714:                        error("afo");
                   2715:        }
                   2716:        return reverse(W);
                   2717: }
1.1       noro     2718: endmodule$
                   2719: end$

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