version 1.6, 2009/10/16 07:39:33 |
version 1.9, 2009/11/12 01:39:54 |
Line 29 localf weyl_nf_quo, weyl_nf_mod, b_subst, v_factorial, |
|
Line 29 localf weyl_nf_quo, weyl_nf_mod, b_subst, v_factorial, |
|
localf replace_vars_f, replace_vars_v, replace_var$ |
localf replace_vars_f, replace_vars_v, replace_var$ |
localf action_on_gfs, action_on_gfs_1$ |
localf action_on_gfs, action_on_gfs_1$ |
localf nd_gb_candidate$ |
localf nd_gb_candidate$ |
|
localf in_gb_oaku$ |
|
|
/* stratification */ |
/* stratification */ |
|
|
|
|
/* y1*y2-1, t-y1*f, dx1+y1*df/dx1*dt ... */ |
/* y1*y2-1, t-y1*f, dx1+y1*df/dx1*dt ... */ |
/* weight for [y1,y2,t, x1,...,xn, dy1,dy2, dt,dx1,...,dxn, h] */ |
/* weight for [y1,y2,t, x1,...,xn, dy1,dy2, dt,dx1,...,dxn, h] */ |
/* 0 1 2 3 N3-1 N3 N3+1 N3+2 2*N3 */ |
/* 0 1 2 3 N3-1 N3 N3+1 N3+2 2*N3 */ |
/* 1 1 D+1 1 1 1 1 1 D D 1 */ |
/* 1 1 D+1 w1 wn 1 1 1 D D 1 */ |
N3 = N+3; |
N3 = N+3; |
WtV = newvect(2*N3+1); |
WtV = newvect(2*N3+1); |
WtV[0] = WtV[1] = 1; WtV[2] = Tdeg+1; |
WtV[0] = WtV[1] = 1; WtV[2] = Tdeg+1; |
for ( I = 3; I <= N3+2; I++ ) WtV[I] = 1; |
for ( I = 3; I < N3; I++ ) WtV[I] = Wt[I-3]; |
|
for ( ; I <= N3+2; I++ ) WtV[I] = 1; |
for ( ; I < 2*N3; I++ ) WtV[I] = Tdeg; |
for ( ; I < 2*N3; I++ ) WtV[I] = Tdeg; |
WtV[2*N3] = 1; |
WtV[2*N3] = 1; |
|
|
|
|
return G3; |
return G3; |
} |
} |
|
|
|
def in_gb_oaku(F) |
|
{ |
|
if ( member(s,vars(F)) ) |
|
error("ann : the variable 's' is reserved."); |
|
F = ptozp(F); |
|
V = vars(F); |
|
N = length(V); |
|
D = newvect(N); |
|
if ( type(Wt=getopt(weight)) == -1 ) |
|
for ( I = N-1, Wt = []; I >= 0; I-- ) Wt = append([V[I],1],Wt); |
|
|
|
Wt1 = vector(N); |
|
for ( I = 0, F1 =F; I < N; I++ ) { |
|
VI = Wt[2*I]; WI = Wt[2*I+1]; |
|
for ( J = 0; J < N; J++ ) |
|
if ( VI == V[J] ) break; |
|
F1 = subst(F1,VI,VI^WI); |
|
} |
|
for ( I = 0; I < N; I++ ) D[I] = [deg(F1,V[I]),V[I]]; |
|
qsort(D,compare_first); |
|
for ( V = [], I = 0; I < N; I++ ) V = cons(D[I][1],V); |
|
V = reverse(V); |
|
for ( I = 0; I < N; I++ ) { |
|
VI = Wt[2*I]; WI = Wt[2*I+1]; |
|
for ( J = 0; J < N; J++ ) if ( VI == V[J] ) break; |
|
Wt1[J] = WI; |
|
} |
|
Wt = vtol(Wt1); |
|
|
|
for ( I = N-1, DV = []; I >= 0; I-- ) |
|
DV = cons(strtov("d"+rtostr(V[I])),DV); |
|
|
|
W = append([TMP_Y1,TMP_Y2,TMP_T],V); |
|
DW = append([TMP_DY1,TMP_DY2,TMP_DT],DV); |
|
|
|
B = [TMP_T-TMP_Y1*F]; |
|
for ( I = 0; I < N; I++ ) { |
|
B = cons(DV[I]+TMP_Y1*diff(F,V[I])*TMP_DT,B); |
|
} |
|
|
|
Tdeg = w_tdeg(F,V,Wt); |
|
/* y1*y2-1, t-y1*f, dx1+y1*df/dx1*dt ... */ |
|
/* weight for [y1,y2,t, x1,...,xn, dy1,dy2, dt,dx1,...,dxn, h] */ |
|
/* 0 1 2 3 N3-1 N3 N3+1 N3+2 2*N3 */ |
|
/* 1 1 D+1 1 1 1 1 1 D D 1 */ |
|
N3 = N+3; |
|
WtV = newvect(2*N3+1); |
|
WtV[0] = WtV[1] = 1; WtV[2] = Tdeg+1; |
|
for ( I = 3; I <= N3+2; I++ ) WtV[I] = 1; |
|
for ( ; I < 2*N3; I++ ) WtV[I] = Tdeg; |
|
WtV[2*N3] = 1; |
|
|
|
/* B is already a GB => modular change of ordering can be applied */ |
|
/* any prime is available => HC=[1] */ |
|
dp_set_weight(WtV); |
|
G0 = nd_gb_candidate(B,append(W,DW),[[0,2],[0,length(W)*2-2]],0,[1],1); |
|
dp_set_weight(0); |
|
G1 = map(subst,G0,TMP_Y1,1); |
|
return [G1,append(V,DV)]; |
|
} |
|
|
/* F = [F0,F1,...] */ |
/* F = [F0,F1,...] */ |
|
|
def ann_n(F) |
def ann_n(F) |
Line 1387 def bf_strat_stage3(L) |
|
Line 1450 def bf_strat_stage3(L) |
|
} |
} |
dp_set_weight(0); |
dp_set_weight(0); |
if ( K < J ) { |
if ( K < J ) { |
for ( L = 0, T = []; L < NDI; L++ ) |
for ( L = 0, T = []; L < NDI; L++ ) { |
|
#if 0 |
|
NewId = DK[L][1]; |
|
#else |
|
NewId = ideal_intersection(DK[L][1],DI[L][1],V0,0); |
|
#endif |
T = cons([[DK[L][0][0]*DI[L][0][0],DK[L][0][1]], |
T = cons([[DK[L][0][0]*DI[L][0][0],DK[L][0][1]], |
DK[L][1],DK[L][2]],T); |
NewId,DK[L][2]],T); |
|
} |
Data[K] = reverse(T); |
Data[K] = reverse(T); |
} else |
} else |
Data[J++] = DI; |
Data[J++] = DI; |