===================================================================
RCS file: /home/cvs/OpenXM_contrib2/asir2000/lib/primdec_mod,v
retrieving revision 1.7
retrieving revision 1.13
diff -u -p -r1.7 -r1.13
--- OpenXM_contrib2/asir2000/lib/primdec_mod 2003/04/21 02:00:13 1.7
+++ OpenXM_contrib2/asir2000/lib/primdec_mod 2004/02/09 23:37:12 1.13
@@ -1,4 +1,4 @@
-$OpenXM$
+/* $OpenXM: OpenXM_contrib2/asir2000/lib/primdec_mod,v 1.12 2003/10/20 00:58:47 takayama Exp $ */
extern Hom,GBTime$
extern DIVLIST,INTIDEAL,ORIGINAL,ORIGINALDIMENSION,STOP,Trials,REM$
@@ -6,11 +6,12 @@ extern T_GRF,T_INT,T_PD,T_MP$
extern BuchbergerMinipoly,PartialDecompByLex,ParallelMinipoly$
extern B_Win,D_Win$
extern COMMONCHECK_SF,CID_SF$
-extern LIBRARY_GR_LOADED$
-extern LIBRARY_FFF_LOADED$
-if(!LIBRARY_FFF_LOADED) load("fff"); else ; LIBRARY_FFF_LOADED = 1$
-if(!LIBRARY_GR_LOADED) load("gr"); else ; LIBRARY_GR_LOADED = 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 */
@@ -2092,6 +2093,10 @@ def convertsmallfield(PP,VSet,Ord)
MPP=map(sfptopsfp,MPP,NewV);
DefPoly=setmod_ff()[1];
+ /* GF(p) case */
+ if ( !DefPoly )
+ return MPP;
+
MinPoly=subst(DefPoly,var(DefPoly),NewV);
XSet=cons(NewV,VSet);
@@ -2200,7 +2205,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 ) {
@@ -2373,7 +2378,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) ) {
@@ -2408,19 +2413,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);
@@ -2439,7 +2444,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] )
@@ -2822,7 +2827,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 ) {
@@ -2885,7 +2890,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 ) {
@@ -2995,7 +3000,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 ) {
@@ -3027,7 +3032,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);
@@ -3049,7 +3054,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);
@@ -3154,7 +3159,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]]);
@@ -3170,7 +3175,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]]);
@@ -3231,7 +3236,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);
@@ -3255,7 +3260,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);
@@ -3273,5 +3278,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$