===================================================================
RCS file: /home/cvs/OpenXM_contrib2/asir2000/lib/bfct,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -p -r1.18 -r1.19
--- OpenXM_contrib2/asir2000/lib/bfct	2002/01/28 02:42:27	1.18
+++ OpenXM_contrib2/asir2000/lib/bfct	2002/01/29 02:03:41	1.19
@@ -45,7 +45,7 @@
  * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
  * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
  *
- * $OpenXM: OpenXM_contrib2/asir2000/lib/bfct,v 1.17 2002/01/28 01:02:03 noro Exp $
+ * $OpenXM: OpenXM_contrib2/asir2000/lib/bfct,v 1.18 2002/01/28 02:42:27 noro Exp $
  */
 /* requires 'primdec' */
 
@@ -485,6 +485,96 @@ def bfct_via_gbfct_weight_1(F,V)
 	W = newvect(N+1);
 	W[N] = 1;
 	R = generic_bfct(B,V1,DV1,W);
+	dp_set_weight(0);
+	return subst(R,s,-s-1);
+}
+
+def bfct_via_gbfct_weight_2(F,V)
+{
+	N = length(V);
+	D = newvect(N);
+	Wt = getopt(weight);
+	if ( type(Wt) != 4 ) {
+		for ( I = 0, Wt = []; I < N; I++ )
+			Wt = cons(1,Wt);
+	}
+	Tdeg = w_tdeg(F,V,Wt);
+
+	/* a weight for the first GB computation */
+	/* [t,x1,...,xn,dt,dx1,...,dxn,h] */
+	WtV = newvect(2*(N+1)+1);
+	WtV[0] = Tdeg;
+	WtV[N+1] = 1;
+	WtV[2*(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;
+	}
+	dp_set_weight(WtV);
+
+	/* a weight for the second GB computation */
+	/* [x1,...,xn,t,dx1,...,dxn,dt,h] */
+	WtV2 = newvect(2*(N+1)+1);
+	WtV2[N] = Tdeg;
+	WtV2[2*N+1] = 1;
+	WtV2[2*(N+1)] = 1;
+	for ( I = 0; I < N; I++ ) {
+		WtV2[I] = Wt[I];
+		WtV2[N+1+I] = Tdeg-Wt[I]+1;
+	}
+
+	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);
+	V2 = append(V,[t]); DV2 = append(DV,[dt]);
+	W = newvect(N+1,[1]);
+	dp_weyl_set_weight(W);
+
+	VDV = append(V1,DV1);
+	N1 = length(V1);
+	N2 = N1*2;
+
+	/* create a non-term order MW in D<x,d> */
+	MW = newmat(N2+1,N2);
+	for ( J = 0; J < N1; J++ ) {
+		MW[0][J] = -W[J]; MW[0][N1+J] = W[J];
+	}
+	for ( J = 0; J < N2; J++ ) MW[1][J] = 1;
+	for ( I = 2; I <= N2; I++ ) MW[I][N2-I+1] = -1;
+
+	/* homogenize F */
+	VDVH = append(VDV,[h]);
+	FH = map(dp_dtop,map(dp_homo,map(dp_ptod,B,VDV)),VDVH);
+	
+	/* compute a groebner basis of FH w.r.t. MWH */
+	GH = dp_weyl_gr_main(FH,VDVH,0,1,11);
+
+	/* dehomigenize GH */
+	G = map(subst,GH,h,1);
+
+	/* G is a groebner basis w.r.t. a non term order MW */
+	/* take the initial part w.r.t. (-W,W) */
+	GIN = map(initial_part,G,VDV,MW,W);
+
+	/* GIN is a groebner basis w.r.t. a term order M */
+	/* As -W+W=0, gr_(-W,W)(D<x,d>) = D<x,d> */
+	
+	/* find b(W1*x1*d1+...+WN*xN*dN) in Id(GIN) */
+	for ( I = 0, T = 0; I < N1; I++ )
+		T += W[I]*V1[I]*DV1[I];
+
+	/* change of ordering from VDV to VDV2 */
+	VDV2 = append(V2,DV2);
+	dp_set_weight(WtV2);
+	GIN2 = dp_weyl_gr_main(GIN,VDV2,0,-1,0);
+
+	R = weyl_minipoly(GIN2,VDV2,0,T); /* M represents DRL order */
 	dp_set_weight(0);
 	return subst(R,s,-s-1);
 }