version 1.17, 2002/09/03 09:57:51 |
version 1.21, 2005/08/02 07:21:48 |
|
|
* 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.16 2002/09/03 08:12:25 noro Exp $ |
* $OpenXM: OpenXM_contrib2/asir2000/lib/gr,v 1.20 2004/07/21 05:12:29 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 505 def minipoly(G0,V,O,P,V0) |
|
Line 510 def minipoly(G0,V,O,P,V0) |
|
|
|
def gennf(G,TL,V,O,V0,FLAG) |
def gennf(G,TL,V,O,V0,FLAG) |
{ |
{ |
|
F = dp_gr_flags(); |
|
for ( T = F; T != []; T = cdr(T) ) { |
|
Key = car(T); T = cdr(T); |
|
if ( Key == "Demand" ) { |
|
Dir = car(T); break; |
|
} |
|
} |
|
if ( Dir ) |
|
return gennf_demand(G,TL,V,O,V0,FLAG,Dir); |
N = length(V); Len = length(G); dp_ord(O); PS = newvect(Len); |
N = length(V); Len = length(G); dp_ord(O); PS = newvect(Len); |
for ( I = 0, T = G, HL = []; T != []; T = cdr(T), I++ ) { |
for ( I = 0, T = G, HL = []; T != []; T = cdr(T), I++ ) { |
PS[I] = dp_ptod(car(T),V); HL = cons(dp_ht(PS[I]),HL); |
PS[I] = dp_ptod(car(T),V); HL = cons(dp_ht(PS[I]),HL); |
Line 556 def gennf(G,TL,V,O,V0,FLAG) |
|
Line 570 def gennf(G,TL,V,O,V0,FLAG) |
|
return [[map(adj_dn,H,LCM),LCM],PS,GI]; |
return [[map(adj_dn,H,LCM),LCM],PS,GI]; |
} |
} |
|
|
|
def gennf_demand(G,TL,V,O,V0,FLAG,Dir) |
|
{ |
|
N = length(V); Len = length(G); dp_ord(O); PS = newvect(Len); |
|
NTL = length(TL); |
|
for ( I = 0, T = G, HL = []; T != []; T = cdr(T), I++ ) { |
|
PS[I] = dp_ptod(car(T),V); HL = cons(dp_ht(PS[I]),HL); |
|
} |
|
for ( I = 0, DTL = []; TL != []; TL = cdr(TL) ) |
|
DTL = cons(dp_ptod(car(TL),V),DTL); |
|
for ( I = Len - 1, GI = []; I >= 0; I-- ) |
|
GI = cons(I,GI); |
|
|
|
USE_TAB = (FLAG != 0); |
|
if ( USE_TAB ) { |
|
T0 = time()[0]; |
|
MB = dp_mbase(HL); DIM = length(MB); |
|
U = dp_ptod(V0,V); |
|
UTAB = newvect(DIM); |
|
for ( I = 0; I < DIM; I++ ) { |
|
UTAB[I] = [MB[I],remove_cont(dp_true_nf(GI,U*MB[I],PS,1))]; |
|
if ( dp_gr_print() ) |
|
print(".",2); |
|
} |
|
if ( dp_gr_print() ) |
|
print(""); |
|
TTAB = time()[0]-T0; |
|
} |
|
|
|
T0 = time()[0]; |
|
for ( LCM = 1, Index = 0, H = []; DTL != []; Index++ ) { |
|
if ( dp_gr_print() ) |
|
print(".",2); |
|
T = car(DTL); DTL = cdr(DTL); |
|
if ( L = search_redble(T,H) ) { |
|
L = nf_load(Dir,L[0]); |
|
DD = dp_subd(T,L[1]); |
|
if ( USE_TAB && (DD == U) ) { |
|
NF = nf_tab(L[0],UTAB); |
|
NF = [NF[0],dp_hc(L[1])*NF[1]*T]; |
|
} else |
|
NF = nf(GI,L[0]*dp_subd(T,L[1]),dp_hc(L[1])*T,PS); |
|
} else |
|
NF = nf(GI,T,T,PS); |
|
NF = remove_cont(NF); |
|
nf_save(NF,Dir,Index); |
|
H = cons([Index,NF[1]],H); |
|
LCM = ilcm(LCM,dp_hc(NF[1])); |
|
} |
|
TNF = time()[0]-T0; |
|
if ( dp_gr_print() ) |
|
print("gennf(TAB="+rtostr(TTAB)+" NF="+rtostr(TNF)+")"); |
|
|
|
for ( I = 0; I < NTL; I++ ) { |
|
NF = nf_load(Dir,I); |
|
NF = adj_dn(NF,LCM); |
|
nf_save(NF,Dir,I); |
|
} |
|
for ( H = [], I = NTL-1; I >= 0; I-- ) |
|
H = cons(nf_load(Dir,I),H); |
|
return [[H,LCM],PS,GI]; |
|
} |
|
|
|
def nf_load(Dir,I) |
|
{ |
|
return bload(Dir+"/nf"+rtostr(I)); |
|
} |
|
|
|
def nf_save(NF,Dir,I) |
|
{ |
|
bsave(NF,Dir+"/nf"+rtostr(I)); |
|
} |
|
|
def adj_dn(P,D) |
def adj_dn(P,D) |
{ |
{ |
return [(idiv(D,dp_hc(P[1])))*P[0],dp_ht(P[1])]; |
return [(idiv(D,dp_hc(P[1])))*P[0],dp_ht(P[1])]; |
Line 1077 def gb_comp(A,B) |
|
Line 1163 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 1574 def check_trace(NF,NFIndex,HL) |
|
Line 1666 def check_trace(NF,NFIndex,HL) |
|
return 0; |
return 0; |
} else |
} else |
error("check_trace"); |
error("check_trace"); |
|
} |
|
|
|
/* |
|
* Trace = [Input,[[j1,[[c,i,m,d],...]],[j2,[[...],...]],...]] |
|
* if c != 0 |
|
* g = 0 |
|
* g = (c*g + m*gi)/d |
|
* ... |
|
* finally fj = g |
|
*/ |
|
|
|
def show_trace(Trace,V) |
|
{ |
|
Input = Trace[0]; |
|
for ( I = 0, T = Input; T != []; T = cdr(T), I++ ) { |
|
print("F"+rtostr(I)+"=",0); |
|
print(dp_dtop(car(T),V)); |
|
} |
|
Trace = cdr(Trace); |
|
for ( T = Trace; T != []; T = cdr(T) ) { |
|
HL = car(T); |
|
J = car(HL); HL = HL[1]; |
|
L = length(HL); |
|
print("F"+rtostr(J)+"=",0); |
|
for ( I = 0; I < L; I++ ) print("(",0); |
|
for ( First = 1, S = HL; S != []; S = cdr(S) ) { |
|
H = car(S); |
|
|
|
Coeff = H[0]; |
|
Index = H[1]; |
|
Monomial = H[2]; |
|
Denominator = H[3]; |
|
if ( First ) { |
|
if ( Monomial != 1 ) { |
|
print("(",0); |
|
print(type(Monomial)==9?dp_dtop(Monomial,V):Monomial,0); |
|
print(")*",0); |
|
} |
|
print("F"+rtostr(Index)+")",0); |
|
} else { |
|
if ( Coeff != 1 ) { |
|
print("*(",0); print(Coeff,0); print(")",0); |
|
} |
|
print("+",0); |
|
if ( Monomial != 1 ) { |
|
print("(",0); |
|
print(type(Monomial)==9?dp_dtop(Monomial,V):Monomial,0); |
|
print(")*",0); |
|
} |
|
print("F"+rtostr(Index)+")",0); |
|
if ( Denominator != 1 ) { |
|
print("/",0); print(Denominator,0); |
|
} |
|
} |
|
if ( First ) First = 0; |
|
} |
|
print(""); |
|
} |
} |
} |
|
|
/* |
/* |