import("gr")$
module noro_pd$

static GBCheck,F4,Procs,SatHomo$

localf init_procs, kill_procs, syca_dec, syc_dec, find_separating_ideal0$
localf find_separating_ideal1, find_separating_ideal2$
localf sy_dec, pseudo_dec, iso_comp, prima_dec$
localf prime_dec, prime_dec_main, lex_predec1, zprimedec, zprimadec$
localf complete_qdecomp, partial_qdecomp, partial_qdecomp0, complete_decomp$
localf partial_decomp, partial_decomp0, zprimacomp, zprimecomp$
localf fast_gb, incremental_gb, elim_gb, ldim, make_mod_subst$
localf rsgn, find_npos, gen_minipoly, indepset$
localf maxindep, contraction, ideal_list_intersection, ideal_intersection$
localf radical_membership, quick_radical_membership, modular_radical_membership$
localf radical_membership_rep, ideal_product, saturation$
localf sat, satind, sat_ind, colon$
localf ideal_colon, ideal_sat, ideal_inclusion, qd_simp_comp, qd_remove_redundant_comp$
localf remove_redundant_comp, remove_redundant_comp_first, ppart, sq$
localf lcfactor, compute_deg0, compute_deg, member$
localf elimination, setintersection, setminus, sep_list$
localf first_element, comp_tdeg, tdeg, comp_by_ord, comp_by_second$
localf gbcheck,f4,sathomo$

SatHomo=0$
GBCheck=1$

#define MAX(a,b) ((a)>(b)?(a):(b))

def gbcheck(A)
{
	if ( A ) GBCheck = 1;
	else GBCheck = -1;
}

def f4(A)
{
	if ( A ) F4 = 1;
	else F4 = 0;
}

def sathomo(A)
{
	if ( A ) SatHomo = 1;
	else SatHomo = 0;
}

def init_procs()
{
	if ( type(NoX=getopt(nox)) == -1 ) NoX = 0;
	if ( !Procs ) {
		if ( NoX ) {
			P0 = ox_launch_nox();
			P1 = ox_launch_nox();
		} else {
			P0 = ox_launch();
			P1 = ox_launch();
		}
		Procs = [P0,P1];
	}
}

def kill_procs()
{
	if ( Procs ) {
		ox_shutdown(Procs[0]);
		ox_shutdown(Procs[1]);
		Procs = 0;
	}
}

/* SYC primary decomositions */

def syca_dec(B,V)
{
T00 = time();
	if ( type(Nolexdec=getopt(nolexdec)) == -1 ) Nolexdec = 0;
	if ( type(SepIdeal=getopt(sepideal)) == -1 ) SepIdeal = 1;
	if ( type(NoSimp=getopt(nosimp)) == -1 ) NoSimp = 0;
	if ( type(Time=getopt(time)) == -1 ) Time = 0;
	Ord = 0;
	Gt = G0 = G = fast_gb(B,V,0,Ord); 
	Q0 = Q = []; IntQ0 = IntQ = [1]; First = 1;
	C = 0;

	Tass = Tiso = Tcolon = Tsep = Tirred = 0;
	Rass = Riso = Rcolon = Rsep = Rirred = 0;
	while ( 1 ) {
		if ( type(Gt[0])==1 ) break;
		T0 = time();
		Pt = prime_dec(Gt,V|indep=1,nolexdec=Nolexdec);
		T1 = time(); Tass += T1[0]-T0[0]+T1[1]-T0[1]; Rass += T1[3]-T0[3];
		T0 = time();
		Qt = iso_comp(Gt,Pt,V,Ord);
		T1 = time(); Tiso += T1[0]-T0[0]+T1[1]-T0[1]; Riso += T1[3]-T0[3];
		IntQt = ideal_list_intersection(map(first_element,Qt),V,Ord);
		IntPt = ideal_list_intersection(map(first_element,Pt),V,Ord);
		if ( First ) {
			IntQ0 = IntQ = IntQt; IntP = IntPt; Qi = Qt; First = 0;
		} else {
			IntQ1 = ideal_intersection(IntQ,IntQt,V,Ord);
			if ( gb_comp(IntQ,IntQ1) ) {
				G = Gt; IntP = IntPt; Q = []; IntQ = [1]; C = 0;
				continue;
			} else {
				IntQ = IntQ1; 
				IntQ1 = ideal_intersection(IntQ0,IntQt,V,Ord);
				if ( !gb_comp(IntQ0,IntQ1) ) {
					IntQ0 = IntQ1;
					Q = append(Qt,Q); Q0 = append(Qt,Q0);
				}
			}
		}
		if ( gb_comp(IntQt,Gt) || gb_comp(IntQ,G) || gb_comp(IntQ0,G0) ) break;
		T0 = time();
		C1 = ideal_colon(G,IntQ,V);
		T1 = time(); Tcolon += T1[0]-T0[0]+T1[1]-T0[1]; Rcolon += T1[3]-T0[3];
		if ( C && gb_comp(C,C1) ) {
			G = Gt; IntP = IntPt; Q = []; IntQ = [1]; C = 0;
			continue;
		} else C = C1;
		T0 = time();
		if ( SepIdeal == 0 )
			Ok = find_separating_ideal0(C,G,IntQ,IntP,V,Ord);
		else if ( SepIdeal == 1 )
			Ok = find_separating_ideal1(C,G,IntQ,IntP,V,Ord);
		else if ( SepIdeal == 2 )
			Ok = find_separating_ideal2(C,G,IntQ,IntP,V,Ord);
		G1 = append(Ok,G);
		Gt1 = fast_gb(G1,V,0,Ord);
		T1 = time(); Tsep += T1[0]-T0[0]+T1[1]-T0[1]; Rsep += T1[3]-T0[3];
#if 0
		if ( ideal_inclusion(Gt1,Gt,V,Ord) ) {
			G = Gt; IntP = IntPt; Q = []; IntQ = [1]; C = 0;
		} else
#endif
			Gt = Gt1;
	}		
	T0 = time();
	if ( !NoSimp ) Q1 = qd_remove_redundant_comp(G0,Qi,Q0,V,Ord);
	else Q1 = Q0;
	if ( Time ) {
		T1 = time(); Tirred += T1[0]-T0[0]+T1[1]-T0[1]; Rirred += T1[3]-T0[3];
		Tall = T1[0]-T00[0]+T1[1]-T00[1]; Rall += T1[3]-T00[3];
		print(["total",Tall,"ass",Tass,"iso",Tiso, "colon",Tcolon,"sep",Tsep,"irred",Tirred]);
		print(["Rtotal",Rall,"Rass",Rass,"Riso",Riso, "Rcolon",Rcolon,"Rsep",Rsep,"Rirred",Rirred]);
		print(["iso",length(Qi),"emb",length(Q0),"->",length(Q1)]);
	}
	return [Qi,Q1];
}

def syc_dec(B,V)
{
T00 = time();
	if ( type(Nolexdec=getopt(nolexdec)) == -1 ) Nolexdec = 0;
	if ( type(SepIdeal=getopt(sepideal)) == -1 ) SepIdeal = 1;
	if ( type(NoSimp=getopt(nosimp)) == -1 ) NoSimp = 0;
	if ( type(Time=getopt(time)) == -1 ) Time = 0;
	Ord = 0;
	G = fast_gb(B,V,0,Ord);
	Q = []; IntQ = [1]; Gt = G; First = 1;
	Tass = Tiso = Tcolon = Tsep = Tirred = 0;
	Rass = Riso = Rcolon = Rsep = Rirred = 0;
	while ( 1 ) {
		if ( type(Gt[0])==1 ) break;
		T0 = time();
		Pt = prime_dec(Gt,V|indep=1,nolexdec=Nolexdec);
		T1 = time(); Tass += T1[0]-T0[0]+T1[1]-T0[1]; Rass += T1[3]-T0[3];
		T0 = time();
		Qt = iso_comp(Gt,Pt,V,Ord);
		T1 = time(); Tiso += T1[0]-T0[0]+T1[1]-T0[1]; Riso += T1[3]-T0[3];
		IntQt = ideal_list_intersection(map(first_element,Qt),V,Ord);
		IntPt = ideal_list_intersection(map(first_element,Pt),V,Ord);
		if ( First ) {
			IntQ = IntQt; Qi = Qt; First = 0;
		} else {
			IntQ1 = ideal_intersection(IntQ,IntQt,V,Ord);
			if ( !gb_comp(IntQ1,IntQ) )
				Q = append(Qt,Q);
		}
		if ( gb_comp(IntQ,G) || gb_comp(IntQt,Gt) ) 
			break;
		T0 = time();
		C = ideal_colon(Gt,IntQt,V);
		T1 = time(); Tcolon += T1[0]-T0[0]+T1[1]-T0[1]; Rcolon += T1[3]-T0[3];
		T0 = time();
		if ( SepIdeal == 0 )
			Ok = find_separating_ideal0(C,Gt,IntQt,IntPt,V,Ord);
		else if ( SepIdeal == 1 )
			Ok = find_separating_ideal1(C,Gt,IntQt,IntPt,V,Ord);
		else if ( SepIdeal == 2 )
			Ok = find_separating_ideal2(C,Gt,IntQt,IntPt,V,Ord);
		G1 = append(Ok,Gt);
		Gt = fast_gb(G1,V,0,Ord);
		T1 = time(); Tsep += T1[0]-T0[0]+T1[1]-T0[1]; Rsep += T1[3]-T0[3];
	}
	T0 = time();
	if ( !NoSimp ) Q1 = qd_remove_redundant_comp(G,Qi,Q,V,Ord);
	else Q1 = Q;
	T1 = time(); Tirred += T1[0]-T0[0]+T1[1]-T0[1]; Rirred += T1[3]-T0[3];
	Tall = T1[0]-T00[0]+T1[1]-T00[1]; Rall += T1[3]-T00[3];
	if ( Time ) {
		print(["total",Tall,"ass",Tass,"iso",Tiso, "colon",Tcolon,"sep",Tsep,"irred",Tirred]);
		print(["Rtotal",Rall,"Rass",Rass,"Riso",Riso, "Rcolon",Rcolon,"Rsep",Rsep,"Rirred",Rirred]);
		print(["iso",length(Qi),"emb",length(Q),"->",length(Q1)]);
	}
	return [Qi,Q1];
}

/* C=G:Q, Rad=rad(Q), return J s.t. Q cap (G+J) = G */

def find_separating_ideal0(C,G,Q,Rad,V,Ord) {
	for ( CI = C, I = 1; ; I++ ) {
		for ( T = CI, S = []; T != []; T = cdr(T) )
			if ( nd_nf(car(T),Q,V,Ord,0) ) S = cons(car(T),S);
		if ( S == [] )
			error("find_separating_ideal0 : cannot happen");
		G1 = append(S,G);
		Int = ideal_intersection(G1,Q,V,Ord);
		/* check whether (Q cap (G+S)) = G */
		if ( gb_comp(Int,G) ) return reverse(S);
		CI = ideal_product(CI,C,V);
	}
}

def find_separating_ideal1(C,G,Q,Rad,V,Ord) {
	for ( T = C, S = []; T != []; T = cdr(T) )
		if ( nd_nf(car(T),Q,V,Ord,0) ) S = cons(car(T),S);
	if ( S == [] )
		error("find_separating_ideal1 : cannot happen");
	G1 = append(S,G);
	Int = ideal_intersection(G1,Q,V,Ord);
	/* check whether (Q cap (G+S)) = G */
	if ( gb_comp(Int,G) ) return reverse(S);

	/* or qsort(C,comp_tdeg) */
	C = qsort(S,comp_tdeg);

	Tmp = ttttt; TV = cons(Tmp,V); Ord1 = [[0,1],[Ord,length(V)]];
	Int0 = incremental_gb(append(vtol(ltov(G)*Tmp),vtol(ltov(Q)*(1-Tmp))),
		TV,Ord1|gbblock=[[0,length(G)]]);
	for ( T = C, S = []; T != []; T = cdr(T) ) {
		if ( !nd_nf(car(T),Rad,V,Ord,0) ) continue;
		Ui = U = car(T);
		for ( I = 1; ; I++ ) {
			G1 = cons(Ui,G);
			Int = ideal_intersection(G1,Q,V,Ord);
			if ( gb_comp(Int,G) ) break;
			else
				Ui = nd_nf(Ui*U,G,V,Ord,0);
		}
		Int1 = incremental_gb(append(Int0,[Tmp*Ui]),TV,Ord1
			|gbblock=[[0,length(Int0)]]);
		Int = elimination(Int1,V);
		if ( !gb_comp(Int,G) ) 
			break;
		else {
			Int0 = Int1;
			S = cons(Ui,S);
		}
	}
	return reverse(S);
}

def find_separating_ideal2(C,G,Q,Rad,V,Ord) {
	for ( T = C, S = []; T != []; T = cdr(T) )
		if ( nd_nf(car(T),Q,V,Ord,0) ) S = cons(car(T),S);
	if ( S == [] )
		error("find_separating_ideal2 : cannot happen");
	G1 = append(S,G);
	Int = ideal_intersection(G1,Q,V,Ord);
	/* check whether (Q cap (G+S)) = G */
	if ( gb_comp(Int,G) ) return reverse(S);

	/* or qsort(S,comp_tdeg) */
	C = qsort(C,comp_tdeg);
	Dp = dp_gr_print(); dp_gr_print(0);
	for ( T = C, S = []; T != []; T = cdr(T) ) {
		print(length(T));
		if ( !nd_nf(car(T),Rad,V,Ord,0) ) continue;
		Ui = U = car(T);
		for ( I = 1; ; I++ ) {
			G1 = cons(Ui,G);
			Int = ideal_intersection(G1,Q,V,Ord);
			if ( gb_comp(Int,G) ) break;
			else
				Ui = nd_nf(Ui*U,G,V,Ord,0);
		}
		S = cons(Ui,S);
	}
	S = qsort(S,comp_tdeg);
	/* S = reverse(S); */
	Len = length(S);

	Tmp = ttttt; TV = cons(Tmp,V); Ord1 = [[0,1],[Ord,length(V)]];
	if ( Len > 1 ) {
		Prev = 1;
		Cur = 2;
		G1 = append(G,[S[0]]);
		Int0 = incremental_gb(append(vtol(ltov(G1)*Tmp),vtol(ltov(Q)*(1-Tmp))),
			TV,Ord1|gbblock=[[0,length(G)]]);
		while ( Prev < Cur ) {
			for ( St = [], I = Prev; I < Cur; I++ ) St = cons(Tmp*S[I],St);
			Int1 = incremental_gb(append(Int0,St),TV,Ord1
				|gbblock=[[0,length(Int0)]]);
			Int = elimination(Int1,V);
			if ( gb_comp(Int,G) ) {
				print(Cur);
				Prev = Cur;
				Cur = Cur+idiv(Len-Cur+1,2);
				Int0 = Int1;
			} else {
				Cur = Prev + idiv(Cur-Prev,2);
			}
		}
		for ( St = [], I = 0; I < Prev; I++ ) St = cons(S[I],St);
		Ok = reverse(St);
	} else
		Ok = [S[0]];
	print([length(S),length(Ok)]);
	dp_gr_print(Dp);
	return Ok;
}

/* SY primary decompsition */

def sy_dec(B,V)
{
	if ( type(Nolexdec=getopt(nolexdec)) == -1 ) Nolexdec = 0;
	Ord = 0;
	G = fast_gb(B,V,0,Ord);
	Q = [];
	IntQ = [1];
	Gt = G;
	First = 1;
	while ( 1 ) {
		if ( type(Gt[0]) == 1 ) break;
		Pt = prime_dec(Gt,V|indep=1,nolexdec=Nolexdec);
		L = pseudo_dec(Gt,Pt,V,Ord);
		Qt = L[0]; Rt = L[1]; St = L[2];
		IntQt = ideal_list_intersection(Qt,V,Ord);
		if ( First ) {
			IntQ = IntQt;
			Qi = Qt;
			First = 0;
		} else {
			IntQ = ideal_intersection(IntQ,IntQt,V,Ord);
			Q = append(Qt,Q);
		}
		if ( gb_comp(IntQ,G) ) break;
		for ( T = Rt; T != []; T = cdr(T) ) {
			if ( type(car(T)[0]) == 1 ) continue;
			U = sy_dec(car(T),V|nolexdec=Nolexdec);
			IntQ = ideal_list_intersection(cons(IntQ,U),V,Ord);
			Q = append(U,Q);
			if ( gb_comp(IntQ,G) ) break;
		}
		Gt = fast_gb(append(Gt,St),V,0,Ord);
	}
	Q = remove_redundant_comp(G,Qi,Q,V,Ord);
	return append(Qi,Q);
}

def pseudo_dec(G,L,V,Ord)
{
	N = length(L);
	S = vector(N);
	Q = vector(N);
	R = vector(N);
	L0 = map(first_element,L);
	for ( I = 0; I < N; I++ ) {
		LI = setminus(L0,[L0[I]]);
		PI = ideal_list_intersection(LI,V,Ord);
		PI = qsort(PI,comp_tdeg);
		for ( T = PI; T != []; T = cdr(T) )
			if ( p_nf(car(T),L0[I],V,Ord) ) break;
		if ( T == [] ) error("separator : cannot happen");
		SI = sat_ind(G,car(T),V);	
		QI = SI[0];
		S[I] = car(T)^SI[1];
		PV = L[I][1];
		V0 = setminus(V,PV);
#if 0
		GI = fast_gb(QI,append(V0,PV),0,
			[[Ord,length(V0)],[Ord,length(PV)]]);
#else
		GI = fast_gb(QI,append(V0,PV),0,
			[[2,length(V0)],[Ord,length(PV)]]);
#endif
		LCFI = lcfactor(GI,V0,Ord);
		for ( F = 1, T = LCFI, Gt = QI; T != []; T = cdr(T) ) {
			St = sat_ind(Gt,T[0],V);
			Gt = St[0]; F *= T[0]^St[1];
		}
		Q[I] = Gt;
		R[I] = fast_gb(cons(F,QI),V,0,Ord);
	}
	return [vtol(Q),vtol(R),vtol(S)];
}

def iso_comp(G,L,V,Ord)
{
	N = length(L);
	S = vector(N);
	Ind = vector(N);
	Q = vector(N);
	L0 = map(first_element,L);
	G = nd_gr(G,V,0,Ord);
	for ( I = 0; I < N; I++ ) {
		LI = setminus(L0,[L0[I]]);
		PI = ideal_list_intersection(LI,V,Ord);
		for ( T = PI; T != []; T = cdr(T) )
			if ( p_nf(car(T),L0[I],V,Ord) ) break;
		if ( T == [] ) error("separator : cannot happen");
		S[I] = car(T);
		QI = sat(G,S[I],V|isgb=1);
		PV = L[I][1];
		V0 = setminus(V,PV);
		GI = elim_gb(QI,V0,PV,0,[[0,length(V0)],[0,length(PV)]]);
		Q[I] = [contraction(GI,V0),L0[I]];
	}
	return vtol(Q);
}

/* GTZ primary decompsition */

def prima_dec(B,V)
{
	G = nd_gr_trace(B,V,1,GBCheck,0);
	G0 = G;
	IntP = [1];
	QD = [];
	while ( 1 ) {
		if ( ideal_inclusion(IntP,G0,V,0) ) 
			return QD;
		W = maxindep(G,V,0); NP = length(W);
		V0 = setminus(V,W); N = length(V0);
		V1 = append(V0,W);
		G1 = fast_gb(G,V1,0,[[0,N],[0,NP]]);
		LCF = lcfactor(G1,V0,0);
		L = zprimacomp(G,V0);
		F = 1;
		for ( T = LCF, G2 = G1; T != []; T = cdr(T) ) {
			S = sat_ind(G2,T[0],V1);
			G2 = S[0]; F *= T[0]^S[1];
		}
		for ( T = L, QL = []; T != []; T = cdr(T) )
			QL = cons(car(T)[0],QL);
		Int = ideal_list_intersection(QL,V,0);
		IntP = ideal_intersection(IntP,Int,V,0);
		QD = append(QD,L);
		F = p_nf(F,G,V,0);
		G = cons(F,G);
	}
}

/* SL prime decomposition */

def prime_dec(B,V)
{
	if ( type(Indep=getopt(indep)) == -1 ) Indep = 0;
	if ( type(NoLexDec=getopt(nolexdec)) == -1 ) NoLexDec = 0;
	B = map(sq,B);
	if ( !NoLexDec )
		PD = lex_predec1(B,V);
	else
		PD = [B];
	G = ideal_list_intersection(PD,V,0);
	PD = remove_redundant_comp(G,[],PD,V,0);
	R = [];
	for ( T = PD; T != []; T = cdr(T) )
		R = append(prime_dec_main(car(T),V|indep=Indep),R);
	if ( Indep ) {
		G = ideal_list_intersection(map(first_element,R),V,0);
		if ( !NoLexDec ) R = remove_redundant_comp_first(G,R,V,0);
	} else {
		G = ideal_list_intersection(R,V,0);
		if ( !NoLexDec ) R = remove_redundant_comp(G,[],R,V,0);
	}
	return R;
}

def prime_dec_main(B,V)
{
	if ( type(Indep=getopt(indep)) == -1 ) Indep = 0;
	G = nd_gr_trace(B,V,1,GBCheck,0);
	IntP = [1];
	PD = [];
	while ( 1 ) {
		/* rad(G) subset IntP */		
		/* check if IntP subset rad(G) */
		for ( T = IntP; T != []; T = cdr(T) ) {
			if ( (GNV = modular_radical_membership(car(T),G,V)) ) {
				F = car(T);
				break;
			}
		}
		if ( T == [] ) return PD;

		/* GNV = [GB(<NV*F-1,G>),NV] */
		G1 = nd_gr_trace(GNV[0],cons(GNV[1],V),1,GBCheck,[[0,1],[0,length(V)]]);
		G0 = elimination(G1,V);
		PD0 = zprimecomp(G0,V,Indep);
		if ( Indep ) {
			Int = ideal_list_intersection(PD0[0],V,0);
			IndepSet = PD0[1];	
			for ( PD1 = [], T = PD0[0]; T != []; T = cdr(T) )
				PD1 = cons([car(T),IndepSet],PD1);
			PD = append(PD,reverse(PD1));
		} else {
			Int = ideal_list_intersection(PD0,V,0);
			PD = append(PD,PD0);
		}
		IntP = ideal_intersection(IntP,Int,V,0);
	}
}

/* pre-decomposition */

def lex_predec1(B,V)
{
	G = nd_gr_trace(B,V,1,GBCheck,2);
	for ( T = G; T != []; T = cdr(T) ) {
		F = fctr(car(T));
		if ( length(F) > 2 || length(F) == 2 && F[1][1] > 1 ) {
			for ( R = [], S = cdr(F); S != []; S = cdr(S) ) {
				Ft = car(S)[0];
				Gt = map(ptozp,map(p_nf,G,[Ft],V,0));
				R1 = nd_gr_trace(cons(Ft,Gt),V,1,GBCheck,0);
				R = cons(R1,R);
			}
			return R;
		}
	}
	return [G];
}

/* zero-dimensional prime/primary decomosition */

def zprimedec(B,V,Mod)
{
	L = partial_decomp(B,V,Mod);
	P = L[0]; NP = L[1];
	R = [];
	for ( ; P != []; P = cdr(P) ) R = cons(car(car(P)),R);
	for ( T = NP; T != []; T = cdr(T) ) {
		R1 = complete_decomp(car(T),V,Mod);
		R = append(R1,R);
	}
	return R;
}

def zprimadec(B,V,Mod)
{
	L = partial_qdecomp(B,V,Mod);
	Q = L[0]; NQ = L[1];
	R = [];
	for ( ; Q != []; Q = cdr(Q) ) {
		T = car(Q); R = cons([T[0],T[1]],R);
	}
	for ( T = NQ; T != []; T = cdr(T) ) {
		R1 = complete_qdecomp(car(T),V,Mod);
		R = append(R1,R);
	}
	return R;
}

def complete_qdecomp(GD,V,Mod)
{
	GQ = GD[0]; GP = GD[1]; D = GD[2];
	W = vars(GP);
	PV = setminus(W,V);
	N = length(V); PN = length(PV);
	U = find_npos([GP,D],V,PV,Mod);
	NV = ttttt;
	M = gen_minipoly(cons(NV-U,GQ),cons(NV,V),PV,0,NV,Mod);
	M = ppart(M,NV,Mod);
	MF = Mod ? modfctr(M) : fctr(M);		
	R = [];
	for ( T = cdr(MF); T != []; T = cdr(T) ) {
		S = car(T);
		Mt = subst(S[0],NV,U);
		GP1 = fast_gb(cons(Mt,GP),W,Mod,0);
		GQ1 = fast_gb(cons(Mt^S[1],GQ),W,Mod,0);
		if ( PV != [] ) {
			GP1 = elim_gb(GP1,V,PV,Mod,[[0,N],[0,PN]]);
			GQ1 = elim_gb(GQ1,V,PV,Mod,[[0,N],[0,PN]]);
		}
		R = cons([GQ1,GP1],R);
	}
	return R;
}

def partial_qdecomp(B,V,Mod)
{
	Elim = (Elim=getopt(elim))&&type(Elim)!=-1 ? 1 : 0;
	N = length(V);
	W = vars(B);
	PV = setminus(W,V);
	NP = length(PV);
	W = append(V,PV);
	if ( Elim && PV != [] ) Ord = [[0,N],[0,NP]];
	else Ord = 0;
	if ( Mod )
		B = nd_f4(B,W,Mod,Ord);
	else
		B = nd_gr_trace(B,W,1,GBCheck,Ord);
	Q = []; NQ = [[B,B,vector(N+1)]];
	for ( I = length(V)-1; I >= 0; I-- ) {
		NQ1 = [];
		for ( T = NQ; T != []; T = cdr(T) ) {
			L = partial_qdecomp0(car(T),V,PV,Ord,I,Mod);
			Q = append(L[0],Q);
			NQ1 = append(L[1],NQ1);
		}
		NQ = NQ1;
	}
	return [Q,NQ];
}

def partial_qdecomp0(GD,V,PV,Ord,I,Mod)
{
	GQ = GD[0]; GP = GD[1]; D = GD[2];
	N = length(V); PN = length(PV);
	W = append(V,PV);
	VI = V[I];
	M = gen_minipoly(GQ,V,PV,Ord,VI,Mod);
	M = ppart(M,VI,Mod);
	if ( Mod )
		MF = modfctr(M,Mod);
	else
		MF = fctr(M);
	Q = []; NQ = [];
	if ( length(MF) == 2 && MF[1][1] == 1 ) {
		D1 = D*1; D1[I] = M;
		GQelim = elim_gb(GQ,V,PV,Mod,Ord);
		GPelim = elim_gb(GP,V,PV,Mod,Ord);
		LD = ldim(GQelim,V);
		if ( deg(M,VI) == LD )
			Q = cons([GQelim,GPelim,D1],Q);
		else
			NQ = cons([GQelim,GPelim,D1],NQ);
		return [Q,NQ];
	}
	for ( T = cdr(MF); T != []; T = cdr(T) ) {
		S = car(T); Mt = S[0]; D1 = D*1; D1[I] = Mt;

		GQ1 = fast_gb(cons(Mt^S[1],GQ),W,Mod,Ord);
		GQelim = elim_gb(GQ1,V,PV,Mod,Ord);
		GP1 = fast_gb(cons(Mt,GP),W,Mod,Ord);
		GPelim = elim_gb(GP1,V,PV,Mod,Ord);

		D1[N] = LD = ldim(GPelim,V);

		for ( J = 0; J < N; J++ )
			if ( D1[J] && deg(D1[J],V[J]) == LD ) break;
		if ( J < N )
			Q = cons([GQelim,GPelim,D1],Q);
		else
			NQ = cons([GQelim,GPelim,D1],NQ);
	}
	return [Q,NQ];
}

def complete_decomp(GD,V,Mod)
{
	G = GD[0]; D = GD[1];
	W = vars(G);
	PV = setminus(W,V);
	N = length(V); PN = length(PV);
	U = find_npos(GD,V,PV,Mod);
	NV = ttttt;
	M = gen_minipoly(cons(NV-U,G),cons(NV,V),PV,0,NV,Mod);
	M = ppart(M,NV,Mod);
	MF = Mod ? modfctr(M) : fctr(M);		
	if ( length(MF) == 2 ) return [G];
	R = [];
	for ( T = cdr(MF); T != []; T = cdr(T) ) {
		Mt = subst(car(car(T)),NV,U);
		G1 = fast_gb(cons(Mt,G),W,Mod,0);
		if ( PV != [] ) G1 = elim_gb(G1,V,PV,Mod,[[0,N],[0,PN]]);
		R = cons(G1,R);
	}
	return R;
}

def partial_decomp(B,V,Mod)
{
	Elim = (Elim=getopt(elim))&&type(Elim)!=-1 ? 1 : 0;
	N = length(V);
	W = vars(B);
	PV = setminus(W,V);
	NP = length(PV);
	W = append(V,PV);
	if ( Elim && PV != [] ) Ord = [[0,N],[0,NP]];
	else Ord = 0;
	if ( Mod )
		B = nd_f4(B,W,Mod,Ord);
	else
		B = nd_gr_trace(B,W,1,GBCheck,Ord);
	P = []; NP = [[B,vector(N+1)]];
	for ( I = length(V)-1; I >= 0; I-- ) {
		NP1 = [];
		for ( T = NP; T != []; T = cdr(T) ) {
			L = partial_decomp0(car(T),V,PV,Ord,I,Mod);
			P = append(L[0],P);
			NP1 = append(L[1],NP1);
		}
		NP = NP1;
	}
	return [P,NP];
}

def partial_decomp0(GD,V,PV,Ord,I,Mod)
{
	G = GD[0]; D = GD[1];
	N = length(V); PN = length(PV);
	W = append(V,PV);
	VI = V[I];
	M = gen_minipoly(G,V,PV,Ord,VI,Mod);
	M = ppart(M,VI,Mod);
	if ( Mod )
		MF = modfctr(M,Mod);
	else
		MF = fctr(M);
	if ( length(MF) == 2 && MF[1][1] == 1 ) {
		D1 = D*1;
		D1[I] = M;
		Gelim = elim_gb(G,V,PV,Mod,Ord);
		D1[N] = LD = ldim(Gelim,V);
		GD1 = [Gelim,D1];
		for ( J = 0; J < N; J++ )
			if ( D1[J] && deg(D1[J],V[J]) == LD )
				return [[GD1],[]];
		return [[],[GD1]];
	}
	P = []; NP = [];
	GI = elim_gb(G,V,PV,Mod,Ord);
	for ( T = cdr(MF); T != []; T = cdr(T) ) {
		Mt = car(car(T));
		D1 = D*1;
		D1[I] = Mt;
		GIt = map(p_nf,GI,[Mt],V,Ord);
		G1 = cons(Mt,GIt);
		Gelim = elim_gb(G1,V,PV,Mod,Ord);
		D1[N] = LD = ldim(Gelim,V);
		for ( J = 0; J < N; J++ )
			if ( D1[J] && deg(D1[J],V[J]) == LD ) break;
		if ( J < N )
			P = cons([Gelim,D1],P);
		else
			NP = cons([Gelim,D1],NP);
	}
	return [P,NP];
}

/* prime/primary components over rational function field */

def zprimacomp(G,V) {
	L = zprimadec(G,V,0);
	R = [];
	dp_ord(0);
	for ( T = L; T != []; T = cdr(T) ) {
		S = car(T);
		UQ = contraction(S[0],V);
		UP = contraction(S[1],V);
		R = cons([UQ,UP],R);
	}
	return R;
} 

def zprimecomp(G,V,Indep) {
	W = maxindep(G,V,0);
	V0 = setminus(V,W);
	V1 = append(V0,W);
#if 0
	O1 = [[0,length(V0)],[0,length(W)]];
	G1 = nd_gr_trace(G,V1,1,GBCheck,O1);
	dp_ord(0);
#else
	G1 = G;
#endif
	PD = zprimedec(G1,V0,0);
	dp_ord(0);
	R = [];
	for ( T = PD; T != []; T = cdr(T) ) {
		U = contraction(car(T),V0);
		R = cons(U,R);
	}
	if ( Indep ) return [R,W];
	else return R;
} 

def fast_gb(B,V,Mod,Ord)
{
	NoRA = (NoRA=getopt(nora))&&type(NoRA)!=-1 ? 1 : 0;
	if ( Mod )
		G = nd_f4(B,V,Mod,Ord|nora=NoRA);
	else {
		if ( F4 )
			G = map(ptozp,f4_chrem(B,V,Ord));
		else 
			G = nd_gr_trace(B,V,1,GBCheck,Ord|nora=NoRA);
	}
	return G;
}

def incremental_gb(A,V,Ord)
{
	if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
	if ( type(Block=getopt(gbblock)) == -1 ) Block = 0;
	if ( Mod )
		G = nd_gr(A,V,Mod,Ord);
	else if ( Procs ) {
		Arg0 = ["nd_gr",A,V,0,Ord];
		Arg1 = ["nd_gr_trace",A,V,1,GBCheck,Ord];
		G = competitive_exec(Procs,Arg0,Arg1);
	} else if ( Block )
		G = nd_gr(A,V,0,Ord|gbblock=Block);
	else
		G = nd_gr(A,V,0,Ord);
	return G;
}

def elim_gb(G,V,PV,Mod,Ord)
{
	N = length(V); PN = length(PV);
	O1 = [[0,N],[0,PN]];
	if ( Ord == O1 )
		Ord = Ord[0][0];
	if ( Mod ) /* XXX */
		G = dp_gr_mod_main(G,V,0,Mod,Ord);
	else if ( Procs ) {
		Arg0 = ["nd_gr_trace",G,V,1,GBCheck,Ord];
		Arg1 = ["nd_gr_trace_rat",G,V,PV,1,GBCheck,O1,Ord];
		G = competitive_exec(Procs,Arg0,Arg1);
	} else
		G = nd_gr_trace(G,V,1,GBCheck,Ord);
	return G;
}

def ldim(G,V)
{
	O0 = dp_ord(); dp_ord(0);
	D = length(dp_mbase(map(dp_ptod,G,V)));
	dp_ord(O0);
	return D;
}

def make_mod_subst(GD,V,PV,HC)
{
	N = length(V);
	PN = length(PV);
	G = GD[0]; D = GD[1];
	for ( I = 0; ; I = (I+1)%100 ) {
		Mod = lprime(I);
		S = [];
		for ( J = PN-1; J >= 0; J-- )
			S = append([PV[J],random()%Mod],S);
		for ( T = HC; T != []; T = cdr(T) )
			if ( !(subst(car(T),S)%Mod) ) break;
		if ( T != [] ) continue;
		for ( J = 0; J < N; J++ ) {
			M = subst(D[J],S);
			F = modsqfr(M,Mod);
			if ( length(F) != 2 || F[1][1] != 1 ) break;
		}
		if ( J < N ) continue;
		G0 = map(subst,G,S);
		return [G0,Mod];
	}
}

def rsgn()
{
	return random()%2 ? 1 : -1;
}

def find_npos(GD,V,PV,Mod)
{
	N = length(V); PN = length(PV);
	G = GD[0]; D = GD[1]; LD = D[N];
	Ord0 = dp_ord(); dp_ord(0);
	HC = map(dp_hc,map(dp_ptod,G,V));
	dp_ord(Ord0);
	if ( !Mod ) {
		W = append(V,PV);
		G1 = nd_gr_trace(G,W,1,GBCheck,[[0,N],[0,PN]]);
		L = make_mod_subst([G1,D],V,PV,HC);
		return find_npos([L[0],D],V,[],L[1]);
	}
	N = length(V);
	NV = ttttt;
	for ( B = 2; ; B++ ) {
		for ( J = N-2; J >= 0; J-- ) {
			for ( U = 0, K = J; K < N; K++ )
				U += rsgn()*((random()%B+1))*V[K];
			M = minipolym(G,V,0,U,NV,Mod);
			if ( deg(M,NV) == LD ) return U;
		}
	}
}

def gen_minipoly(G,V,PV,Ord,VI,Mod)
{
	if ( PV == [] ) {
		NV = ttttt;
		if ( Mod )
			M = minipolym(G,V,Ord,VI,NV,Mod);
		else
			M = minipoly(G,V,Ord,VI,NV);
		return subst(M,NV,VI);
	}
	W = setminus(V,[VI]);
	PV1 = cons(VI,PV);
#if 0
	while ( 1 ) {
		V1 = append(W,PV1);
		if ( Mod )
			G = nd_gr(G,V1,Mod,[[0,1],[0,length(V1)-1]]|nora=1);
		else
			G = nd_gr_trace(G,V1,1,GBCheck,[[0,1],[0,length(V1)-1]]|nora=1);
		if ( W == [] ) break;
		else { 
			W = cdr(W);
			G = elimination(G,cdr(V1));
		}
	}
#elif 1
	if ( Mod ) {
		G = nd_gr(G,V1,Mod,[[0,length(W)],[0,length(PV1)]]|nora=1);
		G = elimination(G,PV1);
	} else {
		PV2 = setminus(PV1,[PV1[length(PV1)-1]]);
		V2 = append(W,PV2);
		G = nd_gr_trace(G,V2,1,GBCheck,[[0,length(W)],[0,length(PV2)]]|nora=1);
		G = elimination(G,PV1);
	}
#else
	V1 = append(W,PV1);
	if ( Mod )
		G = nd_gr(G,V1,Mod,[[0,length(W)],[0,length(PV1)]]|nora=1);
	else
		G = nd_gr_trace(G,V1,1,GBCheck,[[0,length(W)],[0,length(PV1)]]|nora=1);
	G = elimination(G,PV1);
#endif
	if ( Mod )
		G = nd_gr(G,PV1,Mod,[[0,1],[0,length(PV)]]|nora=1);
	else
		G = nd_gr_trace(G,PV1,1,GBCheck,[[0,1],[0,length(PV)]]|nora=1);
	for ( M = car(G), T = cdr(G); T != []; T = cdr(T) )
		if ( deg(car(T),VI) < deg(M,VI) ) M = car(T);
	return M;
}

def indepset(V,H)
{
	if ( H == [] ) return V;
	N = -1;
	for ( T = V; T != []; T = cdr(T) ) {
		VI = car(T);	
		HI = [];
		for ( S = H; S != []; S = cdr(S) )
			if ( !tdiv(car(S),VI) ) HI = cons(car(S),HI);
		RI = indepset(setminus(V,[VI]),HI);
		if ( length(RI) > N ) {
			R = RI; N = length(RI);
		}
	}
	return R;
}

def maxindep(B,V,O)
{
	G = nd_gr_trace(B,V,1,GBCheck,O);
	Old = dp_ord();
	dp_ord(O);
	H = map(dp_dtop,map(dp_ht,map(dp_ptod,G,V)),V);
	H = dp_mono_raddec(H,V);
	N = length(V);
	Dep = [];
	for ( T = H, Len = N+1; T != []; T = cdr(T) ) {
		M = length(car(T));
		if ( M < Len ) {
			Dep = [car(T)];
			Len = M;
		} else if ( M == Len )
			Dep = cons(car(T),Dep);
	}
	R = setminus(V,Dep[0]);
	dp_ord(Old);
	return R;
}

/* ideal operations */
def contraction(G,V)
{
	C = [];
	for ( T = G; T != []; T = cdr(T) ) {
		C1 = dp_hc(dp_ptod(car(T),V));
		S = fctr(C1);
		for ( S = cdr(S); S != []; S = cdr(S) )
			if ( !member(S[0][0],C) ) C = cons(S[0][0],C);
	}
	W = vars(G);
	PV = setminus(W,V);
	W = append(V,PV);
	NV = ttttt;
	for ( T = C, S = 1; T != []; T = cdr(T) )
		S *= car(T);
	G = saturation([G,NV],S,W);
	return G;
}

def ideal_list_intersection(L,V,Ord)
{
	if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
	N = length(L);
	if ( N == 0 ) return [1];
	if ( N == 1 ) return fast_gb(L[0],V,Mod,Ord);
	N2 = idiv(N,2);
	for ( L1 = [], I = 0; I < N2; I++ ) L1 = cons(L[I],L1);
	for ( L2 = []; I < N; I++ ) L2 = cons(L[I],L2);
	I1 = ideal_list_intersection(L1,V,Ord|mod=Mod);
	I2 = ideal_list_intersection(L2,V,Ord|mod=Mod);
	return ideal_intersection(I1,I2,V,Ord|mod=Mod,
		gbblock=[[0,length(I1)],[length(I1),length(I2)]]);
}

def ideal_intersection(A,B,V,Ord)
{
	if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
	if ( type(Block=getopt(gbblock)) == -1 ) Block = 0;
	T = ttttt;
	if ( Mod )
		G = nd_gr(append(vtol(ltov(A)*T),vtol(ltov(B)*(1-T))),
			cons(T,V),Mod,[[0,1],[Ord,length(V)]]);
	else
	if ( Procs ) {
		Arg0 = ["nd_gr",
			append(vtol(ltov(A)*T),vtol(ltov(B)*(1-T))),
			cons(T,V),0,[[0,1],[Ord,length(V)]]];
		Arg1 = ["nd_gr_trace", 
			append(vtol(ltov(A)*T),vtol(ltov(B)*(1-T))),
			cons(T,V),1,GBCheck,[[0,1],[Ord,length(V)]]];
		G = competitive_exec(Procs,Arg0,Arg1);
	} else {
		if ( Block )
			G = nd_gr(append(vtol(ltov(A)*T),vtol(ltov(B)*(1-T))),
				cons(T,V),0,[[0,1],[Ord,length(V)]]|gbblock=Block);
		else
			G = nd_gr(append(vtol(ltov(A)*T),vtol(ltov(B)*(1-T))),
				cons(T,V),0,[[0,1],[Ord,length(V)]]);
	}
	G0 = elimination(G,V);
	return G0;
}

/* returns GB if F notin rad(G) */

def radical_membership(F,G,V) {
	F = p_nf(F,G,V,0);
	if ( !F ) return 0;
	NV = ttttt;
	T = nd_gr_trace(cons(NV*F-1,G),cons(NV,V),1,GBCheck,0);
	if ( type(car(T)) != 1 ) return [T,NV];
	else return 0;
}

def quick_radical_membership(F,G,V) {
	F = p_nf(F,G,V,0);
	if ( !F ) return 1;
	NV = ttttt;
	T = nd_f4(cons(NV*F-1,G),cons(NV,V),lprime(0),0);
	if ( type(car(T)) != 1 ) return 0;
	else return 1;
}

def modular_radical_membership(F,G,V) {
	F = p_nf(F,G,V,0);
	if ( !F ) return 0;
	NV = ttttt;
	for ( J = 0; ; J++ ) {
		Mod = lprime(J);
		H = map(dp_hc,map(dp_ptod,G,V));
		for ( ; H != []; H = cdr(H) ) if ( !(car(H)%Mod) ) break;
		if ( H != [] ) continue;

		T = nd_f4(cons(NV*F-1,G),cons(NV,V),Mod,0);
		if ( type(car(T)) == 1 ) {
			I = radical_membership_rep(F,G,V,-1,0,Mod);
			I1 = radical_membership_rep(F,G,V,I,0,0);
			if ( I1 > 0 ) return 0;
		}
		return radical_membership(F,G,V);
	}
}

def radical_membership_rep(F,G,V,Max,Ord,Mod) {
	Ft = F;
	I = 1;
	while ( Max < 0 || I <= Max ) {
		Ft = nd_nf(Ft,G,V,Ord,Mod);
		if ( !Ft ) return I;
		Ft *= F;
		I++;
	}
	return -1;
}

def ideal_product(A,B,V)
{
	dp_ord(0);
	DA = map(dp_ptod,A,V);
	DB = map(dp_ptod,B,V);
	DegA = map(dp_td,DA);
	DegB = map(dp_td,DB);
	for ( PA = [], T = A, DT = DegA; T != []; T = cdr(T), DT = cdr(DT) )
		PA = cons([car(T),car(DT)],PA);
	PA = reverse(PA);
	for ( PB = [], T = B, DT = DegB; T != []; T = cdr(T), DT = cdr(DT) )
		PB = cons([car(T),car(DT)],PB);
	PB = reverse(PB);
	R = [];
	for ( T = PA; T != []; T = cdr(T) )
		for ( S = PB; S != []; S = cdr(S) )
			R = cons([car(T)[0]*car(S)[0],car(T)[1]+car(S)[1]],R);
	T = qsort(R,comp_by_second);
	T = map(first_element,T);
	Len = length(A)>length(B)?length(A):length(B);
	Len *= 2;
	L = sep_list(T,Len); B0 = L[0]; B1 = L[1];
	R = nd_gr_trace(B0,V,0,-1,0);
	while ( B1 != [] ) {
		print(length(B1));
		L = sep_list(B1,Len);
		B0 = L[0]; B1 = L[1];
		R = nd_gr_trace(append(R,B0),V,0,-1,0|gbblock=[[0,length(R)]],nora=1);
	}
	return R;
}

def saturation(GNV,F,V) 
{
	G = GNV[0]; NV = GNV[1];
	if ( Procs ) {
		Arg0 = ["nd_gr_trace", 
		cons(NV*F-1,G),cons(NV,V),0,GBCheck,[[0,1],[0,length(V)]]];
		Arg1 = ["nd_gr_trace", 
		cons(NV*F-1,G),cons(NV,V),1,GBCheck,[[0,1],[0,length(V)]]];
		G1 = competitive_exec(Procs,Arg0,Arg1);
	} else
		G1 = nd_gr_trace(cons(NV*F-1,G),cons(NV,V),SatHomo,GBCheck,[[0,1],[0,length(V)]]);
	return elimination(G1,V);
}

def sat(G,F,V) 
{
	if ( type(IsGB=getopt(isgb)) == -1 ) IsGB = 0;
	NV = ttttt;
	if ( Procs ) {
		Arg0 = ["nd_gr_trace", 
		cons(NV*F-1,G),cons(NV,V),0,GBCheck,[[0,1],[0,length(V)]]];
		Arg1 = ["nd_gr_trace", 
		cons(NV*F-1,G),cons(NV,V),1,GBCheck,[[0,1],[0,length(V)]]];
		G1 = competitive_exec(Procs,Arg0,Arg1);
	} else {
		B1 = append(G,[NV*F-1]);
		V1 = cons(NV,V);
		Ord1 = [[0,1],[0,length(V)]];
		if ( IsGB )
			G1 = nd_gr_trace(B1,V1,SatHomo,GBCheck,Ord1|
				gbblock=[[0,length(G)]]);
		else
			G1 = nd_gr_trace(B1,V1,SatHomo,GBCheck,Ord1);
	}
	return elimination(G1,V);
}

def satind(G,F,V)
{
	NV = ttttt;
	N = length(V);
	B = append(G,[NV*F-1]);
	V1 = cons(NV,V); 
	D = nd_gr_trace(B,V1,1,GBCheck,[[0,1],[0,N]]
		|nora=1,gentrace=1,gbblock=[[0,length(G)]]);
	G1 = D[0];
	Len = length(G1);
	Deg = compute_deg(B,V1,NV,D);
	D1 = 0;
	R = [];
	M = length(B);
	for ( I = 0; I < Len; I++ ) {
		if ( !member(NV,vars(G1[I])) ) {
			for ( J = 1; J < M; J++ )
				D1 = MAX(D1,Deg[I][J]);
			R = cons(G1[I],R);
		}
	}
	return [reverse(R),D1];
}

def sat_ind(G,F,V)
{
	NV = ttttt;
	F = p_nf(F,G,V,0);
	for ( I = 0, GI = G; ; I++ ) {
		G1 = colon(GI,F,V);
		if ( ideal_inclusion(G1,GI,V,0) )  {
			return [GI,I];
		}
		else GI = G1;
	}
}

def colon(G,F,V)
{
	if ( type(IsGB=getopt(isgb)) == -1 ) IsGB = 0;
	F = p_nf(F,G,V,0);
	if ( !F ) return [1];
	if ( IsGB )
		T = ideal_intersection(G,[F],V,0|gbblock=[[0,length(G)]]);
	else
		T = ideal_intersection(G,[F],V,0);
	return map(ptozp,map(sdiv,T,F));
}

def ideal_colon(G,F,V)
{
	G = nd_gr(G,V,0,0);
	for ( T = F, L = []; T != []; T = cdr(T) )
		L = cons(colon(G,car(T),V|isgb=1),L);
	L = reverse(L);
	return ideal_list_intersection(L,V,0);
}

def ideal_sat(G,F,V)
{
	G = nd_gr(G,V,0,0);
	L = mapat(sat,1,G,F,V);
	return ideal_list_intersection(L,V,0);
}

def ideal_inclusion(F,G,V,O)
{
	if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
	if ( Mod ) {
		for ( T = F; T != []; T = cdr(T) )
			if ( p_nf_mod(car(T),G,V,O,Mod) ) return 0;
	} else {
		for ( T = F; T != []; T = cdr(T) )
			if ( p_nf(car(T),G,V,O) ) return 0;
	}
	return 1;
}

/* remove redundant components */

def qd_simp_comp(QP,V)
{
	R = ltov(QP);
	N = length(R);
	for ( I = 0; I < N; I++ ) {
		if ( R[I] ) {
			QI = R[I][0]; PI = R[I][1];
			for ( J = I+1; J < N; J++ )
				if ( R[J] && gb_comp(PI,R[J][1]) ) {
					QI = ideal_intersection(QI,R[J][0],V,0);
					R[J] = 0;
				}
			R[I] = [QI,PI];
		}
	}
	for ( I = N-1, S = []; I >= 0; I-- )
		if ( R[I] ) S = cons(R[I],S);
	return S;
}

def qd_remove_redundant_comp(G,Iso,Emb,V,Ord)
{
	IsoInt = ideal_list_intersection(map(first_element,Iso),V,Ord);
	Emb = qd_simp_comp(Emb,V);
	Emb = qsort(Emb);
	A = ltov(Emb);
	N = length(A);
	for ( I = 0; I < N; I++ ) {
		if ( !A[I] ) continue;
		for ( T = [], J = 0; J < N; J++ )
			if ( J != I && A[J] ) T = cons(A[J][0],T);
		Int = ideal_list_intersection(T,V,Ord);
		Int = ideal_intersection(IsoInt,Int,V,Ord);
		if ( gb_comp(Int,G) ) A[I] = 0;
	}
	for ( T = [], I = 0; I < N; I++ )
		if ( A[I] ) T = cons(A[I],T);
	return reverse(T);
}

def remove_redundant_comp(G,Iso,Emb,V,Ord)
{
	IsoInt = ideal_list_intersection(Iso,V,Ord);

	A = ltov(Emb);
	N = length(A);
	for ( I = 0; I < N; I++ ) {
		if ( !A[I] ) continue;
		for ( J = I+1; J < N; J++ )
			if ( A[J] && gb_comp(A[I],A[J]) ) A[J] = 0;
	}
	for ( I = 0; I < N; I++ ) {
		if ( !A[I] ) continue;
		for ( T = [], J = 0; J < N; J++ )
			if ( J != I && A[J] ) T = cons(A[J],T);
		Int = ideal_list_intersection(cons(IsoInt,T),V,Ord);
		if ( gb_comp(Int,G) ) A[I] = 0;
	}
	for ( T = [], I = 0; I < N; I++ )
		if ( A[I] ) T = cons(A[I],T);
	return reverse(T);
}

def remove_redundant_comp_first(G,P,V,Ord)
{
	A = ltov(P);
	N = length(A);
	for ( I = 0; I < N; I++ ) {
		if ( !A[I] ) continue;
		for ( J = I+1; J < N; J++ )
			if ( A[J] && gb_comp(A[I][0],A[J][0]) ) A[J] = 0;
	}
	for ( I = 0; I < N; I++ ) {
		if ( !A[I] ) continue;
		for ( T = [], J = 0; J < N; J++ )
			if ( J != I && A[J] ) T = cons(A[J][0],T);
		Int = ideal_list_intersection(T,V,Ord);
		if ( gb_comp(Int,G) ) A[I] = 0;
	}
	for ( T = [], I = 0; I < N; I++ )
		if ( A[I] ) T = cons(A[I],T);
	return reverse(T);
}

/* polynomial operations */

def ppart(F,V,Mod)
{
	if ( !Mod )
		G = nd_gr([F],[V],0,0);
	else
		G = dp_gr_mod_main([F],[V],0,Mod,0);
	return G[0];
}


def sq(F)
{
	if ( !F ) return 0;
	A = cdr(fctr(F));
	for ( R = 1; A != []; A = cdr(A) )
		R *= car(car(A));
	return R;
}

def lcfactor(G,V,O)
{
	O0 = dp_ord(); dp_ord(O);
	C = [];
	for ( T = G; T != []; T = cdr(T) ) {
		C1 = dp_hc(dp_ptod(car(T),V));
		S = fctr(C1);
		for ( S = cdr(S); S != []; S = cdr(S) )
			if ( !member(S[0][0],C) ) C = cons(S[0][0],C);
	}
	dp_ord(O0);
	return C;
}

/* Ti = [D,I,M,C] */

def compute_deg0(Ti,P,V,TV)
{
	N = length(P[0]);
	Num = vector(N);
	for ( I = 0; I < N; I++ ) Num[I] = -1;
	for ( ; Ti != []; Ti = cdr(Ti) ) {
		Sj = car(Ti); 
		Dj = Sj[0];
		Ij =Sj[1]; 
		Mj = deg(type(Sj[2])==9?dp_dtop(Sj[2],V):Sj[2],TV);
		Pj = P[Ij];
		if ( Dj )
			for ( I = 0; I < N; I++ )
				if ( Pj[I] >= 0 ) {
					T = Mj+Pj[I];
					Num[I] = MAX(Num[I],T);
				}
	}
	return Num;
}

def compute_deg(B,V,TV,Data)
{
	GB = Data[0];
	Homo = Data[1];
	Trace = Data[2];
	IntRed = Data[3];
	Ind = Data[4];
	DB = map(dp_ptod,B,V);
	if ( Homo ) {
		DB = map(dp_homo,DB);
		V0 = append(V,[hhh]);
	} else
		V0 = V;
	Perm = Trace[0]; Trace = cdr(Trace);
	for ( I = length(Perm)-1, T = Trace; T != []; T = cdr(T) )
		if ( (J=car(T)[0]) > I ) I = J;
	N = I+1;
	N0 = length(B);
	P = vector(N);
	for ( T = Perm, I = 0; T != []; T = cdr(T), I++ ) {
		Pi = car(T); 
		C = vector(N0);
		for ( J = 0; J < N0; J++ ) C[J] = -1;
		C[Pi[1]] = 0;
		P[Pi[0]] = C;
	}
	for ( T = Trace; T != []; T = cdr(T) ) {
		Ti = car(T); P[Ti[0]] = compute_deg0(Ti[1],P,V0,TV);
	}
	M = length(Ind);
	for ( T = IntRed; T != []; T = cdr(T) ) {
		Ti = car(T); P[Ti[0]] = compute_deg0(Ti[1],P,V,TV);
	}
	R = [];
	for ( J = 0; J < M; J++ ) {
		U = P[Ind[J]];
		R = cons(U,R);
	}
	return reverse(R);
}

/* set theoretic functions */

def member(A,S)
{
	for ( ; S != []; S = cdr(S) )
		if ( car(S) == A ) return 1;
	return 0;
}

def elimination(G,V) {
	for ( R = [], T = G; T != []; T = cdr(T) )
		if ( setminus(vars(car(T)),V) == [] ) R =cons(car(T),R);
	return R;
}

def setintersection(A,B)
{ 
	for ( L = []; A != []; A = cdr(A) )
		if ( member(car(A),B) )
			L = cons(car(A),L);
	return L;   
}

def setminus(A,B) {
	for ( T = reverse(A), R = []; T != []; T = cdr(T) ) {
		for ( S = B, M = car(T); S != []; S = cdr(S) )
			if ( car(S) == M ) break;
		if ( S == [] ) R = cons(M,R);
	}
	return R;
}

def sep_list(L,N)
{
	if ( length(L) <= N ) return [L,[]];
	R = [];
	for ( T = L, I = 0; I < N; I++, T = cdr(T) )
		R = cons(car(T),R);
	return [reverse(R),T];
}

def first_element(L)
{
	return L[0];
}

def comp_tdeg(A,B)
{
	DA = tdeg(A);
	DB = tdeg(B);
	if ( DA > DB ) return 1;
	else if ( DA < DB ) return -1;
	else return 0;
}

def tdeg(P)
{
	dp_ord(0);
	return dp_td(dp_ptod(P,vars(P)));
}

def comp_by_ord(A,B)
{
	if ( dp_ht(A) > dp_ht(B) ) return 1;
	else if ( dp_ht(A) < dp_ht(B) ) return -1;
	else return 0;
}

def comp_by_second(A,B)
{
	if ( A[1] > B[1] ) return 1;
	else if ( A[1] < B[1] ) return -1;
	else return 0;
}
endmodule$
end$