#######################################################################################
###########PrimePosition&J-Stable&Split1&JanetDecomposition&Newupperbound-Algorithms#######
#######################################################################################




with(Groebner);
with(combinat);
testn := proc (A, L)
	local n, A1, Deg, l, i, A2, j;
	A1 := sort(A, proc (a, b) options operator, arrow; TestOrder(a, b, tdeg(op(L))) end proc);
	A1 := [seq(A1[i], i = nops(A1) .. 1, -1)];
	Deg := max([seq(degree(i), i in A1)]);
	for i in A1 do
		A2 := [op(indets(i))];
		if A2[-1] <> L[-1] then
			if A2[-1] <> L[1] then
				member(A2[-1], L, 'k');
				if NormalForm(subs(L[k] = 1, i)*L[k-1]^Deg, A1, tdeg(op(L))) <> 0 then
					RETURN(false, L[k], L[k-1]);
				end if; 
			end if; 
		else if nops(A2) <> 1 and A2[-2] <> L[1] then
						member(A2[-2], L, 'k');
						if NormalForm(subs(L[k] = 1, i)*L[k-1]^Deg, A1, tdeg(op(L))) <> 0 then
							RETURN(false, L[k], L[k-1]);
					        end if; 
			end if; 
		end if; 
	end do; 
     RETURN(true); 
end proc;
J-Stable := proc (A, L)
	local B, A1, A3, a, B1, A2, A4, firsttime, firstbytes, secondtime, secondbytes;
	firsttime, firstbytes := kernelopts(cputime, bytesused);
	B := NULL;
	A1 := LeadingMonomial(Basis(A, tdeg(op(L))), tdeg(op(L)));
	A4 := testn(A1, L); a := 1;
	while A4 <> true do
		A3 := [A4];
		B1 := A3[2] = A3[2]+a*A3[3];
		A2 := [seq(subs(A3[2] = A3[2]+a*A3[3], i), i in A1)];
		A2 := LeadingMonomial(Basis(A2, tdeg(op(L))), tdeg(op(L)));
		A3 := testn(A2, L);
		if A4 <> A3 then
			B := B, B1;
			A1 := A2;
			A4 := A3;
			a := 1
		else 
			a := a+1 
		end if; 
	end do; 
	secondtime, secondbytes := kernelopts(cputime, bytesused);
	RETURN([B], cputime = secondtime-firsttime, bytesused = secondbytes-firstbytes); 
end proc;
QuotientBasis := proc (F, x, X)
	local i, F1;
	F1 := NULL;
	for i in F do
		if `subset`(indets(i), `minus`(X, {x})) then
			F1 := F1, i;
		else 
			F1 := F1, i/x; 
		end if; 
	end do; 
	RETURN([F1]); 
end proc;
function3 := proc (A, L)
	local i;
	for i in L do 
		if `intersect`(A, i) = {} then
			RETURN(false); 
		end if; 
	end do; 
	RETURN(true); 
end proc;
function2 := proc (F, u)
	local L, i, A, B, j, j1;
	L := NULL;
	A := u;
	B := {};
	for i in F do
		L := L, indets(i);
		A := `intersect`(A, indets(i));
		B := `union`(B, indets(i)); 
	end do; 
	B := sort(B); 
	L := [L]; 
	if nops(A) <> 0 then
		RETURN(A); 
	else 
		for j from 2 to nops(B) do
			for j1 in [op(choose(B, j))] do
				if function3(j1, L) then
					RETURN(j1); 
				end if; 
			end do; 
		end do; 
	end if; 
end proc;
Splittest := proc (h, u, F, X)
	local s, x, P0, P1, Q0, Q1, P, Q, F1, B, c, i, t, y, F2, A00, A11, c1;
	if evalb(1 in F) then
		RETURN([[[h, u]], []]); 
	elif nops(F) = 0 then 
		RETURN([[], [[h, u]]]); 
	else 
		B := function2(F, u); 
		c := NULL; 
		for i in F do 
			t := sort(indets(i))[1]; 
			c := c, t; 
		end do; 
		x := sort(B)[1]; 
		y := sort([c])[1]; 
		if x <> y then 
			RETURN([[], [false, [x, y]]]); 
		else 
			F2 := subs(x = 0, F); 
			F2 := `minus`({op(F2)}, {0});
			F2 := [op(F2)];
			A00 := Splittest(h, `minus`(u, {x}), F2, X);
			P0, Q0 := A00[1], A00[2];
			F1 := QuotientBasis(F, x, u);
			A11 := Splittest(h*x, u, F1, X);
			P1, Q1 := A11[1], A11[2];
			if evalb(false in Q0) and evalb(false in Q1) then
				c1 := sort([Q0[2][2], Q1[2][2]])[1]; 
				if c1 = Q0[2][2] then
					RETURN(A00); 
				else 
					RETURN(A11); 
				end if; 
			elif evalb(false in Q0) then
				RETURN(A00); 
				elif evalb(false in Q1) then
					RETURN(A11); 
			else 
					P := [op(P0), op(P1)]; 
					Q := [op(Q0), op(Q1)]; 
					RETURN([P, Q]); 
			end if; 
		end if; 
	end if; 
end proc;
function22 := proc (F, u) 
	local i, B;
	B := {};
	for i in F do
		if `subset`(indets(i), u)	then 
		    B := `union`(B, indets(i)); 
		end if; 
	end do; 
	B := sort([op(B)]); RETURN(B[1]); 
end proc;
JanetDecomposition := proc (h, u, F, X)
	local s, x, P0, P1, Q0, Q1, P, Q, F1;
	if evalb(1 in F) then
		RETURN([[h, u]], []); 
	elif function1(F, u) then
		RETURN([], [[h, u]]); 
	else 
		x := function22(F, u);
		P0, Q0 := Split2(h, `minus`(u, {x}), F, X);
		F1 := QuotientBasis(F, x, X);
		P1, Q1 := Split2(h*x, u, F1, X);
		P := [op(P0), op(P1)];
		Q := [op(Q0), op(Q1)];
		RETURN(P, Q); 
	end if; 
end proc;
Split1 := proc (h, u, F, X)
	local s, x, P0, P1, Q0, Q1, P, Q, F1, B, c, i, t, y, F2, A00, A11, c1;
	if evalb(1 in F) then
		RETURN([[[h, u]], []]); 
	elif nops(F) = 0 then
		RETURN([[], [[h, u]]]); 
	else
		B := function2(F, u); 
		x := sort(B)[1]; 
		F2 := subs(x = 0, F); 
		F2 := `minus`({op(F2)}, {0}); 
		F2 := [op(F2)]; 
		A00 := Splittest(h, `minus`(u, {x}), F2, X);
		P0, Q0 := A00[1], A00[2]; 
		F1 := QuotientBasis(F, x, u);
		A11 := Splittest(h*x, u, F1, X);
		P1, Q1 := A11[1], A11[2];
		P := [op(P0), op(P1)];
		Q := [op(Q0), op(Q1)];
		RETURN([P, Q]); 
	end if; 
end proc;
PrimePosition := proc (h, u, F, X)
	local chen, A, c, B, H1, F1;
	F1 := F;
	chen := NULL;
	c := 1;
	A := Splittest(1, X, F1, X);
	while evalb(false in A[2]) do
		H1 := subs(A[2][2][1] = A[2][2][1]+c*A[2][2][2], F1);
		H1 := LeadingMonomial(Basis(H1, tdeg(op(X))), tdeg(op(X)));
		B := Splittest(1, X, H1, X);
		if B <> A then 
			chen := chen, A[2][2][1] = A[2][2][1]+c*A[2][2][2];
			A := B;
			c := 1;
			F1 := H1; 
		else 
			c := c+1; 
		end if; 
	end do; 
	RETURN([chen]); 
end proc;
bound := proc (n)
	local S, d, i, x, c, j, f;
	if n = 1 then
		RETURN(d); 
	elif n = 2 then
	     RETURN(2*d); 
	else 
		S := -2*mul(-d+t, t = 1 .. n-1)/factorial(n-1)+2+(1/2)*bound(n-1)^2-d;
		for i from 3 to n-1 do 
			f := mul(-x+t, t = 0 .. i-1)/factorial(i);
			for j to i do c := coeff(f, x^j);
				if 0 < c then 
					S := S+c*bound(n-i+1)^j; 
				else 
					S := S+2*c*d^j; 
				end if; 
			end do; 
			S := simplify(S); 
		end do; 
	     RETURN(simplify(S)); 
	 end if; 
end proc;


#####################################
###########Examples##################
#####################################



Cyclic5 := [a*b*c*d*e-1, a*b*c*d+a*b*c*e+a*b*d*e+a*c*d*e+b*c*d*e, a*b*c+a*b*e+a*d*e+b*c*d+c*d*e, a*b+a*e+b*c+c*d+d*e, a+b+c+d+e]; 
Cyclic5 := subs({a = x1, b = x2, c = x3, d = x4, e = x5, h = x6}, Homogenize(Cyclic5, h));
Cyclic5 := LeadingMonomial(Basis(Cyclic5, tdeg(x1, x2, x3, x4, x5, x6)), tdeg(x1, x2, x3, x4, x5, x6));
PrimePosition(1, {x1, x2, x3, x4, x5, x6}, Cyclic5, {x1, x2, x3, x4, x5, x6});
J-Stable(Cyclic5, [x1, x2, x3, x4, x5, x6]); 


Cyclic6 := [a*b*c*d*e*f-1, a*b*c*d*e+a*b*c*d*f+a*b*c*e*f+a*b*d*e*f+a*c*d*e*f+b*c*d*e*f, a*b*c*d+a*b*c*f+a*b*e*f+a*d*e*f+b*c*d*e+c*d*e*f, a*b*c+a*b*f+a*e*f+b*c*d+c*d*e+d*e*f, a*b+a*f+b*c+c*d+d*e+e*f, a+b+c+d+e+f];
Cyclic6 := subs({a = x1, b = x2, c = x3, d = x4, e = x5, f = x6}, Cyclic6);
Cyclic6 := Homogenize(Cyclic6, x7); 
Cyclic6 := LeadingMonomial(Basis(Cyclic6, tdeg(x1, x2, x3, x4, x5, x6, x7)), tdeg(x1, x2, x3, x4, x5, x6, x7));
PrimePosition(1, {x1, x2, x3, x4, x5, x6, x7}, Cyclic6, {x1, x2, x3, x4, x5, x6, x7});
J-Stable(Cyclic6, [x1, x2, x3, x4, x5, x6, x7]);


Noon := [10*h^3-11*h^2*x4+10*x1^2*x4+10*x2^2*x4+10*x3^2*x4, 10*h^3-11*h^2*x3+10*x1^2*x3+10*x2^2*x3+10*x3*x4^2, 10*h^3-11*h^2*x1+10*x1*x2^2+10*x1*x3^2+10*x1*x4^2, 10*h^3-11*h^2*x2+10*x1^2*x2+10*x2*x3^2+10*x2*x4^2];
Noon := subs(h = x5, Noon); 
Noon := LeadingMonomial(Basis(Noon, tdeg(x1, x2, x3, x4, x5)), tdeg(x1, x2, x3, x4, x5));
PrimePosition(1, {x1, x2, x3, x4, x5}, Noon, {x1, x2, x3, x4, x5});
J-Stable(Noon, [x1, x2, x3, x4, x5]); 


Weispfenning94 := [h^2*x^2-2*h^2*x*y+h^2*y^2+h^2*z^2+x*y^2*z+y^4, -3*h^5-2*h^2*x^2*y+x*y^4+y*z^4, -2*h^3*x*y+h*x*y^2*z+h*y^4-x^3*y^2+x*y*z^3]; 
Weispfenning94 := subs({h = x4, x = x1, y = x2, z = x3}, Weispfenning94);
Weispfenning94 := LeadingMonomial(Basis(Weispfenning94, tdeg(x1, x2, x3, x4)), tdeg(x1, x2, x3, x4));
PrimePosition(1, {x1, x2, x3, x4}, Weispfenning94, {x1, x2, x3, x4});
J-Stable(Weispfenning94, [x1, x2, x3, x4]);


Seiler1 := [z*y^2, y^3, x^3, x*y^2*z, x*y^3, x^2*z*y^2, x^2*y^3];
Seiler2 := [x^3, z*y^2, y^3]; 
Seiler1 := subs({x = x3, y = x2, z = x1}, Seiler1); 
Seiler2 := subs({x = x3, y = x2, z = x1}, Seiler2); 
PrimePosition(1, {x1, x2, x3}, Seiler1, {x1, x2, x3}); 
PrimePosition(1, {x1, x2, x3}, Seiler2, {x1, x2, x3}); 
J-Stable(Seiler1, [x1, x2, x3]); 
J-Stable(Seiler2, [x1, x2, x3]); 


BermejoGimenez := [x0^2, x2*x1, x1^3, x0*x1*x3, x0*x2^3, x0*x2^2*x3, x1^2*x3^3, x1^2*x3^2*x4]; 
PrimePosition(1, {x0, x1, x2, x3, x4}, BermejoGimenez, {x0, x1, x2, x3, x4}); 
J-Stable(BermejoGimenez, [x0, x1, x2, x3, x4]);


Liu := [a*h-h*x-t0*y+y*z, a*h-h*y+t0*z-x*z, a*h-h*z+t0*x-t0*y, a*h-h*t0+x*y-x*z];
Liu := subs({a = x5, h = x6, t0 = x4, x = x1, y = x3, z = x2}, Liu);
Liu := LeadingMonomial(Basis(Liu, tdeg(x1, x2, x3, x4, x5, x6)), tdeg(x1, x2, x3, x4, x5, x6));
PrimePosition(1, {x1, x2, x3, x4, x5, x6}, Liu, {x1, x2, x3, x4, x5, x6});
J-Stable(Liu, [x1, x2, x3, x4, x5, x6]);


Katsura5 := [2*at^2+2*au^2+av^2+2*ax^2+2*ay^2+2*az^2-av, 2*at*au+2*at*az+2*au*av+ax*ay+ay*az-au, 2*at*av+2*at*ay+au^2+2*au*az+2*ax*az-at, 2*at*au+2*at*ax+2*au*ay+2*av*az-az, at^2+2*av*ax+2*av*ay+2*av*az-ay, 2*ax+2*ay+2*az+2*at+2*au+av-1];
Katsura5 := Homogenize(Katsura5, h);
Katsura5 := subs({at = x4, au = x5, av = x6, ax = x1, ay = x2, az = x3, h = x7}, Katsura5);
Katsura5 := LeadingMonomial(Basis(Katsura5, tdeg(x1, x2, x3, x4, x5, x6, x7)), tdeg(x1, x2, x3, x4, x5, x6, x7)); 
PrimePosition(1, {x1, x2, x3, x4, x5, x6, x7}, Katsura5, {x1, x2, x3, x4, x5, x6, x7});
J-Stable(Katsura5, [x1, x2, x3, x4, x5, x6, x7]);


Katsura6 := [x1+2*x2+2*x3+2*x4+2*x5+2*x6+2*x7-1, 2*x1*x6+2*x2*x5+2*x2*x7+2*x3*x4-x6, 2*x1*x5+2*x2*x4+2*x2*x6+x3^2+2*x3*x7-x5, 2*x1*x4+2*x2*x3+2*x2*x5+2*x3*x6+2*x4*x7-x4, 2*x1*x3+x2^2+2*x2*x4+2*x3*x5+2*x4*x6+2*x5*x7-x3, 2*x1*x2+2*x2*x3+2*x3*x4+2*x4*x5+2*x5*x6+2*x6*x7-x2, x1^2+2*x2^2+2*x3^2+2*x4^2+2*x5^2+2*x6^2+2*x7^2-x1];
Katsura6 := Homogenize(Katsura6, x8);
Katsura6 := LeadingMonomial(Basis(Katsura6, tdeg(x1, x2, x3, x4, x5, x6, x7, x8)), tdeg(x1, x2, x3, x4, x5, x6, x7, x8));
PrimePosition(1, {x1, x2, x3, x4, x5, x6, x7, x8}, Katsura6, {x1, x2, x3, x4, x5, x6, x7, x8});
J-Stable(Katsura6, [x1, x2, x3, x4, x5, x6, x7, x8]);


Lichtblau := [374*t^11-2189*t^10+5555*t^9-8085*t^8+7590*t^7-5082*t^6+2772*t^5-1320*t^4+495*t^3-110*t^2+x, -22*t^11-88*t^10+550*t^9-1650*t^8+3300*t^7-3696*t^6+1848*t^5-330*t^3+110*t^2-22*t+y];
Lichtblau := subs({h = x4, t = x3, x = x1, y = x2}, Lichtblau);
Lichtblau := LeadingMonomial(Basis(Lichtblau, tdeg(x1, x2, x3, x4)), tdeg(x1, x2, x3, x4));
J-Stable(Lichtblau, [x1, x2, x3, x4]); 
PrimePosition(1, {x1, x2, x3, x4}, Lichtblau, {x1, x2, x3, x4});


Eco7 := [(x1*x2+x2*x3+x3*x4+x4*x5+x5*x6+x1)*x7-1, (x1*x3+x2*x4+x3*x5+x4*x6+x2)*x7-2, (x1*x4+x2*x5+x3*x6+x3)*x7-3, (x1*x5+x2*x6+x4)*x7-4, (x1*x6+x5)*x7-5, x6*x7-6, x1+x2+x3+x4+x5+x6+1];
Eco7 := Homogenize(Eco7, x8);
Eco7 := LeadingMonomial(Basis(Eco7, tdeg(x1, x2, x3, x4, x5, x6, x7, x8)), tdeg(x1, x2, x3, x4, x5, x6, x7, x8)); 
PrimePosition(1, {x1, x2, x3, x4, x5, x6, x7, x8}, Eco7, {x1, x2, x3, x4, x5, x6, x7, x8});
J-Stable(Eco7, [x1, x2, x3, x4, x5, x6, x7, x8]);


Eco8 := [(x1*x2+x2*x3+x3*x4+x4*x5+x5*x6+x6*x7+x1)*x8-1, (x1*x3+x2*x4+x3*x5+x4*x6+x5*x7+x2)*x8-2, (x1*x4+x2*x5+x3*x6+x4*x7+x3)*x8-3, (x1*x5+x2*x6+x3*x7+x4)*x8-4, (x1*x6+x2*x7+x5)*x8-5, (x1*x7+x6)*x8-6, x7*x8-7, x1+x2+x3+x4+x5+x6+x7+1];
Eco8 := Homogenize(Eco8, x9);
Eco8 := LeadingMonomial(Basis(Eco8, tdeg(x1, x2, x3, x4, x5, x6, x7, x8, x9)), tdeg(x1, x2, x3, x4, x5, x6, x7, x8, x9));
PrimePosition(1, {x1, x2, x3, x4, x5, x6, x7, x8, x9}, Eco8, {x1, x2, x3, x4, x5, x6, x7, x8, x9}); 
J-Stable(Eco8, [x1, x2, x3, x4, x5, x6, x7, x8, x9]);


SturmfelsandEisenbud := [bb*vv+ss*uu, bb*ww+tt*uu, ss*ww+tt*vv, bb*yy+ss*xx, bb*zz+tt*xx, ss*zz+tt*yy, uu*yy+vv*xx, uu*zz+ww*xx, vv*zz+ww*yy]; SturmfelsandEisenbud := subs({bb = x9, ss = x4, tt = x5, uu = x6, vv = x7, ww = x8, xx = x1, yy = x2, zz = x3}, SturmfelsandEisenbud);
SturmfelsandEisenbud := LeadingMonomial(Basis(SturmfelsandEisenbud, tdeg(x1, x2, x3, x4, x5, x6, x7, x8, x9)), tdeg(x1, x2, x3, x4, x5, x6, x7, x8, x9));
PrimePosition(1, {x1, x2, x3, x4, x5, x6, x7, x8, x9}, SturmfelsandEisenbud, {x1, x2, x3, x4, x5, x6, x7, x8, x9}); 
J-Stable(SturmfelsandEisenbud, [x1, x2, x3, x4, x5, x6, x7, x8, x9]);


Gerdt2 := [35*y^4-30*x*y^2-210*y^2*z+140*w*y+3*x^2+30*x*z-105*z^2-21*u, 5*x*y^3-140*y^3*z+210*w*y^2-3*x^2*y+45*x*y*z-420*y*z^2+126*u*y-25*w*x+70*w*z]; 
Gerdt2 := Homogenize(Gerdt2, h); 
Gerdt2 := subs({h = x6, u = x5, w = x4, x = x1, y = x2, z = x3}, Gerdt2); 
Gerdt2 := LeadingMonomial(Basis(Gerdt2, tdeg(x1, x2, x3, x4, x5, x6)), tdeg(x1, x2, x3, x4, x5, x6));
PrimePosition(1, {x1, x2, x3, x4, x5, x6}, Gerdt2, {x1, x2, x3, x4, x5, x6}); 
J-Stable(Gerdt2, [x1, x2, x3, x4, x5, x6]);


Vermeer := [u^2-2*u*x+v^2-2*v*y+x^2+y^2-1, -u^3+v^2, -3*u^2*v+3*u^2*y-2*u*v+2*v*x, 6*u^2*v*w^2-3*u^2*w-2*v*w+1]; 
Vermeer := Homogenize(Vermeer, h); 
Vermeer := subs({h = x6, u = x3, v = x4, w = x5, x = x1, y = x2}, Vermeer);
Vermeer := LeadingMonomial(Basis(Vermeer, tdeg(x1, x2, x3, x4, x5, x6)), tdeg(x1, x2, x3, x4, x5, x6)); 
PrimePosition(1, {x1, x2, x3, x4, x5, x6}, Vermeer, {x1, x2, x3, x4, x5, x6}); 
J-Stable(Vermeer, [x1, x2, x3, x4, x5, x6]);


Green1 := [x3*x1, x1*x2+x2^2, x1^2];
Green2 := [x3*x1, x2*x3, x3^2, x2^2*x1, x2^3];
Green1 := LeadingMonomial(Basis(Green1, tdeg(x1, x2, x3)), tdeg(x1, x2, x3)); 
PrimePosition(1, {x1, x2, x3}, Green1, {x1, x2, x3});
J-Stable(Green1, [x1, x2, x3]);
Green2 := LeadingMonomial(Basis(Green2, tdeg(x1, x2, x3)), tdeg(x1, x2, x3)); 
J-Stable(Green2, [x1, x2, x3]); 
PrimePosition(1, {x1, x2, x3}, Green2, {x1, x2, x3});