=================================================================== RCS file: /home/cvs/OpenXM/src/asir-contrib/testing/noro/Attic/pd.rr,v retrieving revision 1.3 retrieving revision 1.10 diff -u -p -r1.3 -r1.10 --- OpenXM/src/asir-contrib/testing/noro/Attic/pd.rr 2010/05/10 05:30:18 1.3 +++ OpenXM/src/asir-contrib/testing/noro/Attic/pd.rr 2010/06/19 08:32:37 1.10 @@ -1,6 +1,6 @@ +/* $OpenXM$ */ import("gr")$ module noro_pd$ - static GBCheck,F4,Procs,SatHomo$ localf init_procs, kill_procs, syca_dec, syc_dec, find_separating_ideal0$ @@ -9,18 +9,18 @@ localf sy_dec, pseudo_dec, iso_comp, prima_dec$ localf prime_dec, prime_dec_main, lex_predec1, zprimedec, zprimadec$ localf complete_qdecomp, partial_qdecomp, partial_qdecomp0, complete_decomp$ localf partial_decomp, partial_decomp0, zprimacomp, zprimecomp$ -localf fast_gb, elim_gb, ldim, make_mod_subst$ +localf fast_gb, incremental_gb, elim_gb, ldim, make_mod_subst$ localf rsgn, find_npos, gen_minipoly, indepset$ localf maxindep, contraction, ideal_list_intersection, ideal_intersection$ -localf radical_membership, quick_radical_membership, modular_radical_membership$ +localf radical_membership, modular_radical_membership$ localf radical_membership_rep, ideal_product, saturation$ localf sat, satind, sat_ind, colon$ localf ideal_colon, ideal_sat, ideal_inclusion, qd_simp_comp, qd_remove_redundant_comp$ -localf remove_redundant_comp, remove_redundant_comp_first, ppart, sq$ -localf lcfactor, compute_deg0, compute_deg, member$ +localf pd_remove_redundant_comp, ppart, sq, gen_fctr, gen_nf, gen_gb_comp$ +localf gen_mptop, lcfactor, compute_deg0, compute_deg, member$ localf elimination, setintersection, setminus, sep_list$ localf first_element, comp_tdeg, tdeg, comp_by_ord, comp_by_second$ -localf gbcheck,f4,sathomo$ +localf gbcheck,f4,sathomo,qd_check$ SatHomo=0$ GBCheck=1$ @@ -69,17 +69,28 @@ def kill_procs() } } +def qd_check(B,V,QD) +{ + if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; + G = nd_gr(B,V,Mod,0); + Iso = ideal_list_intersection(map(first_element,QD[0]),V,0|mod=Mod); + Emb = ideal_list_intersection(map(first_element,QD[1]),V,0|mod=Mod); + GG = ideal_intersection(Iso,Emb,V,0|mod=Mod); + return gen_gb_comp(G,GG,Mod); +} + /* SYC primary decomositions */ def syca_dec(B,V) { T00 = time(); + if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; if ( type(Nolexdec=getopt(nolexdec)) == -1 ) Nolexdec = 0; if ( type(SepIdeal=getopt(sepideal)) == -1 ) SepIdeal = 1; if ( type(NoSimp=getopt(nosimp)) == -1 ) NoSimp = 0; if ( type(Time=getopt(time)) == -1 ) Time = 0; Ord = 0; - Gt = G0 = G = fast_gb(B,V,0,Ord); + Gt = G0 = G = fast_gb(B,V,Mod,Ord); Q0 = Q = []; IntQ0 = IntQ = [1]; First = 1; C = 0; @@ -88,56 +99,73 @@ T00 = time(); while ( 1 ) { if ( type(Gt[0])==1 ) break; T0 = time(); - Pt = prime_dec(Gt,V|indep=1,nolexdec=Nolexdec); + PtR = prime_dec(Gt,V|indep=1,nolexdec=Nolexdec,mod=Mod,radical=1); T1 = time(); Tass += T1[0]-T0[0]+T1[1]-T0[1]; Rass += T1[3]-T0[3]; + Pt = PtR[0]; IntPt = PtR[1]; + if ( gen_gb_comp(Gt,IntPt,Mod) ) { + /* Gt is radical and Gt = cap Pt */ + for ( T = Pt, Qt = []; T != []; T = cdr(T) ) + Qt = cons([car(T)[0],car(T)[0]],Qt); + if ( First ) + return [Qt,[]]; + else + Q0 = append(Qt,Q0); + break; + } T0 = time(); - Qt = iso_comp(Gt,Pt,V,Ord); + Qt = iso_comp(Gt,Pt,V,Ord|mod=Mod,isgb=1); T1 = time(); Tiso += T1[0]-T0[0]+T1[1]-T0[1]; Riso += T1[3]-T0[3]; - IntQt = ideal_list_intersection(map(first_element,Qt),V,Ord); - IntPt = ideal_list_intersection(map(first_element,Pt),V,Ord); + IntQt = ideal_list_intersection(map(first_element,Qt),V,Ord|mod=Mod); if ( First ) { IntQ0 = IntQ = IntQt; IntP = IntPt; Qi = Qt; First = 0; } else { - IntQ1 = ideal_intersection(IntQ,IntQt,V,Ord); - if ( gb_comp(IntQ,IntQ1) ) { + IntQ1 = ideal_intersection(IntQ,IntQt,V,Ord|mod=Mod); + if ( gen_gb_comp(IntQ,IntQ1,Mod) ) { G = Gt; IntP = IntPt; Q = []; IntQ = [1]; C = 0; continue; } else { IntQ = IntQ1; - IntQ1 = ideal_intersection(IntQ0,IntQt,V,Ord); - if ( !gb_comp(IntQ0,IntQ1) ) { + IntQ1 = ideal_intersection(IntQ0,IntQt,V,Ord|mod=Mod); + if ( !gen_gb_comp(IntQ0,IntQ1,Mod) ) { + Q = append(Qt,Q); +#if 1 + for ( T = Qt; T != []; T = cdr(T) ) + if ( !ideal_inclusion(IntQ0,car(T)[0],V,Ord|mod=Mod) ) + Q0 = append(Q0,[car(T)]); +#else + Q0 = append(Q0,Qt); +#endif IntQ0 = IntQ1; - Q = append(Qt,Q); Q0 = append(Qt,Q0); } } } - if ( gb_comp(IntQt,Gt) || gb_comp(IntQ,G) || gb_comp(IntQ0,G0) ) break; + if ( gen_gb_comp(IntQt,Gt,Mod) || gen_gb_comp(IntQ,G,Mod) || gen_gb_comp(IntQ0,G0,Mod) ) break; T0 = time(); - C1 = ideal_colon(G,IntQ,V); + C1 = ideal_colon(G,IntQ,V|mod=Mod); T1 = time(); Tcolon += T1[0]-T0[0]+T1[1]-T0[1]; Rcolon += T1[3]-T0[3]; - if ( C && gb_comp(C,C1) ) { + if ( C && gen_gb_comp(C,C1,Mod) ) { G = Gt; IntP = IntPt; Q = []; IntQ = [1]; C = 0; continue; } else C = C1; T0 = time(); if ( SepIdeal == 0 ) - Ok = find_separating_ideal0(C,G,IntQ,IntP,V,Ord); + Ok = find_separating_ideal0(C,G,IntQ,IntP,V,Ord|mod=Mod); else if ( SepIdeal == 1 ) - Ok = find_separating_ideal1(C,G,IntQ,IntP,V,Ord); + Ok = find_separating_ideal1(C,G,IntQ,IntP,V,Ord|mod=Mod); else if ( SepIdeal == 2 ) - Ok = find_separating_ideal2(C,G,IntQ,IntP,V,Ord); + Ok = find_separating_ideal2(C,G,IntQ,IntP,V,Ord|mod=Mod); G1 = append(Ok,G); - Gt1 = fast_gb(G1,V,0,Ord); + Gt1 = incremental_gb(G1,V,Ord|mod=Mod); T1 = time(); Tsep += T1[0]-T0[0]+T1[1]-T0[1]; Rsep += T1[3]-T0[3]; #if 0 - if ( ideal_inclusion(Gt1,Gt,V,Ord) ) { + if ( ideal_inclusion(Gt1,Gt,V,Ord|mod=Mod) ) { G = Gt; IntP = IntPt; Q = []; IntQ = [1]; C = 0; } else #endif Gt = Gt1; } T0 = time(); - if ( !NoSimp ) Q1 = qd_remove_redundant_comp(G0,Qi,Q0,V,Ord); + if ( !NoSimp ) Q1 = qd_remove_redundant_comp(G0,Qi,Q0,V,Ord|mod=Mod); else Q1 = Q0; if ( Time ) { T1 = time(); Tirred += T1[0]-T0[0]+T1[1]-T0[1]; Rirred += T1[3]-T0[3]; @@ -152,50 +180,62 @@ T00 = time(); def syc_dec(B,V) { T00 = time(); + if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; if ( type(Nolexdec=getopt(nolexdec)) == -1 ) Nolexdec = 0; if ( type(SepIdeal=getopt(sepideal)) == -1 ) SepIdeal = 1; if ( type(NoSimp=getopt(nosimp)) == -1 ) NoSimp = 0; if ( type(Time=getopt(time)) == -1 ) Time = 0; Ord = 0; - G = fast_gb(B,V,0,Ord); + G = fast_gb(B,V,Mod,Ord); Q = []; IntQ = [1]; Gt = G; First = 1; Tass = Tiso = Tcolon = Tsep = Tirred = 0; Rass = Riso = Rcolon = Rsep = Rirred = 0; while ( 1 ) { if ( type(Gt[0])==1 ) break; T0 = time(); - Pt = prime_dec(Gt,V|indep=1,nolexdec=Nolexdec); + PtR = prime_dec(Gt,V|indep=1,nolexdec=Nolexdec,mod=Mod,radical=1); T1 = time(); Tass += T1[0]-T0[0]+T1[1]-T0[1]; Rass += T1[3]-T0[3]; + Pt = PtR[0]; IntPt = PtR[1]; + if ( gen_gb_comp(Gt,IntPt,Mod) ) { + /* Gt is radical and Gt = cap Pt */ + for ( T = Pt, Qt = []; T != []; T = cdr(T) ) + Qt = cons([car(T)[0],car(T)[0]],Qt); + if ( First ) + return [Qt,[]]; + else + Q = append(Qt,Q); + break; + } + T0 = time(); - Qt = iso_comp(Gt,Pt,V,Ord); + Qt = iso_comp(Gt,Pt,V,Ord|mod=Mod,isgb=1); T1 = time(); Tiso += T1[0]-T0[0]+T1[1]-T0[1]; Riso += T1[3]-T0[3]; - IntQt = ideal_list_intersection(map(first_element,Qt),V,Ord); - IntPt = ideal_list_intersection(map(first_element,Pt),V,Ord); + IntQt = ideal_list_intersection(map(first_element,Qt),V,Ord|mod=Mod); if ( First ) { IntQ = IntQt; Qi = Qt; First = 0; } else { - IntQ1 = ideal_intersection(IntQ,IntQt,V,Ord); - if ( !gb_comp(IntQ1,IntQ) ) + IntQ1 = ideal_intersection(IntQ,IntQt,V,Ord|mod=Mod); + if ( !gen_gb_comp(IntQ1,IntQ,Mod) ) Q = append(Qt,Q); } - if ( gb_comp(IntQ,G) || gb_comp(IntQt,Gt) ) + if ( gen_gb_comp(IntQ,G,Mod) || gen_gb_comp(IntQt,Gt,Mod) ) break; T0 = time(); - C = ideal_colon(Gt,IntQt,V); + C = ideal_colon(Gt,IntQt,V|mod=Mod); T1 = time(); Tcolon += T1[0]-T0[0]+T1[1]-T0[1]; Rcolon += T1[3]-T0[3]; T0 = time(); if ( SepIdeal == 0 ) - Ok = find_separating_ideal0(C,Gt,IntQt,IntPt,V,Ord); + Ok = find_separating_ideal0(C,Gt,IntQt,IntPt,V,Ord|mod=Mod); else if ( SepIdeal == 1 ) - Ok = find_separating_ideal1(C,Gt,IntQt,IntPt,V,Ord); + Ok = find_separating_ideal1(C,Gt,IntQt,IntPt,V,Ord|mod=Mod); else if ( SepIdeal == 2 ) - Ok = find_separating_ideal2(C,Gt,IntQt,IntPt,V,Ord); + Ok = find_separating_ideal2(C,Gt,IntQt,IntPt,V,Ord|mod=Mod); G1 = append(Ok,Gt); - Gt = fast_gb(G1,V,0,Ord); + Gt = incremental_gb(G1,V,Ord|mod=Mod); T1 = time(); Tsep += T1[0]-T0[0]+T1[1]-T0[1]; Rsep += T1[3]-T0[3]; } T0 = time(); - if ( !NoSimp ) Q1 = qd_remove_redundant_comp(G,Qi,Q,V,Ord); + if ( !NoSimp ) Q1 = qd_remove_redundant_comp(G,Qi,Q,V,Ord|mod=Mod); else Q1 = Q; T1 = time(); Tirred += T1[0]-T0[0]+T1[1]-T0[1]; Rirred += T1[3]-T0[3]; Tall = T1[0]-T00[0]+T1[1]-T00[1]; Rall += T1[3]-T00[3]; @@ -207,95 +247,140 @@ T00 = time(); return [Qi,Q1]; } +/* XXX */ /* C=G:Q, Rad=rad(Q), return J s.t. Q cap (G+J) = G */ def find_separating_ideal0(C,G,Q,Rad,V,Ord) { + if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; for ( CI = C, I = 1; ; I++ ) { for ( T = CI, S = []; T != []; T = cdr(T) ) - if ( nd_nf(car(T),Q,V,Ord,0) ) S = cons(car(T),S); + if ( gen_nf(car(T),Q,V,Ord,Mod) ) S = cons(car(T),S); if ( S == [] ) error("find_separating_ideal0 : cannot happen"); G1 = append(S,G); - Int = ideal_intersection(G1,Q,V,Ord); + Int = ideal_intersection(G1,Q,V,Ord|mod=Mod); /* check whether (Q cap (G+S)) = G */ - if ( gb_comp(Int,G) ) return reverse(S); - CI = ideal_product(CI,C,V); + if ( gen_gb_comp(Int,G,Mod) ) return reverse(S); + CI = ideal_product(CI,C,V|mod=Mod); } } def find_separating_ideal1(C,G,Q,Rad,V,Ord) { + if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; for ( T = C, S = []; T != []; T = cdr(T) ) - if ( nd_nf(car(T),Q,V,Ord,0) ) S = cons(car(T),S); + if ( gen_nf(car(T),Q,V,Ord,Mod) ) S = cons(car(T),S); if ( S == [] ) error("find_separating_ideal1 : cannot happen"); G1 = append(S,G); - Int = ideal_intersection(G1,Q,V,Ord); + Int = ideal_intersection(G1,Q,V,Ord|mod=Mod); /* check whether (Q cap (G+S)) = G */ - if ( gb_comp(Int,G) ) return reverse(S); + if ( gen_gb_comp(Int,G,Mod) ) return reverse(S); + /* or qsort(C,comp_tdeg) */ C = qsort(S,comp_tdeg); + + Tmp = ttttt; TV = cons(Tmp,V); Ord1 = [[0,1],[Ord,length(V)]]; + Int0 = incremental_gb(append(vtol(ltov(G)*Tmp),vtol(ltov(Q)*(1-Tmp))), + TV,Ord1|gbblock=[[0,length(G)]],mod=Mod); + Dp = dp_gr_print(); dp_gr_print(0); for ( T = C, S = []; T != []; T = cdr(T) ) { - if ( !nd_nf(car(T),Rad,V,Ord,0) ) continue; + if ( !gen_nf(car(T),Rad,V,Ord,Mod) ) continue; Ui = U = car(T); for ( I = 1; ; I++ ) { G1 = cons(Ui,G); - Int = ideal_intersection(G1,Q,V,Ord); - if ( gb_comp(Int,G) ) break; + Int = ideal_intersection(G1,Q,V,Ord|mod=Mod); + if ( gen_gb_comp(Int,G,Mod) ) break; else - Ui = nd_nf(Ui*U,G,V,Ord,0); + Ui = gen_nf(Ui*U,G,V,Ord,Mod); } - if ( length(S) ) { - G1 = append(cons(Ui,S),G); - Int = ideal_intersection(G1,Q,V,Ord); - if ( !gb_comp(Int,G) ) - break; + print([length(T),I],2); + Int1 = incremental_gb(append(Int0,[Tmp*Ui]),TV,Ord1 + |gbblock=[[0,length(Int0)]],mod=Mod); + Int = elimination(Int1,V); + if ( !gen_gb_comp(Int,G,Mod) ) { + break; + } else { + Int0 = Int1; + S = cons(Ui,S); } - S = cons(Ui,S); } + print(""); + dp_gr_print(Dp); return reverse(S); } def find_separating_ideal2(C,G,Q,Rad,V,Ord) { + if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; for ( T = C, S = []; T != []; T = cdr(T) ) - if ( nd_nf(car(T),Q,V,Ord,0) ) S = cons(car(T),S); + if ( gen_nf(car(T),Q,V,Ord,Mod) ) S = cons(car(T),S); if ( S == [] ) error("find_separating_ideal2 : cannot happen"); G1 = append(S,G); - Int = ideal_intersection(G1,Q,V,Ord); + Int = ideal_intersection(G1,Q,V,Ord|mod=Mod); /* check whether (Q cap (G+S)) = G */ - if ( gb_comp(Int,G) ) return reverse(S); + if ( gen_gb_comp(Int,G,Mod) ) return reverse(S); + /* or qsort(S,comp_tdeg) */ C = qsort(C,comp_tdeg); + Dp = dp_gr_print(); dp_gr_print(0); for ( T = C, S = []; T != []; T = cdr(T) ) { - if ( !nd_nf(car(T),Rad,V,Ord,0) ) continue; + if ( !gen_nf(car(T),Rad,V,Ord,Mod) ) continue; Ui = U = car(T); for ( I = 1; ; I++ ) { - G1 = cons(Ui,G); - Int = ideal_intersection(G1,Q,V,Ord); - if ( gb_comp(Int,G) ) break; + G1 = append(G,[Ui]); + Int = ideal_intersection(G1,Q,V,Ord|mod=Mod, + gbblock=[[0,length(G)],[length(G1),length(Q)]]); + if ( gen_gb_comp(Int,G,Mod) ) break; else - Ui = nd_nf(Ui*U,G,V,Ord,0); + Ui = gen_nf(Ui*U,G,V,Ord,Mod); } + print([length(T),I],2); S = cons(Ui,S); } - S = reverse(S); - Len = length(S); - Ok = [S[0]]; - if ( Len > 1 ) { - K = 2; - while ( 1 ) { - for ( St = [], I = 0; I < K; I++ ) St = cons(S[I],St); - G1 = append(St,G); - Int = ideal_intersection(G1,Q,V,Ord); - if ( !gb_comp(Int,G) ) break; - Ok = St; - if ( K == Len ) break; - else { - K = 2*K; - if ( K > Len ) K = Len; + print(""); + S = qsort(S,comp_tdeg); + End = Len = length(S); + + Tmp = ttttt; TV = cons(Tmp,V); Ord1 = [[0,1],[Ord,length(V)]]; + Prev = 1; + G1 = append(G,[S[0]]); + Int0 = incremental_gb(append(vtol(ltov(G1)*Tmp),vtol(ltov(Q)*(1-Tmp))), + TV,Ord1|gbblock=[[0,length(G)]],mod=Mod); + if ( End > 1 ) { + Cur = 2; + while ( Prev < Cur ) { + for ( St = [], I = Prev; I < Cur; I++ ) St = cons(Tmp*S[I],St); + Int1 = incremental_gb(append(Int0,St),TV,Ord1 + |gbblock=[[0,length(Int0)]],mod=Mod); + Int = elimination(Int1,V); + if ( gen_gb_comp(Int,G,Mod) ) { + print([Cur],2); + Prev = Cur; + Cur = Cur+idiv(End-Cur+1,2); + Int0 = Int1; + } else { + End = Cur; + Cur = Prev + idiv(Cur-Prev,2); } } + for ( St = [], I = 0; I < Prev; I++ ) St = cons(S[I],St); + } else + St = [S[0]]; + print(""); + for ( I = Prev; I < Len; I++ ) { + Int1 = incremental_gb(append(Int0,[Tmp*S[I]]),TV,Ord1 + |gbblock=[[0,length(Int0)]],mod=Mod); + Int = elimination(Int1,V); + if ( gen_gb_comp(Int,G,Mod) ) { + print([I],2); + St = cons(S[I],St); + Int0 = Int1; + } } + Ok = reverse(St); + print(""); + print([length(S),length(Ok)]); + dp_gr_print(Dp); return Ok; } @@ -303,43 +388,46 @@ def find_separating_ideal2(C,G,Q,Rad,V,Ord) { def sy_dec(B,V) { + if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; if ( type(Nolexdec=getopt(nolexdec)) == -1 ) Nolexdec = 0; Ord = 0; - G = fast_gb(B,V,0,Ord); + G = fast_gb(B,V,Mod,Ord); Q = []; IntQ = [1]; Gt = G; First = 1; while ( 1 ) { if ( type(Gt[0]) == 1 ) break; - Pt = prime_dec(Gt,V|indep=1,nolexdec=Nolexdec); - L = pseudo_dec(Gt,Pt,V,Ord); + Pt = prime_dec(Gt,V|indep=1,nolexdec=Nolexdec,mod=Mod); + L = pseudo_dec(Gt,Pt,V,Ord|mod=Mod); Qt = L[0]; Rt = L[1]; St = L[2]; - IntQt = ideal_list_intersection(Qt,V,Ord); + IntQt = ideal_list_intersection(map(first_element,Qt),V,Ord|mod=Mod); if ( First ) { IntQ = IntQt; Qi = Qt; First = 0; } else { - IntQ = ideal_intersection(IntQ,IntQt,V,Ord); + IntQ = ideal_intersection(IntQ,IntQt,V,Ord|mod=Mod); Q = append(Qt,Q); } - if ( gb_comp(IntQ,G) ) break; + if ( gen_gb_comp(IntQ,G,Mod) ) break; for ( T = Rt; T != []; T = cdr(T) ) { if ( type(car(T)[0]) == 1 ) continue; - U = sy_dec(car(T),V|nolexdec=Nolexdec); - IntQ = ideal_list_intersection(cons(IntQ,U),V,Ord); + U = sy_dec(car(T),V|nolexdec=Nolexdec,mod=Mod); + IntQ = ideal_list_intersection(cons(IntQ,map(first_element,U)), + V,Ord|mod=Mod); Q = append(U,Q); - if ( gb_comp(IntQ,G) ) break; + if ( gen_gb_comp(IntQ,G,Mod) ) break; } - Gt = fast_gb(append(Gt,St),V,0,Ord); + Gt = fast_gb(append(Gt,St),V,Mod,Ord); } - Q = remove_redundant_comp(G,Qi,Q,V,Ord); + Q = qd_remove_redundant_comp(G,Qi,Q,V,Ord|mod=Mod); return append(Qi,Q); } def pseudo_dec(G,L,V,Ord) { + if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; N = length(L); S = vector(N); Q = vector(N); @@ -347,53 +435,56 @@ def pseudo_dec(G,L,V,Ord) L0 = map(first_element,L); for ( I = 0; I < N; I++ ) { LI = setminus(L0,[L0[I]]); - PI = ideal_list_intersection(LI,V,Ord); + PI = ideal_list_intersection(LI,V,Ord|mod=Mod); PI = qsort(PI,comp_tdeg); for ( T = PI; T != []; T = cdr(T) ) - if ( p_nf(car(T),L0[I],V,Ord) ) break; + if ( gen_nf(car(T),L0[I],V,Ord,Mod) ) break; if ( T == [] ) error("separator : cannot happen"); - SI = sat_ind(G,car(T),V); + SI = satind(G,car(T),V|mod=Mod); QI = SI[0]; S[I] = car(T)^SI[1]; PV = L[I][1]; V0 = setminus(V,PV); #if 0 - GI = fast_gb(QI,append(V0,PV),0, + GI = fast_gb(QI,append(V0,PV),Mod, [[Ord,length(V0)],[Ord,length(PV)]]); #else - GI = fast_gb(QI,append(V0,PV),0, + GI = fast_gb(QI,append(V0,PV),Mod, [[2,length(V0)],[Ord,length(PV)]]); #endif - LCFI = lcfactor(GI,V0,Ord); + LCFI = lcfactor(GI,V0,Ord,Mod); for ( F = 1, T = LCFI, Gt = QI; T != []; T = cdr(T) ) { - St = sat_ind(Gt,T[0],V); + St = satind(Gt,T[0],V|mod=Mod); Gt = St[0]; F *= T[0]^St[1]; } - Q[I] = Gt; - R[I] = fast_gb(cons(F,QI),V,0,Ord); + Q[I] = [Gt,L0[I]]; + R[I] = fast_gb(cons(F,QI),V,Mod,Ord); } return [vtol(Q),vtol(R),vtol(S)]; } def iso_comp(G,L,V,Ord) { + if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; + if ( type(IsGB=getopt(isgb)) == -1 ) IsGB = 0; N = length(L); S = vector(N); Ind = vector(N); Q = vector(N); L0 = map(first_element,L); + if ( !IsGB ) G = nd_gr(G,V,Mod,Ord); for ( I = 0; I < N; I++ ) { LI = setminus(L0,[L0[I]]); - PI = ideal_list_intersection(LI,V,Ord); + PI = ideal_list_intersection(LI,V,Ord|mod=Mod); for ( T = PI; T != []; T = cdr(T) ) - if ( p_nf(car(T),L0[I],V,Ord) ) break; + if ( gen_nf(car(T),L0[I],V,Ord,Mod) ) break; if ( T == [] ) error("separator : cannot happen"); S[I] = car(T); - QI = sat(G,S[I],V); + QI = sat(G,S[I],V|isgb=1,mod=Mod); PV = L[I][1]; V0 = setminus(V,PV); - GI = elim_gb(QI,V0,PV,0,[[0,length(V0)],[0,length(PV)]]); - Q[I] = [contraction(GI,V0),L0[I]]; + GI = elim_gb(QI,V0,PV,Mod,[[0,length(V0)],[0,length(PV)]]); + Q[I] = [contraction(GI,V0|mod=Mod),L0[I]]; } return vtol(Q); } @@ -402,71 +493,78 @@ def iso_comp(G,L,V,Ord) def prima_dec(B,V) { - G = nd_gr_trace(B,V,1,GBCheck,0); - G0 = G; + if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; + if ( type(Ord=getopt(ord)) == -1 ) Ord = 0; + G0 = fast_gb(B,V,Mod,0); + G = fast_gb(G0,V,Mod,Ord); IntP = [1]; QD = []; while ( 1 ) { - if ( ideal_inclusion(IntP,G0,V,0) ) - return QD; - W = maxindep(G,V,0); NP = length(W); + if ( type(G[0])==1 || ideal_inclusion(IntP,G0,V,0|mod=Mod) ) + break; + W = maxindep(G,V,Ord); NP = length(W); V0 = setminus(V,W); N = length(V0); V1 = append(V0,W); - G1 = fast_gb(G,V1,0,[[0,N],[0,NP]]); - LCF = lcfactor(G1,V0,0); - L = zprimacomp(G,V0); + G1 = fast_gb(G,V1,Mod,[[Ord,N],[Ord,NP]]); + LCF = lcfactor(G1,V0,Ord,Mod); + L = zprimacomp(G,V0|mod=Mod); F = 1; - for ( T = LCF, G2 = G1; T != []; T = cdr(T) ) { - S = sat_ind(G2,T[0],V1); + for ( T = LCF, G2 = G; T != []; T = cdr(T) ) { + S = satind(G2,T[0],V1|mod=Mod); G2 = S[0]; F *= T[0]^S[1]; } for ( T = L, QL = []; T != []; T = cdr(T) ) QL = cons(car(T)[0],QL); - Int = ideal_list_intersection(QL,V,0); - IntP = ideal_intersection(IntP,Int,V,0); + Int = ideal_list_intersection(QL,V,0|mod=Mod); + IntP = ideal_intersection(IntP,Int,V,0|mod=Mod); QD = append(QD,L); - F = p_nf(F,G,V,0); - G = cons(F,G); + F = gen_nf(F,G,V,0,Mod); + G = fast_gb(cons(F,G),V,Mod,Ord); } + QD = qd_remove_redundant_comp(G0,[],QD,V,0); + return QD; } /* SL prime decomposition */ def prime_dec(B,V) { + if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; if ( type(Indep=getopt(indep)) == -1 ) Indep = 0; if ( type(NoLexDec=getopt(nolexdec)) == -1 ) NoLexDec = 0; - B = map(sq,B); + if ( type(Rad=getopt(radical)) == -1 ) Rad = 0; + B = map(sq,B,Mod); if ( !NoLexDec ) - PD = lex_predec1(B,V); + PD = lex_predec1(B,V|mod=Mod); else PD = [B]; - G = ideal_list_intersection(PD,V,0); - PD = remove_redundant_comp(G,[],PD,V,0); + G = ideal_list_intersection(PD,V,0|mod=Mod); + PD = pd_remove_redundant_comp(G,PD,V,0|mod=Mod); R = []; for ( T = PD; T != []; T = cdr(T) ) - R = append(prime_dec_main(car(T),V|indep=Indep),R); + R = append(prime_dec_main(car(T),V|indep=Indep,mod=Mod),R); if ( Indep ) { - G = ideal_list_intersection(map(first_element,R),V,0); - R = remove_redundant_comp_first(G,R,V,0); + G = ideal_list_intersection(map(first_element,R),V,0|mod=Mod); + if ( !NoLexDec ) R = pd_remove_redundant_comp(G,R,V,0|first=1,mod=Mod); } else { - G = ideal_list_intersection(R,V,0); - R = remove_redundant_comp(G,[],R,V,0); + G = ideal_list_intersection(R,V,0|mod=Mod); + if ( !NoLexDec ) R = pd_remove_redundant_comp(G,R,V,0|mod=Mod); } - return R; + return Rad ? [R,G] : R; } def prime_dec_main(B,V) { + if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; if ( type(Indep=getopt(indep)) == -1 ) Indep = 0; - G = nd_gr_trace(B,V,1,GBCheck,0); + G = fast_gb(B,V,Mod,0); IntP = [1]; PD = []; while ( 1 ) { /* rad(G) subset IntP */ /* check if IntP subset rad(G) */ for ( T = IntP; T != []; T = cdr(T) ) { - if ( (GNV = modular_radical_membership(car(T),G,V)) ) { + if ( (GNV = modular_radical_membership(car(T),G,V|mod=Mod)) ) { F = car(T); break; } @@ -474,20 +572,20 @@ def prime_dec_main(B,V) if ( T == [] ) return PD; /* GNV = [GB(),NV] */ - G1 = nd_gr_trace(GNV[0],cons(GNV[1],V),1,GBCheck,[[0,1],[0,length(V)]]); + G1 = fast_gb(GNV[0],cons(GNV[1],V),Mod,[[0,1],[0,length(V)]]); G0 = elimination(G1,V); - PD0 = zprimecomp(G0,V,Indep); + PD0 = zprimecomp(G0,V,Indep|mod=Mod); if ( Indep ) { - Int = ideal_list_intersection(PD0[0],V,0); + Int = ideal_list_intersection(PD0[0],V,0|mod=Mod); IndepSet = PD0[1]; for ( PD1 = [], T = PD0[0]; T != []; T = cdr(T) ) PD1 = cons([car(T),IndepSet],PD1); PD = append(PD,reverse(PD1)); } else { - Int = ideal_list_intersection(PD0,V,0); + Int = ideal_list_intersection(PD0,V,0|mod=Mod); PD = append(PD,PD0); } - IntP = ideal_intersection(IntP,Int,V,0); + IntP = ideal_intersection(IntP,Int,V,0|mod=Mod); } } @@ -495,14 +593,15 @@ def prime_dec_main(B,V) def lex_predec1(B,V) { - G = nd_gr_trace(B,V,1,GBCheck,2); + if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; + G = fast_gb(B,V,Mod,2); for ( T = G; T != []; T = cdr(T) ) { - F = fctr(car(T)); + F = gen_fctr(car(T),Mod); if ( length(F) > 2 || length(F) == 2 && F[1][1] > 1 ) { for ( R = [], S = cdr(F); S != []; S = cdr(S) ) { Ft = car(S)[0]; - Gt = map(ptozp,map(p_nf,G,[Ft],V,0)); - R1 = nd_gr_trace(cons(Ft,Gt),V,1,GBCheck,0); + Gt = map(ptozp,map(gen_nf,G,[Ft],V,0,Mod)); + R1 = fast_gb(cons(Ft,Gt),V,Mod,0); R = cons(R1,R); } return R; @@ -716,7 +815,7 @@ def partial_decomp0(GD,V,PV,Ord,I,Mod) Mt = car(car(T)); D1 = D*1; D1[I] = Mt; - GIt = map(p_nf,GI,[Mt],V,Ord); + GIt = map(gen_nf,GI,[Mt],V,Ord,Mod); G1 = cons(Mt,GIt); Gelim = elim_gb(G1,V,PV,Mod,Ord); D1[N] = LD = ldim(Gelim,V); @@ -733,34 +832,36 @@ def partial_decomp0(GD,V,PV,Ord,I,Mod) /* prime/primary components over rational function field */ def zprimacomp(G,V) { - L = zprimadec(G,V,0); + if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; + L = zprimadec(G,V,0|mod=Mod); R = []; dp_ord(0); for ( T = L; T != []; T = cdr(T) ) { S = car(T); - UQ = contraction(S[0],V); - UP = contraction(S[1],V); + UQ = contraction(S[0],V|mod=Mod); + UP = contraction(S[1],V|mod=Mod); R = cons([UQ,UP],R); } return R; } def zprimecomp(G,V,Indep) { - W = maxindep(G,V,0); + if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; + W = maxindep(G,V,0|mod=Mod); V0 = setminus(V,W); V1 = append(V0,W); #if 0 O1 = [[0,length(V0)],[0,length(W)]]; - G1 = nd_gr_trace(G,V1,1,GBCheck,O1); + G1 = fast_gb(G,V1,Mod,O1); dp_ord(0); #else G1 = G; #endif - PD = zprimedec(G1,V0,0); + PD = zprimedec(G1,V0,Mod); dp_ord(0); R = []; for ( T = PD; T != []; T = cdr(T) ) { - U = contraction(car(T),V0); + U = contraction(car(T),V0|mod=Mod); R = cons(U,R); } if ( Indep ) return [R,W]; @@ -769,18 +870,38 @@ def zprimecomp(G,V,Indep) { def fast_gb(B,V,Mod,Ord) { - NoRA = (NoRA=getopt(nora))&&type(NoRA)!=-1 ? 1 : 0; + if ( type(Block=getopt(gbblock)) == -1 ) Block = 0; + if ( type(NoRA=getopt(nora)) == -1 ) NoRA = 0; if ( Mod ) G = nd_f4(B,V,Mod,Ord|nora=NoRA); - else { - if ( F4 ) - G = map(ptozp,f4_chrem(B,V,Ord)); - else - G = nd_gr_trace(B,V,1,GBCheck,Ord|nora=NoRA); - } + else if ( F4 ) + G = map(ptozp,f4_chrem(B,V,Ord)); + else if ( Block ) + G = nd_gr_trace(B,V,1,GBCheck,Ord|nora=NoRA,gbblock=Block); + else + G = nd_gr_trace(B,V,1,GBCheck,Ord|nora=NoRA); return G; } +def incremental_gb(A,V,Ord) +{ + if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; + if ( type(Block=getopt(gbblock)) == -1 ) Block = 0; + if ( Mod ) { + if ( Block ) + G = nd_gr(A,V,Mod,Ord|gbblock=Block); + else + G = nd_gr(A,V,Mod,Ord); + } else if ( Procs ) { + Arg0 = ["nd_gr",A,V,0,Ord]; + Arg1 = ["nd_gr_trace",A,V,1,GBCheck,Ord]; + G = competitive_exec(Procs,Arg0,Arg1); + } else if ( Block ) + G = nd_gr(A,V,0,Ord|gbblock=Block); + else + G = nd_gr(A,V,0,Ord); + return G; +} def elim_gb(G,V,PV,Mod,Ord) { @@ -788,9 +909,12 @@ def elim_gb(G,V,PV,Mod,Ord) O1 = [[0,N],[0,PN]]; if ( Ord == O1 ) Ord = Ord[0][0]; - if ( Mod ) /* XXX */ + if ( Mod ) /* XXX */ { + for ( T = G, H = []; T != []; T = cdr(T) ) + if ( car(T) ) H = cons(car(T),H); + G = reverse(H); G = dp_gr_mod_main(G,V,0,Mod,Ord); - else if ( Procs ) { + } else if ( Procs ) { Arg0 = ["nd_gr_trace",G,V,1,GBCheck,Ord]; Arg1 = ["nd_gr_trace_rat",G,V,PV,1,GBCheck,O1,Ord]; G = competitive_exec(Procs,Arg0,Arg1); @@ -807,6 +931,8 @@ def ldim(G,V) return D; } +/* over Q only */ + def make_mod_subst(GD,V,PV,HC) { N = length(V); @@ -888,7 +1014,8 @@ def gen_minipoly(G,V,PV,Ord,VI,Mod) } #elif 1 if ( Mod ) { - G = nd_gr(G,V1,Mod,[[0,length(W)],[0,length(PV1)]]|nora=1); + V1 = append(W,PV1); + G = nd_gr(G,V1,Mod,[[0,length(W)],[0,length(PV1)]]); G = elimination(G,PV1); } else { PV2 = setminus(PV1,[PV1[length(PV1)-1]]); @@ -932,7 +1059,8 @@ def indepset(V,H) def maxindep(B,V,O) { - G = nd_gr_trace(B,V,1,GBCheck,O); + if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; + G = fast_gb(B,V,Mod,O); Old = dp_ord(); dp_ord(O); H = map(dp_dtop,map(dp_ht,map(dp_ptod,G,V)),V); @@ -955,10 +1083,11 @@ def maxindep(B,V,O) /* ideal operations */ def contraction(G,V) { + if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; C = []; for ( T = G; T != []; T = cdr(T) ) { C1 = dp_hc(dp_ptod(car(T),V)); - S = fctr(C1); + S = gen_fctr(C1,Mod); for ( S = cdr(S); S != []; S = cdr(S) ) if ( !member(S[0][0],C) ) C = cons(S[0][0],C); } @@ -968,7 +1097,7 @@ def contraction(G,V) NV = ttttt; for ( T = C, S = 1; T != []; T = cdr(T) ) S *= car(T); - G = saturation([G,NV],S,W); + G = saturation([G,NV],S,W|mod=Mod); return G; } @@ -992,10 +1121,14 @@ def ideal_intersection(A,B,V,Ord) if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; if ( type(Block=getopt(gbblock)) == -1 ) Block = 0; T = ttttt; - if ( Mod ) - G = nd_gr(append(vtol(ltov(A)*T),vtol(ltov(B)*(1-T))), - cons(T,V),Mod,[[0,1],[Ord,length(V)]]); - else + if ( Mod ) { + if ( Block ) + G = nd_gr(append(vtol(ltov(A)*T),vtol(ltov(B)*(1-T))), + cons(T,V),Mod,[[0,1],[Ord,length(V)]]|gbblock=Block,nora=1); + else + G = nd_gr(append(vtol(ltov(A)*T),vtol(ltov(B)*(1-T))), + cons(T,V),Mod,[[0,1],[Ord,length(V)]]|nora=1); + } else if ( Procs ) { Arg0 = ["nd_gr", append(vtol(ltov(A)*T),vtol(ltov(B)*(1-T))), @@ -1007,37 +1140,35 @@ def ideal_intersection(A,B,V,Ord) } else { if ( Block ) G = nd_gr(append(vtol(ltov(A)*T),vtol(ltov(B)*(1-T))), - cons(T,V),0,[[0,1],[Ord,length(V)]]|gbblock=Block); + cons(T,V),0,[[0,1],[Ord,length(V)]]|gbblock=Block,nora=0); else G = nd_gr(append(vtol(ltov(A)*T),vtol(ltov(B)*(1-T))), - cons(T,V),0,[[0,1],[Ord,length(V)]]); + cons(T,V),0,[[0,1],[Ord,length(V)]]|nora=0); } G0 = elimination(G,V); + if ( 0 && !Procs ) + G0 = nd_gr_postproc(G0,V,Mod,Ord,0); return G0; } /* returns GB if F notin rad(G) */ def radical_membership(F,G,V) { - F = p_nf(F,G,V,0); + if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; + F = gen_nf(F,G,V,0,Mod); if ( !F ) return 0; NV = ttttt; - T = nd_gr_trace(cons(NV*F-1,G),cons(NV,V),1,GBCheck,0); + T = fast_gb(cons(NV*F-1,G),cons(NV,V),Mod,0); if ( type(car(T)) != 1 ) return [T,NV]; else return 0; } -def quick_radical_membership(F,G,V) { - F = p_nf(F,G,V,0); - if ( !F ) return 1; - NV = ttttt; - T = nd_f4(cons(NV*F-1,G),cons(NV,V),lprime(0),0); - if ( type(car(T)) != 1 ) return 0; - else return 1; -} - def modular_radical_membership(F,G,V) { - F = p_nf(F,G,V,0); + if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; + if ( Mod ) + return radical_membership(F,G,V|mod=Mod); + + F = gen_nf(F,G,V,0,0); if ( !F ) return 0; NV = ttttt; for ( J = 0; ; J++ ) { @@ -1060,7 +1191,7 @@ def radical_membership_rep(F,G,V,Max,Ord,Mod) { Ft = F; I = 1; while ( Max < 0 || I <= Max ) { - Ft = nd_nf(Ft,G,V,Ord,Mod); + Ft = gen_nf(Ft,G,V,Ord,Mod); if ( !Ft ) return I; Ft *= F; I++; @@ -1070,6 +1201,7 @@ def radical_membership_rep(F,G,V,Max,Ord,Mod) { def ideal_product(A,B,V) { + if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; dp_ord(0); DA = map(dp_ptod,A,V); DB = map(dp_ptod,B,V); @@ -1090,20 +1222,23 @@ def ideal_product(A,B,V) Len = length(A)>length(B)?length(A):length(B); Len *= 2; L = sep_list(T,Len); B0 = L[0]; B1 = L[1]; - R = nd_gr_trace(B0,V,0,-1,0); + R = fast_gb(B0,V,Mod,0); while ( B1 != [] ) { print(length(B1)); L = sep_list(B1,Len); B0 = L[0]; B1 = L[1]; - R = nd_gr_trace(append(R,B0),V,0,-1,0|gbblock=[[0,length(R)]],nora=1); + R = fast_gb(append(R,B0),V,Mod,0|gbblock=[[0,length(R)]],nora=1); } return R; } def saturation(GNV,F,V) { + if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; G = GNV[0]; NV = GNV[1]; - if ( Procs ) { + if ( Mod ) + G1 = nd_gr(cons(NV*F-1,G),cons(NV,V),Mod,[[0,1],[0,length(V)]]); + else if ( Procs ) { Arg0 = ["nd_gr_trace", cons(NV*F-1,G),cons(NV,V),0,GBCheck,[[0,1],[0,length(V)]]]; Arg1 = ["nd_gr_trace", @@ -1116,26 +1251,51 @@ def saturation(GNV,F,V) def sat(G,F,V) { + if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; + if ( type(IsGB=getopt(isgb)) == -1 ) IsGB = 0; NV = ttttt; - if ( Procs ) { + if ( Mod ) + G1 = nd_gr(cons(NV*F-1,G),cons(NV,V),Mod,[[0,1],[0,length(V)]]); + else if ( Procs ) { Arg0 = ["nd_gr_trace", cons(NV*F-1,G),cons(NV,V),0,GBCheck,[[0,1],[0,length(V)]]]; Arg1 = ["nd_gr_trace", cons(NV*F-1,G),cons(NV,V),1,GBCheck,[[0,1],[0,length(V)]]]; G1 = competitive_exec(Procs,Arg0,Arg1); - } else - G1 = nd_gr_trace(cons(NV*F-1,G),cons(NV,V),SatHomo,GBCheck,[[0,1],[0,length(V)]]); + } else { + B1 = append(G,[NV*F-1]); + V1 = cons(NV,V); + Ord1 = [[0,1],[0,length(V)]]; + if ( IsGB ) + G1 = nd_gr_trace(B1,V1,SatHomo,GBCheck,Ord1| + gbblock=[[0,length(G)]]); + else + G1 = nd_gr_trace(B1,V1,SatHomo,GBCheck,Ord1); + } return elimination(G1,V); } def satind(G,F,V) { + if ( type(Block=getopt(gbblock)) == -1 ) Block = 0; + if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; NV = ttttt; N = length(V); B = append(G,[NV*F-1]); V1 = cons(NV,V); - D = nd_gr_trace(B,V1,1,GBCheck,[[0,1],[0,N]] - |nora=1,gentrace=1,gbblock=[[0,length(G)]]); + Ord1 = [[0,1],[0,N]]; + if ( Mod ) + if ( Block ) + D = nd_gr(B,V1,Mod,Ord1|nora=1,gentrace=1,gbblock=Block); + else + D = nd_gr(B,V1,Mod,Ord1|nora=1,gentrace=1); + else + if ( Block ) + D = nd_gr_trace(B,V1,SatHomo,GBCheck,Ord1 + |nora=1,gentrace=1,gbblock=Block); + else + D = nd_gr_trace(B,V1,SatHomo,GBCheck,Ord1 + |nora=1,gentrace=1); G1 = D[0]; Len = length(G1); Deg = compute_deg(B,V1,NV,D); @@ -1154,11 +1314,13 @@ def satind(G,F,V) def sat_ind(G,F,V) { + if ( type(Ord=getopt(ord)) == -1 ) Ord = 0; + if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; NV = ttttt; - F = p_nf(F,G,V,0); + F = gen_nf(F,G,V,Ord,Mod); for ( I = 0, GI = G; ; I++ ) { - G1 = colon(GI,F,V); - if ( ideal_inclusion(G1,GI,V,0) ) { + G1 = colon(GI,F,V|mod=Mod,ord=Ord); + if ( ideal_inclusion(G1,GI,V,Ord|mod=Mod) ) { return [GI,I]; } else GI = G1; @@ -1167,40 +1329,43 @@ def sat_ind(G,F,V) def colon(G,F,V) { - F = p_nf(F,G,V,0); + if ( type(Ord=getopt(ord)) == -1 ) Ord = 0; + if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; + if ( type(IsGB=getopt(isgb)) == -1 ) IsGB = 0; + F = gen_nf(F,G,V,Ord,Mod); if ( !F ) return [1]; - NV = ttttt; - V1 = cons(NV,V); - T = nd_gr_trace(append(vtol(NV*ltov(G)),[(1-NV)*F]),V1,1,GBCheck, - [[0,1],[0,length(V)]]|gbblock=[[0,length(G)]],nora=1); - T = elimination(T,V); - return map(ptozp,map(sdiv,T,F)); + if ( IsGB ) + T = ideal_intersection(G,[F],V,Ord|gbblock=[[0,length(G)]],mod=Mod); + else + T = ideal_intersection(G,[F],V,Ord|mod=Mod); + return Mod?map(sdivm,T,F,Mod):map(ptozp,map(sdiv,T,F)); } def ideal_colon(G,F,V) { - G = nd_gr(G,V,0,0); - L = mapat(colon,1,G,F,V); - return ideal_list_intersection(L,V,0); + if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; + G = nd_gr(G,V,Mod,0); + for ( T = F, L = []; T != []; T = cdr(T) ) + L = cons(colon(G,car(T),V|isgb=1,mod=Mod),L); + L = reverse(L); + return ideal_list_intersection(L,V,0|mod=Mod); } def ideal_sat(G,F,V) { - G = nd_gr(G,V,0,0); - L = mapat(sat,1,G,F,V); - return ideal_list_intersection(L,V,0); + if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; + G = nd_gr(G,V,Mod,0); + for ( T = F, L = []; T != []; T = cdr(T) ) + L = cons(sat(G,car(T),V|mod=Mod),L); + L = reverse(L); + return ideal_list_intersection(L,V,0|mod=Mod); } def ideal_inclusion(F,G,V,O) { if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; - if ( Mod ) { - for ( T = F; T != []; T = cdr(T) ) - if ( p_nf_mod(car(T),G,V,O,Mod) ) return 0; - } else { - for ( T = F; T != []; T = cdr(T) ) - if ( p_nf(car(T),G,V,O) ) return 0; - } + for ( T = F; T != []; T = cdr(T) ) + if ( gen_nf(car(T),G,V,O,Mod) ) return 0; return 1; } @@ -1208,14 +1373,15 @@ def ideal_inclusion(F,G,V,O) def qd_simp_comp(QP,V) { + if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; R = ltov(QP); N = length(R); for ( I = 0; I < N; I++ ) { if ( R[I] ) { QI = R[I][0]; PI = R[I][1]; for ( J = I+1; J < N; J++ ) - if ( R[J] && gb_comp(PI,R[J][1]) ) { - QI = ideal_intersection(QI,R[J][0],V,0); + if ( R[J] && gen_gb_comp(PI,R[J][1],Mod) ) { + QI = ideal_intersection(QI,R[J][0],V,0|mod=Mod); R[J] = 0; } R[I] = [QI,PI]; @@ -1228,68 +1394,52 @@ def qd_simp_comp(QP,V) def qd_remove_redundant_comp(G,Iso,Emb,V,Ord) { - IsoInt = ideal_list_intersection(map(first_element,Iso),V,Ord); - Emb = qd_simp_comp(Emb,V); - Emb = qsort(Emb); - A = ltov(Emb); - N = length(A); + if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; + IsoInt = ideal_list_intersection(map(first_element,Iso),V,Ord|mod=Mod); + Emb = qd_simp_comp(Emb,V|mod=Mod); + Emb = reverse(qsort(Emb)); + A = ltov(Emb); N = length(A); + Pre = IsoInt; Post = vector(N+1); + for ( Post[N] = IsoInt, I = N-1; I >= 1; I-- ) + Post[I] = ideal_intersection(Post[I+1],A[I][0],V,Ord|mod=Mod); for ( I = 0; I < N; I++ ) { - if ( !A[I] ) continue; - for ( T = [], J = 0; J < N; J++ ) - if ( J != I && A[J] ) T = cons(A[J][0],T); - Int = ideal_list_intersection(T,V,Ord); - Int = ideal_intersection(IsoInt,Int,V,Ord); - if ( gb_comp(Int,G) ) A[I] = 0; + print(".",2); + Int = ideal_intersection(Pre,Post[I+1],V,Ord|mod=Mod); + if ( gen_gb_comp(Int,G,Mod) ) A[I] = 0; + else + Pre = ideal_intersection(Pre,A[I][0],V,Ord|mod=Mod); } for ( T = [], I = 0; I < N; I++ ) if ( A[I] ) T = cons(A[I],T); return reverse(T); } -def remove_redundant_comp(G,Iso,Emb,V,Ord) +def pd_remove_redundant_comp(G,P,V,Ord) { - IsoInt = ideal_list_intersection(Iso,V,Ord); - - A = ltov(Emb); - N = length(A); + if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; + if ( type(First=getopt(first)) == -1 ) First = 0; + A = ltov(P); N = length(A); for ( I = 0; I < N; I++ ) { if ( !A[I] ) continue; for ( J = I+1; J < N; J++ ) - if ( A[J] && gb_comp(A[I],A[J]) ) A[J] = 0; + if ( A[J] && + gen_gb_comp(First?A[I][0]:A[I],First?A[J][0]:A[J],Mod) ) A[J] = 0; } + for ( I = 0, T = []; I < N; I++ ) if ( A[I] ) T = cons(A[I],T); + A = ltov(reverse(T)); N = length(A); + Pre = [1]; Post = vector(N+1); + for ( Post[N] = [1], I = N-1; I >= 1; I-- ) + Post[I] = ideal_intersection(Post[I+1],First?A[I][0]:A[I],V,Ord|mod=Mod); for ( I = 0; I < N; I++ ) { - if ( !A[I] ) continue; - for ( T = [], J = 0; J < N; J++ ) - if ( J != I && A[J] ) T = cons(A[J],T); - Int = ideal_list_intersection(cons(IsoInt,T),V,Ord); - if ( gb_comp(Int,G) ) A[I] = 0; + Int = ideal_intersection(Pre,Post[I+1],V,Ord|mod=Mod); + if ( gen_gb_comp(Int,G,Mod) ) A[I] = 0; + else + Pre = ideal_intersection(Pre,First?A[I][0]:A[I],V,Ord|mod=Mod); } - for ( T = [], I = 0; I < N; I++ ) - if ( A[I] ) T = cons(A[I],T); + for ( T = [], I = 0; I < N; I++ ) if ( A[I] ) T = cons(A[I],T); return reverse(T); } -def remove_redundant_comp_first(G,P,V,Ord) -{ - A = ltov(P); - N = length(A); - for ( I = 0; I < N; I++ ) { - if ( !A[I] ) continue; - for ( J = I+1; J < N; J++ ) - if ( A[J] && gb_comp(A[I][0],A[J][0]) ) A[J] = 0; - } - for ( I = 0; I < N; I++ ) { - if ( !A[I] ) continue; - for ( T = [], J = 0; J < N; J++ ) - if ( J != I && A[J] ) T = cons(A[J][0],T); - Int = ideal_list_intersection(T,V,Ord); - if ( gb_comp(Int,G) ) A[I] = 0; - } - for ( T = [], I = 0; I < N; I++ ) - if ( A[I] ) T = cons(A[I],T); - return reverse(T); -} - /* polynomial operations */ def ppart(F,V,Mod) @@ -1302,22 +1452,22 @@ def ppart(F,V,Mod) } -def sq(F) +def sq(F,Mod) { if ( !F ) return 0; - A = cdr(fctr(F)); + A = cdr(gen_fctr(F,Mod)); for ( R = 1; A != []; A = cdr(A) ) R *= car(car(A)); return R; } -def lcfactor(G,V,O) +def lcfactor(G,V,O,Mod) { O0 = dp_ord(); dp_ord(O); C = []; for ( T = G; T != []; T = cdr(T) ) { C1 = dp_hc(dp_ptod(car(T),V)); - S = fctr(C1); + S = gen_fctr(C1,Mod); for ( S = cdr(S); S != []; S = cdr(S) ) if ( !member(S[0][0],C) ) C = cons(S[0][0],C); } @@ -1325,6 +1475,44 @@ def lcfactor(G,V,O) return C; } +def gen_fctr(F,Mod) +{ + if ( Mod ) return modfctr(F,Mod); + else return fctr(F); +} + +def gen_mptop(F) +{ + if ( !F ) return F; + else if ( type(F)==1 ) + if ( ntype(F)==5 ) return mptop(F); + else return F; + else { + V = var(F); + D = deg(F,V); + for ( R = 0, I = 0; I <= D; I++ ) + if ( C = coef(F,I,V) ) R += gen_mptop(C)*V^I; + return R; + } +} + +def gen_nf(F,G,V,Ord,Mod) +{ + if ( !Mod ) return p_nf(F,G,V,Ord); + + setmod(Mod); + dp_ord(Ord); DF = dp_mod(dp_ptod(F,V),Mod,[]); + N = length(G); DG = newvect(N); + for ( I = N-1, IL = []; I >= 0; I-- ) { + DG[I] = dp_mod(dp_ptod(G[I],V),Mod,[]); + IL = cons(I,IL); + } + T = dp_nf_mod(IL,DF,DG,1,Mod); + for ( R = 0; T; T = dp_rest(T) ) + R += gen_mptop(dp_hc(T))*dp_dtop(dp_ht(T),V); + return R; +} + /* Ti = [D,I,M,C] */ def compute_deg0(Ti,P,V,TV) @@ -1463,5 +1651,16 @@ def comp_by_second(A,B) else if ( A[1] < B[1] ) return -1; else return 0; } + +def gen_gb_comp(A,B,Mod) +{ + if ( !Mod ) return gb_comp(A,B); + LA = length(A); LB = length(B); + if ( LA != LB ) return 0; + A = qsort(A); B = qsort(B); + if ( A != B ) return 0; + return 1; +} + endmodule$ end$