with(Groebner);
with(ArrayTools);
with(PolynomialIdeals);

Update := proc(h, p, t) 
local F, F2, Lmp, r, i, Lcp, Tip, a, g; 
Lcp, Lmp := LeadingTerm(p, t); 
Tip := p - Lcp*Lmp; 
if type(h, monomial) then 
F := [[LeadingTerm(h, t)]]; 
F2 := [F[1][2]]; 
else 
F := [seq([LeadingTerm(a, t)], a in [op(h)])]; 
F2 := [seq(F[i][2], i = 1 .. nops(F))]; 
end if; 
if member(Lmp, F2, 'q') then 
F := subsop(q = [-F[q][1]/Lcp, Tip], F); 
r := expand(add(g[1]*g[2], g in F)); 
else 
r := h; 
end if; 
RETURN(r); 
end proc;

SorT := proc(L, t) 
RETURN(sort(L, (a, b) -> TestOrder(LeadingMonomial(a[1]*a[2], t), LeadingMonomial(b[1]*b[2], t), t))); 
end proc;

MODTraverso := proc(G, B, f, t, n) 
local i, U, p, P, PH, Lmp, h, m, LtG, H, A, criterion, zero, pair, Syz, firsttime, firstbytes, secondtime, secondbytes; 
firsttime, firstbytes := kernelopts(cputime, bytesused); 
pair := 0; 
zero := 0; 
criterion := 0; 
A := []; 
Syz := []; 
U := B; 
H := []; 
LtG := LeadingMonomial(G, t); 
P := [[1, 1, f, f, f]]; 
pair := pair + 1; 
while P <> [] do 
P := SorT(P, t); 
m := P[1]; 
P := P[2 .. -1]; 
if member(m[1]*m[2], A) = false and NormalForm(m[1]*m[2], Syz, t) <> 0 then 
A := [op(A), m[1]*m[2]]; 
p := NormalForm(expand(m[1]*m[4]), G, t); 
for h in H do 
p := Update(p, h, t); 
end do; 
if p <> 0 then 
Lmp := LeadingMonomial(p, t); 
U := [op({op(U)} minus {Lmp})]; 
for i to n do if NormalForm(x[i]*m[1]*m[2], LtG, t) <> 0 then 
P := [op(P), [x[i], m[1]*m[2], f, p, p]]; 
pair := pair + 1; 
else 
criterion := criterion + 1; 
pair := pair + 1; 
end if; 
end do; 
H := [op(H), p]; 
else 
Syz := [op(Syz), m[1]*m[2]]; 
zero := zero + 1; 
end if; 
else 
criterion := criterion + 1; 
end if; 
end do; 
secondtime, secondbytes := kernelopts(cputime, bytesused); printf("%-1s %1s %1s %1s:         %3a %3a\n", The, cpu, time, is, secondtime - firsttime, sec); 
printf("%-1s %1s %1s:         %3a %3a\n", The, used, memory, secondbytes - firstbytes, bytes); 
printf("%-1s %1s %1s %1s:          %3a\n", number, of, pairs, is, pair); 
printf("%-1s %1s %1s %1s:         %3a\n", number, of, zeros, is, zero); 
printf("%-1s %1s %1s:             %3a\n", Two, criteria, is, criterion); 
RETURN([[op(G), op(H)], U]); 
end proc;

Traverso := proc(G, B, f, t, n) 
local i, U, h, p, P, Lmp, H, pair, zero, firsttime, firstbytes, secondtime, secondbytes; 
firsttime, firstbytes := kernelopts(cputime, bytesused); 
pair := 0; 
zero := 0; 
U := B; 
H := []; 
P := [[1, f]]; 
pair := pair + 1; 
while P <> [] do 
P := SorT(P, t); 
p := NormalForm(expand(P[1][1]*P[1][2]), G, t); 
P := P[2 .. -1]; 
for h in H do 
p := Update(p, h, t); 
end do; 
if p <> 0 then 
Lmp := LeadingMonomial(p, t); 
U := [op({op(U)} minus {Lmp})]; 
P := [op(P), seq([x[i], p], i = 1 .. n)]; 
pair := pair + n; 
H := [op(H), p]; 
else 
zero := zero + 1; 
end if; 
end do; 
secondtime, secondbytes := kernelopts(cputime, bytesused);  
printf("%-1s %1s %1s %1s:         %3a %3a\n", The, cpu, time, is, secondtime - firsttime, sec); 
printf("%-1s %1s %1s:         %3a %3a\n", The, used, memory, secondbytes - firstbytes, bytes); 
printf("%-1s %1s %1s %1s:         %3a\n", number, of, pairs, is, pair); 
printf("%-1s %1s %1s %1s:         %3a\n", number, of, zeros, is, zero); 
RETURN([[op(G), op(H)], U]); 
end proc

Extendd := proc(A, B) 
RETURN(Array([op(convert(A, list)), op(convert(B, list))])); 
end proc;

Appendd := proc(A, h) 
RETURN(Array([op(convert(A, list)), h])); 
end proc;

Sort := proc(L, t) 
RETURN(sort(L, (b, a) -> TestOrder(a[3], b[3], t))); 
end proc;

Pair := proc(G, LtG, g, t)
local P, A, A1, a, i, j, u, n, C; 
global pair, criterion; 
P := Array([]); 
u := LeadingMonomial(g, t); 
n := ArrayNumElems(LtG); 
pair := pair + n; 
A := Array([seq(lcm(LtG[j], u)/u, j = 1 .. n)]); 
A1 := Array([op({op(Basis(convert(A, list), t))} minus {seq(LtG[j], j = 1 .. n)})]); 
criterion := criterion + n - ArrayNumElems(A1); 
for a in A1 do 
member(a, A, 'q'); 
P := Appendd(P, Array([g, G[q], lcm(u, LtG[q])])); 
end do; 
RETURN(P); 
end proc;

BSH := proc(F, f, t) 
local G, LtG, P, zero, i, p, s, h, g, n, firsttime, firstbytes, secondtime, secondbytes; 
global pair, criterion; 
firsttime, firstbytes := kernelopts(cputime, bytesused); 
criterion := 0; 
pair := 0; 
zero := 0; 
G := Array(F); 
LtG := Array(LeadingMonomial(convert(G, list), t)); 
P := Pair(G, LtG, f, t); 
G := Appendd(G, f); 
LtG := Appendd(LtG, LeadingMonomial(f, t)); 
while ArrayNumElems(P) <> 0 do 
P := Sort(P, t); 
p := P[-1]; 
P := Array(1 .. ArrayNumElems(P) - 1, P); 
s := SPolynomial(p[1], p[2], t); 
h := NormalForm(s, convert(G, list), t); 
if h <> 0 then 
P := Extendd(P, Pair(G, LtG, h, t)); 
G := Appendd(G, h); 
LtG := Appendd(LtG, LeadingMonomial(h, t)); 
else 
zero := zero + 1; 
end if; 
end do; 
secondtime, secondbytes := kernelopts(cputime, bytesused); printf("%-1s %1s %1s %1s:         %3a %3a\n", The, cpu, time, is, secondtime - firsttime, sec); 
printf("%-1s %1s %1s:         %3a %3a\n", The, used, memory, secondbytes - firstbytes, bytes); 
printf("%-1s %1s %1s %1s:         %3a\n", number, of, pairs, is, pair); 
printf("%-1s %1s %1s %1s:         %3a\n", number, of, zeros, is, zero); 
printf("%-1s %1s %1s:           %3a\n", Buch, criteria, is, criterion); 
RETURN(convert(G, list)); 
end proc;


Kat5 := [2*x[5] + 2*x[4] + 2*x[3] + 2*x[2] + 2*x[1] + x[6] - 1, 2*x[1]*x[2] + 2*x[1]*x[4] + 2*x[2]*x[5] + 3*x[3]*x[6] - x[3], 2*x[1]*x[3] + 2*x[1]*x[5] + x[2]^2 + x[2]*x[6] + 2*x[4]*x[6] - x[4], 2*x[1]*x[2] + 2*x[1]*x[6] + 2*x[2]*x[3] + 2*x[3]*x[4] + 2*x[4]*x[5] + x[5]*x[6] - x[1], 2*x[1]^2 + 2*x[2]^2 + 2*x[3]^2 + 2*x[4]^2 + 2*x[5]^2 + x[6]^2 - x[6], x[1]^2 + 2*x[1]*x[3] + 2*x[2]*x[4] + 2*x[2]*x[6] + 2*x[3]*x[5] + x[4]*x[6] - x[2]];
t := tdeg(seq(x[i], i = 1 .. 6));
G := Basis(Kat5, t);
B := NormalSet(G, t)[1];
f := -x[1]^2*x[2]*x[4]^2*x[5]*x[6]^2 + x[1]^2*x[2]^2*x[4]*x[6] + x[1]^2*x[2]*x[3]*x[5]^2 + x[3]*x[4]*x[5]*x[6];
MODTraverso(G, B, f, t, 6);
Traverso(G, B, f, t, 6);
BSH(G, f, t)


Eco7 := [x[1]*x[2]*x[7] + x[2]*x[3]*x[7] + x[3]*x[4]*x[7] + x[4]*x[5]*x[7] + x[5]*x[6]*x[7] + x[1]*x[7] - 1, x[1]*x[3]*x[7] + x[2]*x[4]*x[7] + x[3]*x[5]*x[7] + x[4]*x[6]*x[7] + x[2]*x[7] - 2, x[1]*x[4]*x[7] + x[2]*x[5]*x[7] + x[3]*x[6]*x[7] + x[3]*x[7] - 3, x[1]*x[5]*x[7] + x[2]*x[6]*x[7] + x[4]*x[7] - 4, x[1]*x[6]*x[7] + x[5]*x[7] - 5, x[6]*x[7] - 6, x[1] + x[2] + x[3] + x[4] + x[5] + x[6] + 1];
t := tdeg(seq(x[i], i = 1 .. 7));
G := Basis(Eco7, t);
B := NormalSet(G, t)[1];
f := -x[5]^3;
MODTraverso(G, B, f, t, 7);
Traverso(G, B, f, t, 7);
BSH(G, f, t)


CR10 := [-8*x[1]*x[2] - 2*x[1] - x[3] + 1, -8*x[1]*x[2] - 2*x[2] - 3*x[4], -8*x[3]*x[4] + x[1] - 2*x[3] - x[5], -8*x[3]*x[4] + x[2] - 2*x[4] - 3*x[6], -8*x[5]*x[6] + x[3] - 2*x[5] - x[7], -8*x[5]*x[6] + x[4] - 2*x[6] - 3*x[8], -8*x[7]*x[8] + x[5] - 2*x[7] - x[9], -8*x[7]*x[8] + x[6] - 2*x[8] - 3*x[10], -8*x[9]*x[10] + x[7] - 2*x[9], -8*x[9]*x[10] + x[8] - 2*x[10] - 3];
t := tdeg(seq(x[i], i = 1 .. 10));
G := Basis(CR10, t);
B := NormalSet(G, t)[1];
f := -x[1]*x[2]^2*x[4]^2*x[5]*x[6]*x[7]^2*x[9]^2*x[10] - x[1]^2*x[2]*x[5]*x[6]*x[7]^2*x[8]^2*x[9]*x[10] - x[1]*x[2]^2*x[3]^2*x[4]^2*x[6]^2*x[9]^2 + x[1]^2*x[3]*x[5]*x[8]^2*x[9]*x[10];
MODTraverso(G, B, f, t, 10);
Traverso(G, B, f, t, 10);
BSH(G, f, t);


Bellido := [x[1]^2 + x[2]^2 + x[3]^2 - 12*x[1] - 68, x[4]^2 + x[5]^2 + x[6]^2 - 12*x[5] - 68, x[7]^2 + x[8]^2 + x[9]^2 - 24*x[8] - 12*x[9] + 100, x[1]*x[4] + x[2]*x[5] + x[3]*x[6] - 6*x[1] - 6*x[5] - 52, x[1]*x[7] + x[2]*x[8] + x[3]*x[9] - 6*x[1] - 12*x[8] - 6*x[9] + 64, x[4]*x[7] + x[5]*x[8] + x[6]*x[9] - 6*x[5] - 12*x[8] - 6*x[9] + 32, 2*x[2] + 2*x[3] - 2*x[6] - x[4] - x[5] - x[7] - x[9] + 18, x[1] + x[2] + 2*x[3] + 2*x[4] + 2*x[6] - 2*x[7] + x[8] - x[9] - 38, x[1] + x[3] + x[5] - x[6] + 2*x[7] - 2*x[8] - 2*x[4] + 8];
t := tdeg(seq(x[i], i = 1 .. 9));
G := Basis(Bellido, t);
B := NormalSet(G, t)[1];
f := -x[1]^2*x[2]^2*x[3]*x[4]^2*x[5]^2*x[6]*x[7]*x[9] - x[1]*x[4]*x[5]*x[6]^2*x[8];
MODTraverso(G, B, f, t, 9);
Traverso(G, B, f, t, 9);
BSH(G, f, t);


Kat6 := [2*x[6] + 2*x[5] + 2*x[4] + 2*x[3] + 2*x[2] + 2*x[1] + x[7] - 1, 2*x[1]*x[4] + 2*x[1]*x[6] + 2*x[2]*x[3] + x[2]*x[7] + 2*x[5]*x[7] - x[5], 2*x[1]*x[3] + 2*x[1]*x[5] + x[2]^2 + 2*x[2]*x[6] + x[3]*x[7] + 2*x[4]*x[7] - x[4], 2*x[1]*x[2] + 2*x[1]*x[4] + 2*x[2]*x[5] + 2*x[3]*x[6] + 2*x[3]*x[7] + x[4]*x[7] - x[3], 2*x[1]*x[2] + 2*x[1]*x[7] + 2*x[2]*x[3] + 2*x[3]*x[4] + 2*x[4]*x[5] + 2*x[5]*x[6] + x[6]*x[7] - x[1], 2*x[1]^2 + 2*x[2]^2 + 2*x[3]^2 + 2*x[4]^2 + 2*x[5]^2 + 2*x[6]^2 + x[7]^2 - x[7], x[1]^2 + 2*x[1]*x[3] + 2*x[2]*x[4] + 2*x[2]*x[7] + 2*x[3]*x[5] + 2*x[4]*x[6] + x[5]*x[7] - x[2]];
t := tdeg(seq(x[i], i = 1 .. 7));
G := Basis(Kat6, t);
B := NormalSet(G, t)[1];
f := -x[1]^2*x[2]^2*x[3]^2*x[5]^2 + x[1]^2*x[3]*x[5]^2*x[6]^2 + x[1]*x[2]^2*x[5]*x[6]^2*x[7];
MODTraverso(G, B, f, t, 7);
Traverso(G, B, f, t, 7)
BSH(G, f, t);


BR7 := [-2*x[2]^2 - x[1] + 3*x[2] - 2*x[3] + 1, -2*x[3]^2 - x[2] + 3*x[3] - 2*x[4] + 1, -2*x[4]^2 - x[3] + 3*x[4] - 2*x[5] + 1, -2*x[5]^2 - x[4] + 3*x[5] - 2*x[6] + 1, -2*x[6]^2 - x[5] + 3*x[6] - 2*x[7] + 1, -2*x[7]^2 - x[6] + 3*x[7] - 2*x[8] + 1, -2*x[8]^2 - x[7] + 3*x[8] - 2*x[9] + 1, x[1], x[9]];
t := tdeg(seq(x[i], i = 1 .. 9));
G := Basis(BR7, t);
B := NormalSet(G, t)[1];
f := x[1]*x[2]*x[3]*x[6]*x[8]*x[9] + x[2]*x[4]*x[5]*x[6]*x[7]*x[8] + x[1]*x[4]*x[5]*x[7]*x[8] + x[1]*x[3]*x[6]*x[9] + x[1]*x[6]*x[7];
MODTraverso(G, B, f, t, 9);
Traverso(G, B, f, t, 9);
BSH(G, f, t);