version 1.9, 2001/09/05 08:09:10 |
version 1.19, 2003/10/20 00:58:47 |
|
|
* DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, |
* DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, |
* PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. |
* PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. |
* |
* |
* $OpenXM: OpenXM_contrib2/asir2000/lib/gr,v 1.8 2001/04/09 02:42:29 noro Exp $ |
* $OpenXM: OpenXM_contrib2/asir2000/lib/gr,v 1.18 2003/06/21 02:09:17 noro Exp $ |
*/ |
*/ |
|
|
|
module gr $ |
|
/* Empty for now. It will be used in a future. */ |
|
endmodule $ |
|
|
extern INIT_COUNT,ITOR_FAIL$ |
extern INIT_COUNT,ITOR_FAIL$ |
extern REMOTE_MATRIX,REMOTE_NF,REMOTE_VARS$ |
extern REMOTE_MATRIX,REMOTE_NF,REMOTE_VARS$ |
|
|
Line 126 def tolex_tl(G0,V,O,W,H) |
|
Line 131 def tolex_tl(G0,V,O,W,H) |
|
|
|
def tolex(G0,V,O,W) |
def tolex(G0,V,O,W) |
{ |
{ |
|
Procs = getopt(procs); |
|
|
TM = TE = TNF = 0; |
TM = TE = TNF = 0; |
N = length(V); HM = hmlist(G0,V,O); ZD = zero_dim(HM,V,O); |
N = length(V); HM = hmlist(G0,V,O); ZD = zero_dim(HM,V,O); |
if ( !ZD ) |
if ( ZD ) |
error("tolex : ideal is not zero-dimensional!"); |
MB = dp_mbase(map(dp_ptod,HM,V)); |
MB = dp_mbase(map(dp_ptod,HM,V)); |
else |
|
MB = 0; |
for ( J = 0; ; J++ ) { |
for ( J = 0; ; J++ ) { |
M = lprime(J); |
M = lprime(J); |
if ( !valid_modulus(HM,M) ) |
if ( !valid_modulus(HM,M) ) |
continue; |
continue; |
T0 = time()[0]; GM = tolexm(G0,V,O,W,M); TM += time()[0] - T0; |
T0 = time()[0]; |
dp_ord(2); |
if ( ZD ) { |
DL = map(dp_etov,map(dp_ht,map(dp_ptod,GM,W))); |
GM = tolexm(G0,V,O,W,M); |
D = newvect(N); TL = []; |
dp_ord(2); |
do |
DL = map(dp_etov,map(dp_ht,map(dp_ptod,GM,W))); |
TL = cons(dp_dtop(dp_vtoe(D),W),TL); |
D = newvect(N); TL = []; |
while ( nextm(D,DL,N) ); |
do |
L = npos_check(DL); NPOSV = L[0]; DIM = L[1]; |
TL = cons(dp_dtop(dp_vtoe(D),W),TL); |
T0 = time()[0]; NF = gennf(G0,TL,V,O,W[N-1],1)[0]; |
while ( nextm(D,DL,N) ); |
|
} else { |
|
GM = dp_gr_mod_main(G0,W,0,M,2); |
|
dp_ord(2); |
|
for ( T = GM, S = 0; T != []; T = cdr(T) ) |
|
for ( D = dp_ptod(car(T),V); D; D = dp_rest(D) ) |
|
S += dp_ht(D); |
|
TL = dp_terms(S,V); |
|
} |
|
TM += time()[0] - T0; |
|
T0 = time()[0]; NF = gennf(G0,TL,V,O,W[N-1],ZD)[0]; |
TNF += time()[0] - T0; |
TNF += time()[0] - T0; |
T0 = time()[0]; |
T0 = time()[0]; |
R = tolex_main(V,O,NF,GM,M,MB); |
if ( type(Procs) != -1 ) |
|
R = tolex_d_main(V,O,NF,GM,M,MB,Procs); |
|
else |
|
R = tolex_main(V,O,NF,GM,M,MB); |
TE += time()[0] - T0; |
TE += time()[0] - T0; |
if ( R ) { |
if ( R ) { |
if ( dp_gr_print() ) |
if ( dp_gr_print() ) |
Line 316 def dptov(P,W,MB) |
|
Line 337 def dptov(P,W,MB) |
|
|
|
def tolex_main(V,O,NF,GM,M,MB) |
def tolex_main(V,O,NF,GM,M,MB) |
{ |
{ |
DIM = length(MB); |
if ( MB ) { |
DV = newvect(DIM); |
PosDim = 0; |
|
DIM = length(MB); |
|
DV = newvect(DIM); |
|
} else |
|
PosDim = 1; |
for ( T = GM, SL = [], LCM = 1; T != []; T = cdr(T) ) { |
for ( T = GM, SL = [], LCM = 1; T != []; T = cdr(T) ) { |
S = p_terms(car(T),V,2); |
S = p_terms(car(T),V,2); |
|
if ( PosDim ) { |
|
MB = gather_nf_terms(S,NF,V,O); |
|
DV = newvect(length(MB)); |
|
} |
dp_ord(O); RHS = termstomat(NF,map(dp_ptod,cdr(S),V),MB,M); |
dp_ord(O); RHS = termstomat(NF,map(dp_ptod,cdr(S),V),MB,M); |
dp_ord(0); NHT = nf_tab_gsl(dp_ptod(LCM*car(S),V),NF); |
dp_ord(O); NHT = nf_tab_gsl(dp_ptod(LCM*car(S),V),NF); |
dptov(NHT[0],DV,MB); |
dptov(NHT[0],DV,MB); |
dp_ord(O); B = hen_ttob_gsl([DV,NHT[1]],RHS,cdr(S),M); |
dp_ord(O); B = hen_ttob_gsl([DV,NHT[1]],RHS,cdr(S),M); |
if ( !B ) |
if ( !B ) |
Line 338 def tolex_main(V,O,NF,GM,M,MB) |
|
Line 367 def tolex_main(V,O,NF,GM,M,MB) |
|
return SL; |
return SL; |
} |
} |
|
|
|
def tolex_d_main(V,O,NF,GM,M,MB,Procs) |
|
{ |
|
map(ox_reset,Procs); |
|
/* register data in servers */ |
|
map(ox_cmo_rpc,Procs,"register_data_for_find_base",NF,V,O,MB,M); |
|
/* discard return value in stack */ |
|
map(ox_pop_cmo,Procs); |
|
Free = Procs; |
|
Busy = []; |
|
T = GM; |
|
SL = []; |
|
while ( T != [] || Busy != [] ){ |
|
if ( Free == [] || T == [] ) { |
|
/* someone is working; wait for data */ |
|
Ready = ox_select(Busy); |
|
Busy = setminus(Busy,Ready); |
|
Free = append(Ready,Free); |
|
for ( ; Ready != []; Ready = cdr(Ready) ) |
|
SL = cons(ox_get(car(Ready)),SL); |
|
} else { |
|
P = car(Free); |
|
Free = cdr(Free); |
|
Busy = cons(P,Busy); |
|
Template = car(T); |
|
T = cdr(T); |
|
ox_cmo_rpc(P,"find_base",Template); |
|
ox_push_cmd(P,262); /* 262 = OX_popCMO */ |
|
} |
|
} |
|
return SL; |
|
} |
|
|
|
struct find_base_data { NF,V,O,MB,M,PosDim,DV }$ |
|
extern Find_base$ |
|
|
|
def register_data_for_find_base(NF,V,O,MB,M) |
|
{ |
|
Find_base = newstruct(find_base_data); |
|
Find_base->NF = NF; |
|
Find_base->V = V; |
|
Find_base->O = O; |
|
Find_base->M = M; |
|
Find_base->MB = MB; |
|
|
|
if ( MB ) { |
|
Find_base->PosDim = 0; |
|
DIM = length(MB); |
|
Find_base->DV = newvect(DIM); |
|
} else |
|
Find_base->PosDim = 1; |
|
} |
|
|
|
def find_base(S) { |
|
NF = Find_base->NF; |
|
V = Find_base->V; |
|
O = Find_base->O; |
|
MB = Find_base->MB; |
|
M = Find_base->M; |
|
PosDim = Find_base->PosDim; |
|
DV = Find_base->DV; |
|
|
|
S = p_terms(S,V,2); |
|
if ( PosDim ) { |
|
MB = gather_nf_terms(S,NF,V,O); |
|
DV = newvect(length(MB)); |
|
} |
|
dp_ord(O); RHS = termstomat(NF,map(dp_ptod,cdr(S),V),MB,M); |
|
dp_ord(O); NHT = nf_tab_gsl(dp_ptod(car(S),V),NF); |
|
dptov(NHT[0],DV,MB); |
|
dp_ord(O); B = hen_ttob_gsl([DV,NHT[1]],RHS,cdr(S),M); |
|
if ( !B ) |
|
return 0; |
|
Len = length(S); |
|
for ( U = B[1]*car(S), I = 1; I < Len; I++ ) |
|
U += B[0][I-1]*S[I]; |
|
R = ptozp(U); |
|
return R; |
|
} |
|
|
|
/* |
|
* NF = [Pairs,DN] |
|
* Pairs = [[NF1,T1],[NF2,T2],...] |
|
*/ |
|
|
|
def gather_nf_terms(S,NF,V,O) |
|
{ |
|
R = 0; |
|
for ( T = S; T != []; T = cdr(T) ) { |
|
DT = dp_ptod(car(T),V); |
|
for ( U = NF[0]; U != []; U = cdr(U) ) |
|
if ( car(U)[1] == DT ) { |
|
R += tpoly(dp_terms(car(U)[0],V)); |
|
break; |
|
} |
|
} |
|
return map(dp_ptod,p_terms(R,V,O),V); |
|
} |
|
|
def reduce_dn(L) |
def reduce_dn(L) |
{ |
{ |
NM = L[0]; DN = L[1]; V = vars(NM); |
NM = L[0]; DN = L[1]; V = vars(NM); |
Line 352 def minipoly(G0,V,O,P,V0) |
|
Line 479 def minipoly(G0,V,O,P,V0) |
|
if ( !zero_dim(hmlist(G0,V,O),V,O) ) |
if ( !zero_dim(hmlist(G0,V,O),V,O) ) |
error("tolex : ideal is not zero-dimensional!"); |
error("tolex : ideal is not zero-dimensional!"); |
|
|
|
Pin = P; |
|
P = ptozp(P); |
|
CP = sdiv(P,Pin); |
G1 = cons(V0-P,G0); |
G1 = cons(V0-P,G0); |
O1 = [[0,1],[O,length(V)]]; |
O1 = [[0,1],[O,length(V)]]; |
V1 = cons(V0,V); |
V1 = cons(V0,V); |
Line 372 def minipoly(G0,V,O,P,V0) |
|
Line 502 def minipoly(G0,V,O,P,V0) |
|
TL = cons(V0^J,TL); |
TL = cons(V0^J,TL); |
NF = gennf(G1,TL,V1,O1,V0,1)[0]; |
NF = gennf(G1,TL,V1,O1,V0,1)[0]; |
R = tolex_main(V1,O1,NF,[MP],M,MB); |
R = tolex_main(V1,O1,NF,[MP],M,MB); |
return R[0]; |
return ptozp(subst(R[0],V0,CP*V0)); |
} |
} |
} |
} |
|
|
Line 462 def vtop(S,L,GSL) |
|
Line 592 def vtop(S,L,GSL) |
|
} |
} |
} |
} |
|
|
|
/* broken */ |
|
|
def leq_nf(TL,NF,LHS,V) |
def leq_nf(TL,NF,LHS,V) |
{ |
{ |
TLen = length(NF); |
TLen = length(NF); |
Line 918 def p_true_nf(P,B,V,O) { |
|
Line 1050 def p_true_nf(P,B,V,O) { |
|
return [dp_dtop(L[0],V),L[1]]; |
return [dp_dtop(L[0],V),L[1]]; |
} |
} |
|
|
|
def p_nf_mod(P,B,V,O,Mod) { |
|
setmod(Mod); |
|
dp_ord(O); DP = dp_mod(dp_ptod(P,V),Mod,[]); |
|
N = length(B); DB = newvect(N); |
|
for ( I = N-1, IL = []; I >= 0; I-- ) { |
|
DB[I] = dp_mod(dp_ptod(B[I],V),Mod,[]); |
|
IL = cons(I,IL); |
|
} |
|
return dp_dtop(dp_nf_mod(IL,DP,DB,1,Mod),V); |
|
} |
|
|
def p_terms(D,V,O) |
def p_terms(D,V,O) |
{ |
{ |
dp_ord(O); |
dp_ord(O); |
Line 939 def gb_comp(A,B) |
|
Line 1082 def gb_comp(A,B) |
|
LB = length(B); |
LB = length(B); |
if ( LA != LB ) |
if ( LA != LB ) |
return 0; |
return 0; |
A1 = qsort(newvect(LA,A)); |
A = newvect(LA,A); |
B1 = qsort(newvect(LB,B)); |
B = newvect(LB,B); |
for ( I = 0; I < LA; I++ ) |
for ( I = 0; I < LA; I++ ) |
|
A[I] *= headsgn(A[I]); |
|
for ( I = 0; I < LB; I++ ) |
|
B[I] *= headsgn(B[I]); |
|
A1 = qsort(A); |
|
B1 = qsort(B); |
|
for ( I = 0; I < LA; I++ ) |
if ( A1[I] != B1[I] && A1[I] != -B1[I] ) |
if ( A1[I] != B1[I] && A1[I] != -B1[I] ) |
break; |
break; |
return I == LA ? 1 : 0; |
return I == LA ? 1 : 0; |
|
|
Win = "nonhomo"; |
Win = "nonhomo"; |
Lose = P1; |
Lose = P1; |
} else { |
} else { |
Win = "nhomo"; |
Win = "homo"; |
Lose = P0; |
Lose = P0; |
} |
} |
ox_reset(Lose); |
ox_reset(Lose); |
return [Win,R]; |
return [Win,R]; |
} |
} |
|
|
|
/* competitive Gbase computation : F4 vs. Bucbberger */ |
|
/* P : process list */ |
|
|
|
def dgrf4mod(G,V,M,O) |
|
{ |
|
P = getopt(proc); |
|
if ( type(P) == -1 ) |
|
return dp_f4_mod_main(G,V,M,O); |
|
P0 = P[0]; P1 = P[1]; P = [P0,P1]; |
|
map(ox_reset,P); |
|
ox_cmo_rpc(P0,"dp_f4_mod_main",G,V,M,O); |
|
ox_cmo_rpc(P1,"dp_gr_mod_main",G,V,0,M,O); |
|
map(ox_push_cmd,P,262); /* 262 = OX_popCMO */ |
|
F = ox_select(P); |
|
R = ox_get(F[0]); |
|
if ( F[0] == P0 ) { |
|
Win = "F4"; |
|
Lose = P1; |
|
} else { |
|
Win = "Buchberger"; |
|
Lose = P0; |
|
} |
|
ox_reset(Lose); |
|
return [Win,R]; |
|
} |
|
|
/* functions for rpc */ |
/* functions for rpc */ |
|
|
def register_matrix(M) |
def register_matrix(M) |
Line 1449 def register_input(List) |
|
Line 1624 def register_input(List) |
|
Poly <- (Coef*Poly+Monomial*PolyList[Index])/Denominator |
Poly <- (Coef*Poly+Monomial*PolyList[Index])/Denominator |
*/ |
*/ |
|
|
def tracetogen(GBIndex,Trace) |
def tracetogen(G) |
{ |
{ |
|
GB = G[0]; GBIndex = G[1]; Trace = G[2]; |
|
|
InputList = Trace[0]; |
InputList = Trace[0]; |
Trace = cdr(Trace); |
Trace = cdr(Trace); |
|
|
Line 1468 def tracetogen(GBIndex,Trace) |
|
Line 1645 def tracetogen(GBIndex,Trace) |
|
/* stores coeffs */ |
/* stores coeffs */ |
Coef = vector(N); |
Coef = vector(N); |
|
|
|
/* XXX create dp_ptod(1,V) */ |
|
HT = dp_ht(InputList[0]); |
|
One = dp_subd(HT,HT); |
|
|
for ( I = 0; I < Nini; I++ ) { |
for ( I = 0; I < Nini; I++ ) { |
Tr[I] = [1,I,1,1]; |
Tr[I] = [1,I,One,1]; |
C = vector(Nini); |
C = vector(Nini); |
C[I] = 1; |
C[I] = One; |
Coef[I] = C; |
Coef[I] = C; |
} |
} |
for ( ; I < N; I++ ) |
for ( ; I < N; I++ ) |
Line 1511 def compute_coef_by_trace(I,Tr,Coef) |
|
Line 1692 def compute_coef_by_trace(I,Tr,Coef) |
|
} |
} |
Coef[I] = CI; |
Coef[I] = CI; |
} |
} |
end$ |
|
|
extern Gbcheck_DP,Gbcheck_IL$ |
|
|
|
def register_data_for_gbcheck(DPL) |
|
{ |
|
for ( IL = [], I = length(DPL)-1; I >= 0; I-- ) |
|
IL = cons(I,IL); |
|
Gbcheck_DP = newvect(length(DPL),DPL); |
|
Gbcheck_IL = IL; |
|
} |
|
|
|
def sp_nf_for_gbcheck(Pair) |
|
{ |
|
SP = dp_sp(Gbcheck_DP[Pair[0]],Gbcheck_DP[Pair[1]]); |
|
return dp_nf(Gbcheck_IL,SP,Gbcheck_DP,1); |
|
} |
|
|
|
def gbcheck(B,V,O) |
|
{ |
|
dp_ord(O); |
|
D = map(dp_ptod,B,V); |
|
L = dp_gr_checklist(D,length(V)); |
|
DP = L[0]; Plist = L[1]; |
|
for ( IL = [], I = size(DP)[0]-1; I >= 0; I-- ) |
|
IL = cons(I,IL); |
|
Procs = getopt(proc); |
|
if ( type(Procs) == 4 ) { |
|
map(ox_reset,Procs); |
|
/* register DP in servers */ |
|
map(ox_cmo_rpc,Procs,"register_data_for_gbcheck",vtol(DP)); |
|
/* discard return value in stack */ |
|
map(ox_pop_cmo,Procs); |
|
Free = Procs; |
|
Busy = []; |
|
T = Plist; |
|
while ( T != [] || Busy != [] ){ |
|
if ( Free == [] || T == [] ) { |
|
/* someone is working; wait for data */ |
|
Ready = ox_select(Busy); |
|
Busy = setminus(Busy,Ready); |
|
Free = append(Ready,Free); |
|
for ( ; Ready != []; Ready = cdr(Ready) ) { |
|
if ( ox_get(car(Ready)) ) { |
|
map(ox_reset,Procs); |
|
return 0; |
|
} |
|
} |
|
} else { |
|
P = car(Free); |
|
Free = cdr(Free); |
|
Busy = cons(P,Busy); |
|
Pair = car(T); |
|
T = cdr(T); |
|
ox_cmo_rpc(P,"sp_nf_for_gbcheck",Pair); |
|
ox_push_cmd(P,262); /* 262 = OX_popCMO */ |
|
} |
|
} |
|
map(ox_reset,Procs); |
|
return 1; |
|
} else { |
|
for ( T = Plist; T != []; T = cdr(T) ) { |
|
Pair = T[0]; |
|
SP = dp_sp(DP[Pair[0]],DP[Pair[1]]); |
|
if ( dp_nf(IL,SP,DP,1) ) |
|
return 0; |
|
} |
|
return 1; |
|
} |
|
} |
end$ |
end$ |