=================================================================== RCS file: /home/cvs/OpenXM/src/asir-contrib/testing/noro/Attic/pd.rr,v retrieving revision 1.2 retrieving revision 1.6 diff -u -p -r1.2 -r1.6 --- OpenXM/src/asir-contrib/testing/noro/Attic/pd.rr 2010/05/10 02:15:17 1.2 +++ OpenXM/src/asir-contrib/testing/noro/Attic/pd.rr 2010/05/21 06:45:06 1.6 @@ -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_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 pd_remove_redundant_comp, ppart, sq$ localf 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,qdcheck$ SatHomo=0$ GBCheck=1$ @@ -30,7 +30,7 @@ GBCheck=1$ def gbcheck(A) { if ( A ) GBCheck = 1; - else GBcheck = -1; + else GBCheck = -1; } def f4(A) @@ -69,6 +69,15 @@ def kill_procs() } } +def qd_check(B,V,QD) +{ + G = nd_gr(B,V,0,0); + Iso = ideal_list_intersection(map(first_element,QD[0]),V,0); + Emb = ideal_list_intersection(map(first_element,QD[1]),V,0); + GG = ideal_intersection(Iso,Emb,V,0); + return gb_comp(G,GG); +} + /* SYC primary decomositions */ def syca_dec(B,V) @@ -233,7 +242,12 @@ def find_separating_ideal1(C,G,Q,Rad,V,Ord) { /* check whether (Q cap (G+S)) = G */ if ( gb_comp(Int,G) ) 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)]]); for ( T = C, S = []; T != []; T = cdr(T) ) { if ( !nd_nf(car(T),Rad,V,Ord,0) ) continue; Ui = U = car(T); @@ -244,13 +258,15 @@ def find_separating_ideal1(C,G,Q,Rad,V,Ord) { else Ui = nd_nf(Ui*U,G,V,Ord,0); } - if ( length(S) ) { - G1 = append(cons(Ui,S),G); - Int = ideal_intersection(G1,Q,V,Ord); - if ( !gb_comp(Int,G) ) - break; + Int1 = incremental_gb(append(Int0,[Tmp*Ui]),TV,Ord1 + |gbblock=[[0,length(Int0)]]); + Int = elimination(Int1,V); + if ( !gb_comp(Int,G) ) + break; + else { + Int0 = Int1; + S = cons(Ui,S); } - S = cons(Ui,S); } return reverse(S); } @@ -265,8 +281,11 @@ def find_separating_ideal2(C,G,Q,Rad,V,Ord) { /* check whether (Q cap (G+S)) = G */ if ( gb_comp(Int,G) ) 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) ) { + print(length(T)); if ( !nd_nf(car(T),Rad,V,Ord,0) ) continue; Ui = U = car(T); for ( I = 1; ; I++ ) { @@ -278,24 +297,37 @@ def find_separating_ideal2(C,G,Q,Rad,V,Ord) { } S = cons(Ui,S); } - S = reverse(S); + S = qsort(S,comp_tdeg); + /* S = reverse(S); */ Len = length(S); - Ok = [S[0]]; + + Tmp = ttttt; TV = cons(Tmp,V); Ord1 = [[0,1],[Ord,length(V)]]; 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; + Prev = 1; + Cur = 2; + G1 = append(G,[S[0]]); + Int0 = incremental_gb(append(vtol(ltov(G1)*Tmp),vtol(ltov(Q)*(1-Tmp))), + TV,Ord1|gbblock=[[0,length(G)]]); + 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)]]); + Int = elimination(Int1,V); + if ( gb_comp(Int,G) ) { + print(Cur); + Prev = Cur; + Cur = Cur+idiv(Len-Cur+1,2); + Int0 = Int1; + } else { + Cur = Prev + idiv(Cur-Prev,2); } } - } + for ( St = [], I = 0; I < Prev; I++ ) St = cons(S[I],St); + Ok = reverse(St); + } else + Ok = [S[0]]; + print([length(S),length(Ok)]); + dp_gr_print(Dp); return Ok; } @@ -334,7 +366,7 @@ def sy_dec(B,V) } Gt = fast_gb(append(Gt,St),V,0,Ord); } - Q = remove_redundant_comp(G,Qi,Q,V,Ord); + Q = qd_remove_redundant_comp(G,Qi,Q,V,Ord); return append(Qi,Q); } @@ -382,6 +414,7 @@ def iso_comp(G,L,V,Ord) Ind = vector(N); Q = vector(N); L0 = map(first_element,L); + G = nd_gr(G,V,0,Ord); for ( I = 0; I < N; I++ ) { LI = setminus(L0,[L0[I]]); PI = ideal_list_intersection(LI,V,Ord); @@ -389,7 +422,7 @@ def iso_comp(G,L,V,Ord) if ( p_nf(car(T),L0[I],V,Ord) ) 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); PV = L[I][1]; V0 = setminus(V,PV); GI = elim_gb(QI,V0,PV,0,[[0,length(V0)],[0,length(PV)]]); @@ -442,16 +475,16 @@ def prime_dec(B,V) else PD = [B]; G = ideal_list_intersection(PD,V,0); - PD = remove_redundant_comp(G,[],PD,V,0); + PD = pd_remove_redundant_comp(G,PD,V,0); R = []; for ( T = PD; T != []; T = cdr(T) ) R = append(prime_dec_main(car(T),V|indep=Indep),R); if ( Indep ) { G = ideal_list_intersection(map(first_element,R),V,0); - R = remove_redundant_comp_first(G,R,V,0); + if ( !NoLexDec ) R = pd_remove_redundant_comp(G,R,V,0|first=1); } else { G = ideal_list_intersection(R,V,0); - R = remove_redundant_comp(G,[],R,V,0); + if ( !NoLexDec ) R = pd_remove_redundant_comp(G,R,V,0); } return R; } @@ -781,6 +814,22 @@ def fast_gb(B,V,Mod,Ord) 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 ) + 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) { @@ -1116,6 +1165,7 @@ def saturation(GNV,F,V) def sat(G,F,V) { + if ( type(IsGB=getopt(isgb)) == -1 ) IsGB = 0; NV = ttttt; if ( Procs ) { Arg0 = ["nd_gr_trace", @@ -1123,8 +1173,16 @@ def sat(G,F,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); } @@ -1167,20 +1225,22 @@ def sat_ind(G,F,V) def colon(G,F,V) { + if ( type(IsGB=getopt(isgb)) == -1 ) IsGB = 0; F = p_nf(F,G,V,0); 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); + if ( IsGB ) + T = ideal_intersection(G,[F],V,0|gbblock=[[0,length(G)]]); + else + T = ideal_intersection(G,[F],V,0); return 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); + for ( T = F, L = []; T != []; T = cdr(T) ) + L = cons(colon(G,car(T),V|isgb=1),L); + L = reverse(L); return ideal_list_intersection(L,V,0); } @@ -1230,63 +1290,44 @@ 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); + Emb = reverse(qsort(Emb)); + A = ltov(Emb); N = length(A); + Pre = IsoInt; Post = vector(N+1); + for ( Post[N] = [1], I = N-1; I >= 1; I-- ) + Post[I] = ideal_intersection(Post[I+1],A[I][0],V,Ord); 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); + Int = ideal_intersection(Pre,Post[I+1],V,Ord); if ( gb_comp(Int,G) ) A[I] = 0; + else + Pre = ideal_intersection(Pre,A[I][0],V,Ord); } 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(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] && + gb_comp(First?A[I][0]:A[I],First?A[J][0]:A[J]) ) 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); 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); + Int = ideal_intersection(Pre,Post[I+1],V,Ord); if ( gb_comp(Int,G) ) A[I] = 0; + else + Pre = ideal_intersection(Pre,First?A[I][0]:A[I],V,Ord); } - 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); + for ( T = [], I = 0; I < N; I++ ) if ( A[I] ) T = cons(A[I],T); return reverse(T); }