version 1.4, 2000/07/14 08:26:40 |
version 1.19, 2003/10/20 00:58:47 |
|
|
/* $OpenXM: OpenXM_contrib2/asir2000/lib/gr,v 1.3 2000/06/05 02:26:48 noro Exp $ */ |
/* |
|
* Copyright (c) 1994-2000 FUJITSU LABORATORIES LIMITED |
|
* All rights reserved. |
|
* |
|
* FUJITSU LABORATORIES LIMITED ("FLL") hereby grants you a limited, |
|
* non-exclusive and royalty-free license to use, copy, modify and |
|
* redistribute, solely for non-commercial and non-profit purposes, the |
|
* computer program, "Risa/Asir" ("SOFTWARE"), subject to the terms and |
|
* conditions of this Agreement. For the avoidance of doubt, you acquire |
|
* only a limited right to use the SOFTWARE hereunder, and FLL or any |
|
* third party developer retains all rights, including but not limited to |
|
* copyrights, in and to the SOFTWARE. |
|
* |
|
* (1) FLL does not grant you a license in any way for commercial |
|
* purposes. You may use the SOFTWARE only for non-commercial and |
|
* non-profit purposes only, such as academic, research and internal |
|
* business use. |
|
* (2) The SOFTWARE is protected by the Copyright Law of Japan and |
|
* international copyright treaties. If you make copies of the SOFTWARE, |
|
* with or without modification, as permitted hereunder, you shall affix |
|
* to all such copies of the SOFTWARE the above copyright notice. |
|
* (3) An explicit reference to this SOFTWARE and its copyright owner |
|
* shall be made on your publication or presentation in any form of the |
|
* results obtained by use of the SOFTWARE. |
|
* (4) In the event that you modify the SOFTWARE, you shall notify FLL by |
|
* 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 |
|
* SOFTWARE. |
|
* |
|
* THE SOFTWARE IS PROVIDED AS IS WITHOUT ANY WARRANTY OF ANY KIND. FLL |
|
* MAKES ABSOLUTELY NO WARRANTIES, EXPRESSED, IMPLIED OR STATUTORY, AND |
|
* EXPRESSLY DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS |
|
* FOR A PARTICULAR PURPOSE OR NONINFRINGEMENT OF THIRD PARTIES' |
|
* RIGHTS. NO FLL DEALER, AGENT, EMPLOYEES IS AUTHORIZED TO MAKE ANY |
|
* MODIFICATIONS, EXTENSIONS, OR ADDITIONS TO THIS WARRANTY. |
|
* UNDER NO CIRCUMSTANCES AND UNDER NO LEGAL THEORY, TORT, CONTRACT, |
|
* OR OTHERWISE, SHALL FLL BE LIABLE TO YOU OR ANY OTHER PERSON FOR ANY |
|
* DIRECT, INDIRECT, SPECIAL, INCIDENTAL, PUNITIVE OR CONSEQUENTIAL |
|
* DAMAGES OF ANY CHARACTER, INCLUDING, WITHOUT LIMITATION, DAMAGES |
|
* ARISING OUT OF OR RELATING TO THE SOFTWARE OR THIS AGREEMENT, DAMAGES |
|
* FOR LOSS OF GOODWILL, WORK STOPPAGE, OR LOSS OF DATA, OR FOR ANY |
|
* DAMAGES, EVEN IF FLL SHALL HAVE BEEN INFORMED OF THE POSSIBILITY OF |
|
* SUCH DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY. EVEN IF A PART |
|
* OF THE SOFTWARE HAS BEEN DEVELOPED BY A THIRD PARTY, THE THIRD PARTY |
|
* DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, |
|
* PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. |
|
* |
|
* $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 78 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 206 def tolex_gsl_main(G0,V,O,W,NFL,NPOSV,GM,M,MB) |
|
Line 275 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 217 def hen_ttob_gsl(LHS,RHS,TERMS,M) |
|
Line 287 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 266 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 282 def tolex_main(V,O,NF,GM,M,MB) |
|
Line 361 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; |
} |
} |
|
|
|
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 301 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 321 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 351 def gennf(G,TL,V,O,V0,FLAG) |
|
Line 532 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 410 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 506 def tolexm_main(PS,HL,V,W,M,FLAG) |
|
Line 690 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 865 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 882 def dp_terms(D,V) |
|
Line 1078 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 == [] ) |
A = newvect(LA,A); |
|
B = newvect(LB,B); |
|
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] ) |
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 1379 def register_input(List) |
|
Line 1609 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$ |