===================================================================
RCS file: /home/cvs/OpenXM/src/asir-contrib/testing/noro/ndbf.rr,v
retrieving revision 1.18
retrieving revision 1.20
diff -u -p -r1.18 -r1.20
--- OpenXM/src/asir-contrib/testing/noro/ndbf.rr	2011/01/16 08:46:10	1.18
+++ OpenXM/src/asir-contrib/testing/noro/ndbf.rr	2014/09/05 11:55:19	1.20
@@ -1,4 +1,4 @@
-/* $OpenXM: OpenXM/src/asir-contrib/testing/noro/ndbf.rr,v 1.17 2010/07/12 07:20:03 noro Exp $ */
+/* $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
@@ -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 */
 
@@ -112,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);
@@ -131,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);
@@ -319,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++ ) {
@@ -388,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++ ) {
@@ -430,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)
@@ -770,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-- )
@@ -816,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);