===================================================================
RCS file: /home/cvs/OpenXM_contrib2/asir2000/lib/primdec_mod,v
retrieving revision 1.3
retrieving revision 1.14
diff -u -p -r1.3 -r1.14
--- OpenXM_contrib2/asir2000/lib/primdec_mod	2003/04/20 07:50:45	1.3
+++ OpenXM_contrib2/asir2000/lib/primdec_mod	2004/07/30 02:24:11	1.14
@@ -1,14 +1,17 @@
+/* $OpenXM: OpenXM_contrib2/asir2000/lib/primdec_mod,v 1.13 2004/02/09 23:37:12 noro Exp $ */
+
 extern Hom,GBTime$
 extern DIVLIST,INTIDEAL,ORIGINAL,ORIGINALDIMENSION,STOP,Trials,REM$
 extern T_GRF,T_INT,T_PD,T_MP$
 extern BuchbergerMinipoly,PartialDecompByLex,ParallelMinipoly$
 extern B_Win,D_Win$
 extern COMMONCHECK_SF,CID_SF$
-extern FFF_LOADED_BY_PRIMDEC_MOD$
-extern GR_LOADED_BY_PRIMDEC_MOD$
 
-if(!FFF_LOADED_BY_PRIMDEC_MOD) load("fff"); else ; FFF_LOADED_BY_PRIMDEC_MOD = 1$
-if(!GR_LOADED_BY_PRIMDEC_MOD) load("gr"); else ; GR_LOADED_BY_PRIMDEC_MOD = 1$
+if (!module_definedp("fff")) load("fff"); else $
+if (!module_definedp("gr")) load("gr"); else $
+module primdec_mod $
+  /* Empty for now. It will be used in a future. */
+endmodule $
 
 /*==============================================*/
 /*  prime decomposition of ideals over 		*/
@@ -134,7 +137,7 @@ def frobeniuskernel_main(P,VSet,WSet)
 	XSet=append(VSet,WSet);
 	NewOrder=[[0,length(VSet)],[0,length(WSet)]];
 
-	Char=setmod_ff()[0];
+	Char=characteristic_ff();
 
 	for (I=0;I<NV;I++)
 		{
@@ -168,7 +171,7 @@ def frobeniuskernel_main2(P,VSet,WSet)
 	XSet=append(VSet,WSet);
 	NewOrder=[[0,NV],[0,NV]];
 
-	Char=setmod_ff()[0];
+	Char=characteristic_ff();
 
 	for (I=0;I<NV;I++)
 		{
@@ -216,7 +219,7 @@ def frobeniuskernel_main4(P,VSet,WSet)
 	XSet=append(VSet,WSet);
 	NewOrder=[[0,NV],[0,NV]];
 
-	Char=setmod_ff()[0];
+	Char=characteristic_ff();
 
 	for (I=0;I<NV;I++)
 		{
@@ -279,7 +282,7 @@ def frobeniuskernel_main3(P,VSet,WSet)
 
 	NewP=coefficientfrobeniuskernel(P);
 
-	Char=setmod_ff()[0];
+	Char=characteristic_ff();
 
 	for (I=0;I<NV;I++)
 		{
@@ -342,8 +345,8 @@ def coefficientfrobeniuskernel_main(Poly)
 	Vars=vars(Poly);
 	QP=dp_ptod(Poly,Vars);
 	ANS=0;
-	FOrd=deg(setmod_ff()[1],x);
-	Char=setmod_ff()[0];
+	FOrd=extdeg_ff();
+	Char=characteristic_ff();
 	Pow=Char^(FOrd-1);
 
 	while(QP !=0 )
@@ -1636,7 +1639,7 @@ def separableclosure(CP,TargetVSet,VSet)
 		print("This is not a separable ideal, so we make its separable closure.", 2);
 	}
 	WSet=makecounterpart(TargetVSet);
-	Char=setmod_ff()[0];
+	Char=characteristic_ff();
 
 	NewP=CP[0];
 	EXPVECTOR=newvect(NVSet);
@@ -1692,7 +1695,7 @@ def convertdivisor(P,TargetVSet,VSet,ExVector)
 
 	NVSet=length(TargetVSet);
 	WSet=makecounterpart(TargetVSet);
-	Char=setmod_ff()[0];
+	Char=characteristic_ff();
 	Ord=0;
 
 	NewP=P;
@@ -1975,7 +1978,8 @@ def contraction(P,V,W)
 	YSet=setminus(W,V);
 
 	Ord1 = [[Ord,length(V)],[0,length(YSet)]];
-	GP1 = dp_gr_f_main(P,W,Hom,Ord1);
+	W1 = append(V,YSet);
+	GP1 = dp_gr_f_main(P,W1,Hom,Ord1);
 
 	Factor = extcont_factor(GP1,V,Ord);
 	for ( F = 1, T = Factor; T != []; T = cdr(T) )
@@ -2034,7 +2038,7 @@ def checkseparablepoly(P,V)
 
 def pdivide(F,V)
 	{
-	Char=setmod_ff()[0];
+	Char=characteristic_ff();
 	TestP=P;
 
 	Deg=ideg(TestP,V);
@@ -2082,14 +2086,19 @@ def convertsmallfield(PP,VSet,Ord)
 	{
 	dp_ord(Ord);
 	NVSet=length(VSet);
-	Char=setmod_ff()[0];
-	ExtDeg=deg(setmod_ff()[1],x);
+	Char=characteristic_ff();
+	ExtDeg=extdeg_ff();
 
-	NewV=pg;	
+	NewV=pgpgpgpgpgpgpg;	
 	MPP=map(monic_hc,PP,VSet);
 	MPP=map(sfptopsfp,MPP,NewV);
 
-	MinPoly=subst(setmod_ff()[1],x,NewV);
+	DefPoly=setmod_ff()[1];
+	/* GF(p) case */
+	if ( !DefPoly )
+		return MPP;
+
+	MinPoly=subst(DefPoly,var(DefPoly),NewV);
 	XSet=cons(NewV,VSet);
 
 	Ord1=[[0,1],[Ord,NVSet]];
@@ -2109,7 +2118,7 @@ def checkgaloisorbit(PP,VSet,Ord,Flag)
 	{
 	NPP=length(PP);
 	TmpPP=PP;
-	ExtDeg=deg(setmod_ff()[1],x);
+	ExtDeg=extdeg_ff();
 	
 	ANS=[];
 	BNS=[];
@@ -2197,7 +2206,7 @@ def partial_decomp(B,V)
 		map(ox_cmo_rpc,ParallelMinipoly,"setmod_ff",characteristic_ff(),extdeg_ff());
 		map(ox_pop_cmo,ParallelMinipoly);
 	}
-	B = map(ptosfp,B);
+	B = map(simp_ff,B);
 	B = dp_gr_f_main(B,V,0,0);
 	R = partial_decomp0(B,V,length(V)-1);
 	if ( PartialDecompByLex ) {
@@ -2370,7 +2379,7 @@ def minipoly_sf_by_buchberger(G,V,O,F,V0,Server)
 	if ( Server )
 		ox_sync(0);
 	Vc = cons(V0,setminus(vars(G),V));
-	Gf = cons(ptosfp(V0-F),G);
+	Gf = cons(simp_ff(V0-F),G);
 	Vf = append(V,Vc);
 	Gelim = dp_gr_f_main(Gf,Vf,1,[[0,length(V)],[0,length(Vc)]]);
 	for ( Gc = [], T = Gelim; T != []; T = cdr(T) ) {
@@ -2405,19 +2414,19 @@ def minipoly_sf_0dim(G,V,O,F,V0,Server)
 	for ( I = Len - 1, GI = []; I >= 0; I-- )
 		GI = cons(I,GI);
 	MB = dp_mbase(HL); DIM = length(MB); UT = newvect(DIM);
-	U = dp_ptod(ptosfp(F),V);
+	U = dp_ptod(simp_ff(F),V);
 	U = dp_nf_f(GI,U,PS,1);
 	for ( I = 0; I < DIM; I++ )
 		UT[I] = [MB[I],dp_nf_f(GI,U*MB[I],PS,1)];
 
-	T = dp_ptod(ptosfp(1),[V0]);
-	TT = dp_ptod(ptosfp(1),V);
+	T = dp_ptod(simp_ff(1),[V0]);
+	TT = dp_ptod(simp_ff(1),V);
 	G = H = [[TT,T]];
 
 	for ( I = 1; ; I++ ) {
 		if ( dp_gr_print() )
 			print(".",2);
-		T = dp_ptod(ptosfp(V0^I),[V0]);
+		T = dp_ptod(simp_ff(V0^I),[V0]);
 		TT = dp_nf_tab_f(H[0][0],UT);
 		H = cons([TT,T],H);
 		L = dp_lnf_f([TT,T],G);
@@ -2436,7 +2445,7 @@ def minipoly_sf_rat(G,V,F,V0)
 	Vc = setminus(vars(G),V);
 	Gf = cons(V0-F,G);
 	Vf = append(V,[V0]);
-	G3 = dp_gr_f_main(map(ptosfp,Gf),Vf,0,3);
+	G3 = dp_gr_f_main(map(simp_ff,Gf),Vf,0,3);
 	for ( T = G3; T != []; T = cdr(T) ) {
 		Vt = setminus(vars(car(T)),Vc);
 		if ( Vt == [V0] )
@@ -2819,7 +2828,7 @@ def henleq_gsl_sfrat(L,B,Vc,Eval)
 			X = map(subst,X,V0,V0-E0);
 			if ( zerovector(RESTA*X+RESTB) ) {
 				if ( dp_gr_print() ) print("end",0);
-				return [X,ptosfp(1)];
+				return [X,simp_ff(1)];
 			} else
 				return 0;
 		} else if ( COUNT == CCC ) {
@@ -2882,7 +2891,7 @@ def henleq_gsl_sfrat_higher(L,B,Vc,Eval)
 			X = map(mshift,X,Vc,E,-1);
 			if ( zerovector(RESTA*X+RESTB) ) {
 				if ( dp_gr_print() ) print("end",0);
-				return [X,ptosfp(1)];
+				return [X,simp_ff(1)];
 			} else
 				return 0;
 		} else if ( COUNT == CCC ) {
@@ -2992,7 +3001,7 @@ def polyvtoratv_higher(Vect,Vc,K)
 def polytorat_gcd(F,V,K)
 {
 	if ( deg(F,V) < K )
-		return [F,ptosfp(1)];
+		return [F,simp_ff(1)];
 	F1 = Mod^(K*2); F2 = F;
 	B1 = 0; B2 = 1;
 	while ( 1 ) {
@@ -3024,7 +3033,7 @@ def polytorat_gcd(F,V,K)
 def polytorat(F,V,Mat,K)
 {
 	if ( deg(F,V) < K )
-		return [F,ptosfp(1)];
+		return [F,simp_ff(1)];
 	for ( I = 0; I < K; I++ )
 		for ( J = 0; J < K; J++ )
 			Mat[I][J] = coef(F,I+K-J);
@@ -3046,7 +3055,7 @@ def polytorat_higher(F,V,K)
 {
 	if ( K < 2 ) return 0;
 	if ( homogeneous_deg(F) < K )
-		return [F,ptosfp(1)];
+		return [F,simp_ff(1)];
 	D = create_icpoly(V,K);
 	C = extract_coef(D*F,V,K,2*K);
 	Vc = vars(C);
@@ -3151,7 +3160,7 @@ def ideal_uniq(L) /* sub procedure of welldec and norm
 			R = append(R,[L[I]]);
 		else {
 			for (J = 0; J < length(R); J++)
-				if ( gb_comp(L[I],R[J]) )
+				if ( gb_comp_old(L[I],R[J]) )
 					break;
 			if ( J == length(R) )
 				R = append(R,[L[I]]);
@@ -3167,7 +3176,7 @@ def ideal_uniq_by_first(L) /* sub procedure of welldec
 			R = append(R,[L[I]]);
 		else {
 			for (J = 0; J < length(R); J++)
-				if ( gb_comp(L[I][0],R[J][0]) )
+				if ( gb_comp_old(L[I][0],R[J][0]) )
 					break;
 			if ( J == length(R) )
 				R = append(R,[L[I]]);
@@ -3228,7 +3237,7 @@ def gr_fctr_sf(FL,VL,Ord)
 	for (TP = [],I = 0; I<length(FL); I++ ) {
 		F = FL[I];
 		SF = idealsqfr_sf(F);
-		if ( !gb_comp(F,SF) ) 
+		if ( !gb_comp_old(F,SF) ) 
 			F = dp_gr_f_main(SF,VL,0,Ord);
 		CID_SF=[1];
 		SP = gr_fctr_sub_sf(F,VL,Ord);
@@ -3252,7 +3261,7 @@ def gr_fctr_sub_sf(G,VL,Ord)
 				W = cons(FL[J][0],G);
 				NG = dp_gr_f_main(W,VL,0,Ord);
 				TNG = idealsqfr_sf(NG);
-				if ( !gb_comp(NG,TNG) )
+				if ( !gb_comp_old(NG,TNG) )
 					NG = dp_gr_f_main(TNG,VL,0,Ord);
 				if ( !inclusion_test(CID_SF,NG,VL,Ord) ) {
 					DG = gr_fctr_sub_sf(NG,VL,Ord);
@@ -3270,5 +3279,21 @@ def gr_fctr_sub_sf(G,VL,Ord)
 	if (I == length(G))
 		RL = append([G],RL);
 	return RL;
+}
+
+def gb_comp_old(A,B)
+{
+	LA = length(A);
+	LB = length(B);
+	if ( LA != LB )
+		return 0;
+	A = newvect(LA,A);
+	B = newvect(LB,B);
+	A1 = qsort(A);
+	B1 = qsort(B);
+	for ( I = 0; I < LA; I++ )
+		if ( A1[I] != B1[I] && A1[I] != -B1[I] )
+			break;
+	return I == LA ? 1 : 0;
 }
 end$