version 1.13, 2001/11/19 00:57:13 |
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.12 2001/11/01 10:00:19 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 950 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; |
Line 1575 def gbcheck(B,V,O) |
|
Line 1713 def gbcheck(B,V,O) |
|
{ |
{ |
dp_ord(O); |
dp_ord(O); |
D = map(dp_ptod,B,V); |
D = map(dp_ptod,B,V); |
L = dp_gr_checklist(D); |
L = dp_gr_checklist(D,length(V)); |
DP = L[0]; Plist = L[1]; |
DP = L[0]; Plist = L[1]; |
for ( IL = [], I = size(DP)[0]-1; I >= 0; I-- ) |
for ( IL = [], I = size(DP)[0]-1; I >= 0; I-- ) |
IL = cons(I,IL); |
IL = cons(I,IL); |