version 1.15, 2001/01/11 08:43:23 |
version 1.17, 2002/01/28 01:02:03 |
|
|
* 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/bfct,v 1.14 2001/01/10 04:30:35 noro Exp $ |
* $OpenXM: OpenXM_contrib2/asir2000/lib/bfct,v 1.16 2001/01/18 00:52:32 noro Exp $ |
*/ |
*/ |
/* requires 'primdec' */ |
/* requires 'primdec' */ |
|
|
Line 212 def generic_bfct(F,V,DV,W) |
|
Line 212 def generic_bfct(F,V,DV,W) |
|
N = length(V); |
N = length(V); |
N2 = N*2; |
N2 = N*2; |
|
|
|
/* If W is a list, convert it to a vector */ |
|
if ( type(W) == 4 ) |
|
W = newvect(length(W),W); |
dp_weyl_set_weight(W); |
dp_weyl_set_weight(W); |
|
|
/* create a term order M in D<x,d> (DRL) */ |
/* create a term order M in D<x,d> (DRL) */ |
Line 348 def bfct_via_gbfct(F) |
|
Line 351 def bfct_via_gbfct(F) |
|
return subst(R,s,-s-1); |
return subst(R,s,-s-1); |
} |
} |
|
|
|
/* use an order s.t. [t,x,y,z,...,dt,dx,dy,dz,...,h] */ |
|
|
|
def bfct_via_gbfct_weight(F,V) |
|
{ |
|
N = length(V); |
|
D = newvect(N); |
|
Wt = getopt(weight); |
|
if ( type(Wt) == 4 ) { |
|
Tdeg = w_tdeg(F,V,Wt); |
|
WtV = newvect(2*(N+1)+1); |
|
WtV[0] = Tdeg; |
|
WtV[N+1] = 1; |
|
/* wdeg(V[I])=Wt[I], wdeg(DV[I])=Tdeg-Wt[I]+1 */ |
|
for ( I = 1; I <= N; I++ ) { |
|
WtV[I] = Wt[I-1]; |
|
WtV[N+1+I] = Tdeg-Wt[I-1]+1; |
|
} |
|
WtV[2*(N+1)] = 1; |
|
dp_set_weight(WtV); |
|
} |
|
for ( I = N-1, DV = []; I >= 0; I-- ) |
|
DV = cons(strtov("d"+rtostr(V[I])),DV); |
|
|
|
B = [t-F]; |
|
for ( I = 0; I < N; I++ ) { |
|
B = cons(DV[I]+diff(F,V[I])*dt,B); |
|
} |
|
V1 = cons(t,V); DV1 = cons(dt,DV); |
|
W = newvect(N+1); |
|
W[0] = 1; |
|
R = generic_bfct(B,V1,DV1,W); |
|
|
|
return subst(R,s,-s-1); |
|
} |
|
|
|
/* use an order s.t. [x,y,z,...,t,dx,dy,dz,...,dt,h] */ |
|
|
|
def bfct_via_gbfct_weight_1(F,V) |
|
{ |
|
N = length(V); |
|
D = newvect(N); |
|
Wt = getopt(weight); |
|
if ( type(Wt) == 4 ) { |
|
Tdeg = w_tdeg(F,V,Wt); |
|
WtV = newvect(2*(N+1)); |
|
/* wdeg(V[I])=Wt[I], wdeg(DV[I])=Tdeg-Wt[I]+1 */ |
|
for ( I = 0; I < N; I++ ) { |
|
WtV[I] = Wt[I]; |
|
WtV[N+1+I] = Tdeg-Wt[I]+1; |
|
} |
|
WtV[N] = Tdeg; |
|
WtV[2*N+1] = 1; |
|
dp_set_weight(WtV); |
|
} |
|
for ( I = N-1, DV = []; I >= 0; I-- ) |
|
DV = cons(strtov("d"+rtostr(V[I])),DV); |
|
|
|
B = [t-F]; |
|
for ( I = 0; I < N; I++ ) { |
|
B = cons(DV[I]+diff(F,V[I])*dt,B); |
|
} |
|
V1 = append(V,[t]); DV1 = append(DV,[dt]); |
|
W = newvect(N+1); |
|
W[N] = 1; |
|
R = generic_bfct(B,V1,DV1,W); |
|
|
|
return subst(R,s,-s-1); |
|
} |
|
|
def weyl_minipolym(G,V,O,M,V0) |
def weyl_minipolym(G,V,O,M,V0) |
{ |
{ |
N = length(V); |
N = length(V); |
Line 366 def weyl_minipolym(G,V,O,M,V0) |
|
Line 438 def weyl_minipolym(G,V,O,M,V0) |
|
GI = cons(I,GI); |
GI = cons(I,GI); |
|
|
U = dp_mod(dp_ptod(V0,V),M,[]); |
U = dp_mod(dp_ptod(V0,V),M,[]); |
|
U = dp_weyl_nf_mod(GI,U,PS,1,M); |
|
|
T = dp_mod(<<0>>,M,[]); |
T = dp_mod(<<0>>,M,[]); |
TT = dp_mod(dp_ptod(1,V),M,[]); |
TT = dp_mod(dp_ptod(1,V),M,[]); |
Line 545 def v_factorial(V,N) |
|
Line 618 def v_factorial(V,N) |
|
{ |
{ |
for ( J = N-1, R = 1; J >= 0; J-- ) |
for ( J = N-1, R = 1; J >= 0; J-- ) |
R *= V-J; |
R *= V-J; |
|
return R; |
|
} |
|
|
|
def w_tdeg(F,V,W) |
|
{ |
|
dp_set_weight(newvect(length(W),W)); |
|
T = dp_ptod(F,V); |
|
for ( R = 0; T; T = cdr(T) ) { |
|
D = dp_td(T); |
|
if ( D > R ) R = D; |
|
} |
return R; |
return R; |
} |
} |
end$ |
end$ |