| version 1.10, 2001/09/06 00:24:07 |
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.9 2001/09/05 08:09:10 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 1516 def compute_coef_by_trace(I,Tr,Coef) |
|
| Line 1691 def compute_coef_by_trace(I,Tr,Coef) |
|
| CI = CT; |
CI = CT; |
| } |
} |
| Coef[I] = CI; |
Coef[I] = CI; |
| |
} |
| |
|
| |
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$ |