version 1.4, 2011/02/18 02:59:04 |
version 1.7, 2011/08/09 07:49:38 |
|
|
/* $OpenXM: OpenXM/src/asir-contrib/testing/noro/new_pd.rr,v 1.3 2011/01/19 04:52:03 noro Exp $ */ |
/* $OpenXM: OpenXM/src/asir-contrib/testing/noro/new_pd.rr,v 1.6 2011/07/05 07:46:09 noro Exp $ */ |
import("gr")$ |
import("gr")$ |
module noro_pd$ |
module noro_pd$ |
static GBCheck,F4,EProcs,Procs,SatHomo,GBRat$ |
static GBCheck,F4,EProcs,Procs,SatHomo,GBRat$ |
Line 8 localf get_lc,tomonic,aa,ideal_intersection_m,redbase$ |
|
Line 8 localf get_lc,tomonic,aa,ideal_intersection_m,redbase$ |
|
localf para_exec,nd_gr_rat,competitive_exec,call_func$ |
localf para_exec,nd_gr_rat,competitive_exec,call_func$ |
localf call_ideal_list_intersection$ |
localf call_ideal_list_intersection$ |
localf call_colon,call_prime_dec$ |
localf call_colon,call_prime_dec$ |
|
localf prime_dec2, prime_dec_main2$ |
localf first_second$ |
localf first_second$ |
localf third$ |
localf third$ |
localf locsat,iso_comp_para,extract_qj,colon_prime_dec,extract_comp$ |
localf locsat,iso_comp_para,extract_qj,colon_prime_dec,extract_comp$ |
Line 35 localf complete_qdecomp, partial_qdecomp, partial_qdec |
|
Line 36 localf complete_qdecomp, partial_qdecomp, partial_qdec |
|
localf partial_decomp, partial_decomp0, zprimacomp, zprimecomp$ |
localf partial_decomp, partial_decomp0, zprimacomp, zprimecomp$ |
localf fast_gb, incremental_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 rsgn, find_npos, gen_minipoly, indepset$ |
localf maxindep, contraction, ideal_list_intersection, ideal_intersection$ |
localf maxindep, maxindep2, contraction, ideal_list_intersection, ideal_intersection$ |
localf radical_membership, modular_radical_membership$ |
localf radical_membership, modular_radical_membership$ |
localf radical_membership_rep, ideal_product, saturation$ |
localf radical_membership_rep, ideal_product, saturation$ |
localf sat, satind, sat_ind, colon, isat$ |
localf sat, satind, sat_ind, colon, isat$ |
localf ideal_colon, ideal_sat, ideal_inclusion, qd_simp_comp, qd_remove_redundant_comp$ |
localf ideal_colon, ideal_sat, ideal_inclusion, qd_simp_comp, qd_remove_redundant_comp$ |
localf pd_simp_comp$ |
localf pd_simp_comp, remove_identical_comp$ |
localf pd_remove_redundant_comp, ppart, sq, gen_fctr, gen_nf, gen_gb_comp$ |
localf pd_remove_redundant_comp, ppart, sq, gen_fctr, gen_nf, gen_gb_comp$ |
localf gen_mptop, lcfactor, compute_deg0, compute_deg, member$ |
localf gen_mptop, lcfactor, compute_deg0, compute_deg, member$ |
localf elimination, setintersection, setminus, sep_list$ |
localf elimination, setintersection, setminus, sep_list$ |
Line 1098 def prime_dec(B,V) |
|
Line 1099 def prime_dec(B,V) |
|
{ |
{ |
if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; |
if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; |
if ( type(Indep=getopt(indep)) == -1 ) Indep = 0; |
if ( type(Indep=getopt(indep)) == -1 ) Indep = 0; |
if ( type(NoLexDec=getopt(lexdec)) == -1 ) LexDec = 0; |
if ( type(LexDec=getopt(lexdec)) == -1 ) LexDec = 0; |
if ( type(Rad=getopt(radical)) == -1 ) Rad = 0; |
if ( type(Rad=getopt(radical)) == -1 ) Rad = 0; |
B = map(sq,B,Mod); |
B = map(sq,B,Mod); |
if ( LexDec ) |
if ( LexDec ) |
Line 1117 def prime_dec(B,V) |
|
Line 1118 def prime_dec(B,V) |
|
if ( LexDec ) R = pd_simp_comp(R,V|first=1,mod=Mod); |
if ( LexDec ) R = pd_simp_comp(R,V|first=1,mod=Mod); |
} else { |
} else { |
G = ideal_list_intersection(R,V,0|mod=Mod); |
G = ideal_list_intersection(R,V,0|mod=Mod); |
if ( LexDec ) R = pd_simp_comp(R,V|first=1,mod=Mod); |
if ( LexDec ) R = pd_simp_comp(R,V|mod=Mod); |
} |
} |
return Rad ? [R,G] : R; |
return Rad ? [R,G] : R; |
} |
} |
|
|
|
def prime_dec2(B,V) |
|
{ |
|
if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; |
|
if ( type(Indep=getopt(indep)) == -1 ) Indep = 0; |
|
if ( type(LexDec=getopt(lexdec)) == -1 ) LexDec = 0; |
|
if ( type(Rad=getopt(radical)) == -1 ) Rad = 0; |
|
if ( type(Para=getopt(para)) == -1 || type(Para) != 4 ) Para = []; |
|
B = map(sq,B,Mod); |
|
if ( LexDec ) |
|
PD = lex_predec1(B,V|mod=Mod); |
|
else |
|
PD = [B]; |
|
if ( length(PD) > 1 ) { |
|
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_main2(car(T),V|indep=Indep,mod=Mod,para=Para),R); |
|
if ( Indep ) { |
|
G = ideal_list_intersection(map(first,R),V,0|mod=Mod); |
|
R = pd_simp_comp(R,V|first=1,mod=Mod); |
|
} else { |
|
G = ideal_list_intersection(R,V,0|mod=Mod); |
|
R = pd_simp_comp(R,V|mod=Mod); |
|
} |
|
return Rad ? [R,G] : R; |
|
} |
|
|
def prime_dec_main(B,V) |
def prime_dec_main(B,V) |
{ |
{ |
if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; |
if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; |
Line 1136 def prime_dec_main(B,V) |
|
Line 1166 def prime_dec_main(B,V) |
|
/* rad(G) subset IntP */ |
/* rad(G) subset IntP */ |
/* check if IntP subset rad(G) */ |
/* check if IntP subset rad(G) */ |
/* print([length(PD),length(IntP)],2); */ |
/* print([length(PD),length(IntP)],2); */ |
for ( T = IntP; T != []; T = cdr(T) ) { |
for ( T = IntP; T != []; T = cdr(T) ) |
if ( (GNV = radical_membership(car(T),G,V|mod=Mod,isgb=1,dg=[DG,Ind])) ) { |
if ( (G0 = radical_membership(car(T),G,V|mod=Mod,isgb=1,dg=[DG,Ind],sat=1)) ) { |
F = car(T); |
F = car(T); |
break; |
break; |
} |
} |
} |
|
if ( T == [] ) return PD; |
if ( T == [] ) return PD; |
|
|
/* GNV = [GB(<NV*F-1,G>),NV] */ |
|
G1 = fast_gb(GNV[0],cons(GNV[1],V),Mod,[[0,1],[0,length(V)]]); |
|
G0 = elimination(G1,V); |
|
PD0 = zprimecomp(G0,V,Indep|mod=Mod); |
PD0 = zprimecomp(G0,V,Indep|mod=Mod); |
if ( Indep ) { |
Int = ideal_list_intersection(Indep?map(first,PD0):PD0,V,0|mod=Mod); |
Int = ideal_list_intersection(PD0[0],V,0|mod=Mod); |
PD = append(PD,PD0); |
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|mod=Mod); |
|
PD = append(PD,PD0); |
|
} |
|
#if 0 |
#if 0 |
IntP = ideal_intersection_m(IntP,Int,V,0|mod=Mod); |
IntP = ideal_intersection_m(IntP,Int,V,0|mod=Mod); |
#else |
#else |
IntP = ideal_intersection(IntP,Int,V,0 |
IntP = ideal_intersection(IntP,Int,V,0|mod=Mod,gbblock=[[0,length(IntP)]]); |
|mod=Mod,gbblock=[[0,length(IntP)]]); |
|
#endif |
#endif |
} |
} |
} |
} |
|
|
|
def prime_dec_main2(B,V) |
|
{ |
|
if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; |
|
if ( type(Indep=getopt(indep)) == -1 ) Indep = 0; |
|
if ( type(Para=getopt(para)) == -1 || type(Para) != 4 ) Para = []; |
|
NPara = length(Para); |
|
|
|
G = fast_gb(B,V,Mod,0); |
|
IntP = [1]; |
|
PD = []; |
|
DG = ltov(map(dp_ptod,G,V)); |
|
for ( Ind = [], I = length(G)-1; I >= 0; I-- ) Ind = cons(I,Ind); |
|
if ( Mod ) DG = map(dp_mod,DG,Mod,[]); |
|
while ( 1 ) { |
|
/* rad(G) subset IntP */ |
|
/* check if IntP subset rad(G) */ |
|
/* print([length(PD),length(IntP)],2); */ |
|
Sat = []; |
|
IntPM = mingen(IntP,V); |
|
for ( T = IntPM; T != [] && length(Sat) < 16; T = cdr(T) ) |
|
if ( G0 = radical_membership(car(T),G,V|mod=Mod,isgb=1,dg=[DG,Ind],sat=1) ) |
|
Sat = cons(G0,Sat); |
|
if ( Sat == [] ) return PD; |
|
print(length(Sat),2); print("->",2); |
|
Sat = remove_identical_comp(Sat|mod=Mod); |
|
print(length(Sat)); |
|
for ( T = Sat; T != []; T = cdr(T) ) { |
|
PD0 = zprimecomp(car(T),V,Indep|mod=Mod); |
|
Int = ideal_list_intersection(Indep?map(first,PD0):PD0,V,0|mod=Mod); |
|
PD = append(PD,PD0); |
|
IntP = ideal_intersection(IntP,Int,V,0|mod=Mod,gbblock=[[0,length(IntP)]]); |
|
} |
|
} |
|
} |
|
|
/* pre-decomposition */ |
/* pre-decomposition */ |
|
|
def lex_predec1(B,V) |
def lex_predec1(B,V) |
Line 1228 def complete_qdecomp(GD,V,Mod) |
|
Line 1279 def complete_qdecomp(GD,V,Mod) |
|
NV = ttttt; |
NV = ttttt; |
M = gen_minipoly(cons(NV-U,GQ),cons(NV,V),PV,0,NV,Mod); |
M = gen_minipoly(cons(NV-U,GQ),cons(NV,V),PV,0,NV,Mod); |
M = ppart(M,NV,Mod); |
M = ppart(M,NV,Mod); |
MF = Mod ? modfctr(M) : fctr(M); |
MF = Mod ? modfctr(M,Mod) : fctr(M); |
R = []; |
R = []; |
for ( T = cdr(MF); T != []; T = cdr(T) ) { |
for ( T = cdr(MF); T != []; T = cdr(T) ) { |
S = car(T); |
S = car(T); |
Line 1325 def complete_decomp(GD,V,Mod) |
|
Line 1376 def complete_decomp(GD,V,Mod) |
|
NV = ttttt; |
NV = ttttt; |
M = gen_minipoly(cons(NV-U,G),cons(NV,V),PV,0,NV,Mod); |
M = gen_minipoly(cons(NV-U,G),cons(NV,V),PV,0,NV,Mod); |
M = ppart(M,NV,Mod); |
M = ppart(M,NV,Mod); |
MF = Mod ? modfctr(M) : fctr(M); |
MF = Mod ? modfctr(M,Mod) : fctr(M); |
if ( length(MF) == 2 ) return [G]; |
if ( length(MF) == 2 ) return [G]; |
R = []; |
R = []; |
for ( T = cdr(MF); T != []; T = cdr(T) ) { |
for ( T = cdr(MF); T != []; T = cdr(T) ) { |
Line 1441 def zprimecomp(G,V,Indep) { |
|
Line 1492 def zprimecomp(G,V,Indep) { |
|
for ( T = PD; T != []; T = cdr(T) ) { |
for ( T = PD; T != []; T = cdr(T) ) { |
U = contraction(car(T),V0|mod=Mod); |
U = contraction(car(T),V0|mod=Mod); |
U = nd_gr(U,V,Mod,0); |
U = nd_gr(U,V,Mod,0); |
R = cons(U,R); |
R = cons(Indep?[U,W]:U,R); |
} |
} |
if ( Indep ) return [R,W]; |
return R; |
else return R; |
|
} |
} |
|
|
def fast_gb(B,V,Mod,Ord) |
def fast_gb(B,V,Mod,Ord) |
Line 1569 def find_npos(GD,V,PV,Mod) |
|
Line 1619 def find_npos(GD,V,PV,Mod) |
|
{ |
{ |
N = length(V); PN = length(PV); |
N = length(V); PN = length(PV); |
G = GD[0]; D = GD[1]; LD = D[N]; |
G = GD[0]; D = GD[1]; LD = D[N]; |
|
DH = map(dp_dtop,map(dp_ht,map(dp_ptod,D,V)),V); |
Ord0 = dp_ord(); dp_ord(0); |
Ord0 = dp_ord(); dp_ord(0); |
HC = map(dp_hc,map(dp_ptod,G,V)); |
HC = map(dp_hc,map(dp_ptod,G,V)); |
dp_ord(Ord0); |
dp_ord(Ord0); |
Line 1582 def find_npos(GD,V,PV,Mod) |
|
Line 1633 def find_npos(GD,V,PV,Mod) |
|
NV = ttttt; |
NV = ttttt; |
for ( B = 2; ; B++ ) { |
for ( B = 2; ; B++ ) { |
for ( J = N-2; J >= 0; J-- ) { |
for ( J = N-2; J >= 0; J-- ) { |
for ( U = 0, K = J; K < N; K++ ) |
for ( U = 0, K = J; K < N; K++ ) { |
|
if ( DH[K] == V[K] ) continue; |
U += rsgn()*((random()%B+1))*V[K]; |
U += rsgn()*((random()%B+1))*V[K]; |
|
} |
|
#if 0 |
M = minipolym(G,V,0,U,NV,Mod); |
M = minipolym(G,V,0,U,NV,Mod); |
|
#else |
|
M = gen_minipoly(cons(NV-U,G),cons(NV,V),PV,0,NV,Mod); |
|
#endif |
if ( deg(M,NV) == LD ) return U; |
if ( deg(M,NV) == LD ) return U; |
} |
} |
} |
} |
Line 1592 def find_npos(GD,V,PV,Mod) |
|
Line 1649 def find_npos(GD,V,PV,Mod) |
|
|
|
def gen_minipoly(G,V,PV,Ord,VI,Mod) |
def gen_minipoly(G,V,PV,Ord,VI,Mod) |
{ |
{ |
|
O0 = dp_ord(); |
if ( PV == [] ) { |
if ( PV == [] ) { |
NV = sssss; |
NV = sssss; |
if ( Mod ) |
if ( Mod ) |
M = minipolym(G,V,Ord,VI,NV,Mod); |
M = minipolym(G,V,Ord,VI,NV,Mod); |
else |
else |
M = minipoly(G,V,Ord,VI,NV); |
M = minipoly(G,V,Ord,VI,NV); |
|
dp_ord(O0); |
return subst(M,NV,VI); |
return subst(M,NV,VI); |
} |
} |
W = setminus(V,[VI]); |
W = setminus(V,[VI]); |
Line 1615 def gen_minipoly(G,V,PV,Ord,VI,Mod) |
|
Line 1674 def gen_minipoly(G,V,PV,Ord,VI,Mod) |
|
G = elimination(G,cdr(V1)); |
G = elimination(G,cdr(V1)); |
} |
} |
} |
} |
#elif 1 |
#elif 0 |
if ( Mod ) { |
if ( Mod ) { |
V1 = append(W,PV1); |
V1 = append(W,PV1); |
G = nd_gr(G,V1,Mod,[[0,length(W)],[0,length(PV1)]]); |
G = nd_gr(G,V1,Mod,[[0,length(W)],[0,length(PV1)]]); |
Line 1640 def gen_minipoly(G,V,PV,Ord,VI,Mod) |
|
Line 1699 def gen_minipoly(G,V,PV,Ord,VI,Mod) |
|
G = nd_gr_trace(G,PV1,1,GBCheck,[[0,1],[0,length(PV)]]|nora=1); |
G = nd_gr_trace(G,PV1,1,GBCheck,[[0,1],[0,length(PV)]]|nora=1); |
for ( M = car(G), T = cdr(G); T != []; T = cdr(T) ) |
for ( M = car(G), T = cdr(G); T != []; T = cdr(T) ) |
if ( deg(car(T),VI) < deg(M,VI) ) M = car(T); |
if ( deg(car(T),VI) < deg(M,VI) ) M = car(T); |
|
dp_ord(O0); |
return M; |
return M; |
} |
} |
|
|
Line 1685 def maxindep(B,V,O) |
|
Line 1745 def maxindep(B,V,O) |
|
return R; |
return R; |
} |
} |
|
|
|
def maxindep2(B,V,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); |
|
H = map(sq,H,0); |
|
H = nd_gr(H,V,0,0); |
|
H = monodec0(H,V); |
|
N = length(V); |
|
Dep = []; |
|
for ( T = H, Len = N+1; T != []; T = cdr(T) ) { |
|
M = length(car(T)); |
|
if ( M < Len ) { |
|
Dep = [car(T)]; |
|
Len = M; |
|
} else if ( M == Len ) |
|
Dep = cons(car(T),Dep); |
|
} |
|
R = []; |
|
for ( T = Dep; T != []; T = cdr(T) ) |
|
R = cons(setminus(V,car(T)),R); |
|
dp_ord(Old); |
|
return reverse(R); |
|
} |
|
|
|
|
/* ideal operations */ |
/* ideal operations */ |
def contraction(G,V) |
def contraction(G,V) |
{ |
{ |
Line 1808 def radical_membership(F,G,V) { |
|
Line 1896 def radical_membership(F,G,V) { |
|
if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; |
if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; |
if ( type(IsGB=getopt(isgb)) == -1 ) IsGB = 0; |
if ( type(IsGB=getopt(isgb)) == -1 ) IsGB = 0; |
if ( type(L=getopt(dg)) == -1 ) L = 0; |
if ( type(L=getopt(dg)) == -1 ) L = 0; |
|
if ( type(Sat=getopt(sat)) == -1 ) Sat = 0; |
dp_ord(0); |
dp_ord(0); |
if ( L ) { DG = L[0]; Ind = L[1]; } |
if ( L ) { DG = L[0]; Ind = L[1]; } |
else { |
else { |
Line 1830 def radical_membership(F,G,V) { |
|
Line 1919 def radical_membership(F,G,V) { |
|
|gbblock=[[0,length(G)]]); |
|gbblock=[[0,length(G)]]); |
else |
else |
T = nd_gr(append(G,[NV*F-1]),cons(NV,V),Mod,0); |
T = nd_gr(append(G,[NV*F-1]),cons(NV,V),Mod,0); |
if ( type(car(T)) != 1 ) return [T,NV]; |
if ( type(car(T)) == 1 ) return 0; |
else return 0; |
else if ( Sat ) { |
|
G1 = fast_gb(T,cons(NV,V),Mod,[[0,1],[0,length(V)]]); |
|
G0 = elimination(G1,V); |
|
return G0; |
|
} else return [T,NV]; |
} |
} |
|
|
def modular_radical_membership(F,G,V) { |
def modular_radical_membership(F,G,V) { |
Line 2209 def pd_remove_redundant_comp(G,P,V,Ord) |
|
Line 2302 def pd_remove_redundant_comp(G,P,V,Ord) |
|
Pre = ideal_intersection(Pre,First?A[I][0]:A[I],V,Ord|mod=Mod); |
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_identical_comp(L) |
|
{ |
|
if ( type(Mod=getopt(mod)) == -1 ) Mod = 0; |
|
if ( length(L) == 1 ) return L; |
|
|
|
A = ltov(L); N = length(A); |
|
for ( I = 0; I < N; I++ ) { |
|
if ( !A[I] ) continue; |
|
for ( J = I+1; J < N; J++ ) |
|
if ( A[J] && |
|
gen_gb_comp(A[I],A[J],Mod) ) A[J] = 0; |
|
} |
|
for ( I = 0, T = []; I < N; I++ ) if ( A[I] ) T = cons(A[I],T); |
return reverse(T); |
return reverse(T); |
} |
} |
|
|