version 1.5, 2000/08/21 08:31:41 |
version 1.16, 2002/09/03 08:12:25 |
|
|
* shall be made on your publication or presentation in any form of the |
* shall be made on your publication or presentation in any form of the |
* results obtained by use of the SOFTWARE. |
* results obtained by use of the SOFTWARE. |
* (4) In the event that you modify the SOFTWARE, you shall notify FLL by |
* (4) In the event that you modify the SOFTWARE, you shall notify FLL by |
* e-mail at risa-admin@flab.fujitsu.co.jp of the detailed specification |
* e-mail at risa-admin@sec.flab.fujitsu.co.jp of the detailed specification |
* for such modification or the source code of the modified part of the |
* for such modification or the source code of the modified part of the |
* SOFTWARE. |
* SOFTWARE. |
* |
* |
|
|
* 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.4 2000/07/14 08:26:40 noro Exp $ |
* $OpenXM: OpenXM_contrib2/asir2000/lib/gr,v 1.15 2002/06/12 08:19:04 noro Exp $ |
*/ |
*/ |
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 128 def tolex(G0,V,O,W) |
|
Line 128 def tolex(G0,V,O,W) |
|
{ |
{ |
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); |
R = tolex_main(V,O,NF,GM,M,MB); |
Line 254 def tolex_gsl_main(G0,V,O,W,NFL,NPOSV,GM,M,MB) |
|
Line 265 def tolex_gsl_main(G0,V,O,W,NFL,NPOSV,GM,M,MB) |
|
R += B[0][K]*TERMS[K]; |
R += B[0][K]*TERMS[K]; |
LCM *= B[1]; |
LCM *= B[1]; |
SL = cons(cons(V1,[R,LCM]),SL); |
SL = cons(cons(V1,[R,LCM]),SL); |
print(["DN",B[1]]); |
if ( dp_gr_print() ) |
|
print(["DN",B[1]]); |
} |
} |
return SL; |
return SL; |
} |
} |
Line 265 def hen_ttob_gsl(LHS,RHS,TERMS,M) |
|
Line 277 def hen_ttob_gsl(LHS,RHS,TERMS,M) |
|
L1 = idiv(LCM,LDN); R1 = idiv(LCM,RDN); |
L1 = idiv(LCM,LDN); R1 = idiv(LCM,RDN); |
T0 = time()[0]; |
T0 = time()[0]; |
S = henleq_gsl(RHS[0],LHS[0]*L1,M); |
S = henleq_gsl(RHS[0],LHS[0]*L1,M); |
print(["henleq_gsl",time()[0]-T0]); |
if ( dp_gr_print() ) |
|
print(["henleq_gsl",time()[0]-T0]); |
N = length(TERMS); |
N = length(TERMS); |
return [S[0],S[1]*R1]; |
return [S[0],S[1]*R1]; |
} |
} |
Line 314 def dptov(P,W,MB) |
|
Line 327 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 330 def tolex_main(V,O,NF,GM,M,MB) |
|
Line 351 def tolex_main(V,O,NF,GM,M,MB) |
|
U += B[0][I-1]*S[I]; |
U += B[0][I-1]*S[I]; |
R = ptozp(U); |
R = ptozp(U); |
SL = cons(R,SL); |
SL = cons(R,SL); |
print(["DN",B[1]]); |
if ( dp_gr_print() ) |
|
print(["DN",B[1]]); |
} |
} |
return SL; |
return SL; |
} |
} |
|
|
|
/* |
|
* 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 349 def minipoly(G0,V,O,P,V0) |
|
Line 390 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 369 def minipoly(G0,V,O,P,V0) |
|
Line 413 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 399 def gennf(G,TL,V,O,V0,FLAG) |
|
Line 443 def gennf(G,TL,V,O,V0,FLAG) |
|
if ( dp_gr_print() ) |
if ( dp_gr_print() ) |
print(".",2); |
print(".",2); |
} |
} |
print(""); |
if ( dp_gr_print() ) |
|
print(""); |
TTAB = time()[0]-T0; |
TTAB = time()[0]-T0; |
} |
} |
|
|
Line 458 def vtop(S,L,GSL) |
|
Line 503 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 554 def tolexm_main(PS,HL,V,W,M,FLAG) |
|
Line 601 def tolexm_main(PS,HL,V,W,M,FLAG) |
|
print(".",2); |
print(".",2); |
UTAB[I] = [MB[I],dp_nf_mod(GI,U*dp_mod(MB[I],M,[]),PS,1,M)]; |
UTAB[I] = [MB[I],dp_nf_mod(GI,U*dp_mod(MB[I],M,[]),PS,1,M)]; |
} |
} |
print(""); |
if ( dp_gr_print() ) |
|
print(""); |
T = dp_mod(dp_ptod(dp_dtop(dp_vtoe(D),W),V),M,[]); |
T = dp_mod(dp_ptod(dp_dtop(dp_vtoe(D),W),V),M,[]); |
H = G = [[T,T]]; |
H = G = [[T,T]]; |
DL = []; G2 = []; |
DL = []; G2 = []; |
Line 913 def p_true_nf(P,B,V,O) { |
|
Line 961 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 930 def dp_terms(D,V) |
|
Line 989 def dp_terms(D,V) |
|
|
|
def gb_comp(A,B) |
def gb_comp(A,B) |
{ |
{ |
for ( T = A; T != []; T = cdr(T) ) { |
LA = length(A); |
for ( S = B, M = car(T), N = -M; S != []; S = cdr(S) ) |
LB = length(B); |
if ( car(S) == M || car(S) == N ) |
if ( LA != LB ) |
break; |
return 0; |
if ( S == [] ) |
A1 = qsort(newvect(LA,A)); |
|
B1 = qsort(newvect(LB,B)); |
|
for ( I = 0; I < LA; I++ ) |
|
if ( A1[I] != B1[I] && A1[I] != -B1[I] ) |
break; |
break; |
} |
return I == LA ? 1 : 0; |
return T == [] ? 1 : 0; |
|
} |
} |
|
|
def zero_dim(G,V,O) { |
def zero_dim(G,V,O) { |
|
|
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 1427 def register_input(List) |
|
Line 1514 def register_input(List) |
|
{ |
{ |
Len = length(List); |
Len = length(List); |
NFArray = newvect(Len+100,List); |
NFArray = newvect(Len+100,List); |
|
} |
|
|
|
/* |
|
tracetogen(): preliminary version |
|
|
|
dp_gr_main() returns [GB,GBIndex,Trace]. |
|
GB : groebner basis |
|
GBIndex : IndexList (corresponding to Trace) |
|
Trace : [InputList,Trace0,Trace1,...] |
|
TraceI : [Index,TraceList] |
|
TraceList : [[Coef,Index,Monomial,Denominator],...] |
|
Poly <- 0 |
|
Poly <- (Coef*Poly+Monomial*PolyList[Index])/Denominator |
|
*/ |
|
|
|
def tracetogen(G) |
|
{ |
|
GB = G[0]; GBIndex = G[1]; Trace = G[2]; |
|
|
|
InputList = Trace[0]; |
|
Trace = cdr(Trace); |
|
|
|
/* number of initial basis */ |
|
Nini = length(InputList); |
|
|
|
/* number of generated basis */ |
|
Ngen = length(Trace); |
|
|
|
N = Nini + Ngen; |
|
|
|
/* stores traces */ |
|
Tr = vector(N); |
|
|
|
/* stores coeffs */ |
|
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++ ) { |
|
Tr[I] = [1,I,One,1]; |
|
C = vector(Nini); |
|
C[I] = One; |
|
Coef[I] = C; |
|
} |
|
for ( ; I < N; I++ ) |
|
Tr[I] = Trace[I-Nini][1]; |
|
|
|
for ( T = GBIndex; T != []; T = cdr(T) ) |
|
compute_coef_by_trace(car(T),Tr,Coef); |
|
return Coef; |
|
} |
|
|
|
def compute_coef_by_trace(I,Tr,Coef) |
|
{ |
|
if ( Coef[I] ) |
|
return; |
|
|
|
/* XXX */ |
|
Nini = size(Coef[0])[0]; |
|
|
|
/* initialize coef vector */ |
|
CI = vector(Nini); |
|
|
|
for ( T = Tr[I]; T != []; T = cdr(T) ) { |
|
/* Trace = [Coef,Index,Monomial,Denominator] */ |
|
Trace = car(T); |
|
C = Trace[0]; |
|
Ind = Trace[1]; |
|
Mon = Trace[2]; |
|
Den = Trace[3]; |
|
if ( !Coef[Ind] ) |
|
compute_coef_by_trace(Ind,Tr,Coef); |
|
|
|
/* XXX */ |
|
CT = newvect(Nini); |
|
for ( J = 0; J < Nini; J++ ) |
|
CT[J] = (C*CI[J]+Mon*Coef[Ind][J])/Den; |
|
CI = CT; |
|
} |
|
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$ |