| version 1.6, 2000/08/22 05:04:22 | version 1.13, 2001/11/19 00:57:13 | 
|  |  | 
| * 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.5 2000/08/21 08:31:41 noro Exp $ | * $OpenXM: OpenXM_contrib2/asir2000/lib/gr,v 1.12 2001/11/01 10:00:19 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 254  def tolex_gsl_main(G0,V,O,W,NFL,NPOSV,GM,M,MB) |  | 
| Line 254  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 266  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 330  def tolex_main(V,O,NF,GM,M,MB) |  | 
| Line 332  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; | 
| } | } | 
| 
| Line 399  def gennf(G,TL,V,O,V0,FLAG) |  | 
| Line 402  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 554  def tolexm_main(PS,HL,V,W,M,FLAG) |  | 
| Line 558  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 918  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 946  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 1471  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); | 
|  | 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$ |