===================================================================
RCS file: /home/cvs/OpenXM/src/asir-contrib/testing/noro/ndbf.rr,v
retrieving revision 1.15
retrieving revision 1.20
diff -u -p -r1.15 -r1.20
--- OpenXM/src/asir-contrib/testing/noro/ndbf.rr	2010/06/19 08:32:37	1.15
+++ OpenXM/src/asir-contrib/testing/noro/ndbf.rr	2014/09/05 11:55:19	1.20
@@ -1,11 +1,11 @@
-/* $OpenXM$ */
+/* $OpenXM: OpenXM/src/asir-contrib/testing/noro/ndbf.rr,v 1.19 2011/03/30 05:07:01 noro Exp $ */
 /* requires 'primdec' */
 
 #define TMP_H hhhhhhhh
 #define TMP_S ssssssss
 #define TMP_DS dssssssss
-#define TMP_T t
-#define TMP_DT dt
+#define TMP_T tttttttt
+#define TMP_DT dtttttttt
 #define TMP_Y1 yyyyyyyy1
 #define TMP_DY1 dyyyyyyyy1
 #define TMP_Y2 yyyyyyyy2
@@ -31,7 +31,7 @@ localf weyl_nf_quo, weyl_nf_mod, b_subst, v_factorial,
 localf replace_vars_f, replace_vars_v, replace_var$
 localf action_on_gfs, action_on_gfs_1$
 localf nd_gb_candidate$
-localf in_gb_oaku$
+localf in_gb_oaku, homogenize_oaku$
 
 /* stratification */
 
@@ -45,6 +45,8 @@ localf ideal_intersection$
 
 def bfunction(F)
 {
+	if ( member(s,vars(F)) )
+		error("ann : the variable 's' is reserved.");
 	/* F -> F/Fcont */
 	F1 = ptozp(F); Fcont = sdiv(F,F1); F = F1;
 
@@ -110,7 +112,7 @@ def in_ww(F)
 		if ( type(Vord) != 4 ) {
 	    	for ( I = 0; I < N; I++ )
 	    		D[I] = [deg(F,V[I]),V[I]];
-	    	qsort(D,compare_first);
+	    	qsort(D,ndbf.compare_first);
 	    	for ( V = [], I = 0; I < N; I++ )
 	    		V = cons(D[I][1],V);
 			V = reverse(V);
@@ -129,7 +131,7 @@ def in_ww(F)
 			}
 	    	for ( I = 0; I < N; I++ )
 	    		D[I] = [deg(F1,V[I]),V[I]];
-	    	qsort(D,compare_first);
+	    	qsort(D,ndbf.compare_first);
 	    	for ( V = [], I = 0; I < N; I++ )
 	    		V = cons(D[I][1],V);
 			V = reverse(V);
@@ -297,8 +299,13 @@ def ann(F)
 {
 	if ( member(s,vars(F)) )
 		error("ann : the variable 's' is reserved.");
+	if ( type(Vord=getopt(vord)) == -1 ) Vord = 0;
 	F = ptozp(F);
 	V = vars(F);
+	if ( Vord ) {
+		Param = setminus(V,Vord);
+		V = Vord;
+	}
 	N = length(V);
 	D = newvect(N);
 	if ( type(Wt=getopt(weight)) == -1 )
@@ -312,7 +319,7 @@ def ann(F)
 		F1 = subst(F1,VI,VI^WI);
 	}
 	for ( I = 0; I < N; I++ ) D[I] = [deg(F1,V[I]),V[I]];
-	qsort(D,compare_first);
+	qsort(D,ndbf.compare_first);
 	for ( V = [], I = 0; I < N; I++ ) V = cons(D[I][1],V);
 	V = reverse(V); 
 	for ( I = 0; I < N; I++ ) {
@@ -381,7 +388,7 @@ def in_gb_oaku(F)
 		F1 = subst(F1,VI,VI^WI);
 	}
 	for ( I = 0; I < N; I++ ) D[I] = [deg(F1,V[I]),V[I]];
-	qsort(D,compare_first);
+	qsort(D,ndbf.compare_first);
 	for ( V = [], I = 0; I < N; I++ ) V = cons(D[I][1],V);
 	V = reverse(V); 
 	for ( I = 0; I < N; I++ ) {
@@ -423,6 +430,31 @@ def in_gb_oaku(F)
 	return [G1,append(V,DV)];
 }
 
+/* homogenization w.r.t. (-W,W)-weight */
+/* VDV = [x1,...,xn,dx1,...,dxn] */
+/* homogenize F w.r.t. (W,-W,1) for (x,dx,y) */
+
+def homogenize_oaku(F,VDV,W,Y)
+{
+	N = length(VDV);
+	if ( N%2 ) error("invalid variable list");
+	N2 = N/2;
+	if ( length(W) != N2 ) error("inconsistent weight vector");
+	W0 = dp_set_weight();
+	Wt = append(W,append(vtol(-ltov(W)),[1]));
+	dp_set_weight(Wt);
+	H = homogenize(F,VDV,Y);
+	dp_set_weight(W0);
+	if ( type(Vars=getopt(vars)) != -1 && Vars ) {
+		DY = strtov("d"+rtostr(Y));
+		for ( I = 0, T = VDV, V = []; I < N2; I++, T = cdr(T) )
+			V = cons(car(T),V);
+		T = cons(Y,append(T,[DY]));
+		for ( ; V != []; V = cdr(V) ) T = cons(car(V),T);
+		return [H,T];
+	} else return H;
+}
+
 /* F = [F0,F1,...] */
 
 def ann_n(F)
@@ -763,7 +795,7 @@ def bfct(F)
 
 	for ( I = 0; I < N; I++ )
 		D[I] = [deg(F,V[I]),V[I]];
-	qsort(D,compare_first);
+	qsort(D,ndbf.compare_first);
 	for ( V = [], I = 0; I < N; I++ )
 		V = cons(D[I][1],V);
 	for ( I = N-1, DV = []; I >= 0; I-- )
@@ -809,7 +841,7 @@ def bfct_via_gbfct(F)
 
 	for ( I = 0; I < N; I++ )
 		D[I] = [deg(F,V[I]),V[I]];
-	qsort(D,compare_first);
+	qsort(D,ndbf.compare_first);
 	for ( V = [], I = 0; I < N; I++ )
 		V = cons(D[I][1],V);
 	V = reverse(V);
@@ -1410,11 +1442,14 @@ def weyl_ideal_quotient(B,F,VDV)
 
 def bf_strat(F)
 {
+	if ( member(s,vars(F)) )
+		error("ann : the variable 's' is reserved.");
 	dp_ord(0);
 	T0 = time();
 	if ( type(Heu=getopt(heuristic)) == -1 ) Heu = 0;
 	if ( type(Vord=getopt(vord)) == -1 || type(Vord) != 4 ) Vord = 0;
 	if ( type(Wt=getopt(weight)) == -1 ) Wt = 0;
+	if ( type(ElimIdeal=getopt(elimideal)) == -1 ) ElimIdeal = 0;
 	L = in_ww(F|weight=Wt,heuristic=Heu,vord=Vord);
 	T1 = time();
 	print(["in_ww",(T1[0]+T1[1])-(T0[0]+T0[1])]);
@@ -1453,6 +1488,7 @@ def bf_strat(F)
 	}
 
 	L2 = bf_strat_stage2(L);
+	if ( ElimIdeal ) return L2;
 	S = bf_strat_stage3(L2);
 	R = [];
 	for ( T = S; T != []; T = cdr(T) ) {
@@ -1563,6 +1599,8 @@ def bf_strat_stage3(L)
 
 def bf_local(F,P)
 {
+	if ( member(s,vars(F)) )
+		error("ann : the variable 's' is reserved.");
 	/* F -> F/Fcont */
 	F1 = ptozp(F); Fcont = sdiv(F,F1); F = F1;
 	if ( type(Heu=getopt(heuristic)) == -1 ) Heu = 0;