`type/mytype1`:= proc (v) if type(v, indexed) and op(0, v) = E or op(0, v) = F or op(0, v) = Theta then return true else return false end if end proc:

`type/mutype`:= proc (v) if type(v, indexed) and op(0, v) = mu then return true else return false end if end proc:

Arrange1 := proc (v) local L, m; if v = 0 then return [0, 0, 0] else L := indets(v, mytype1); m := nops(L) end if; if 1 < m then return [m, L[1], add(i, i = normal([op(collect(v, L, distributed))]))] elif m = 1 then return 1, L[1], coeff(v, L[1])*L[1] end if end proc:


grade1 := proc (V) local L; L := Arrange1(V); if L[1] = 1 and L[2] <> E[10000000000, 10000000000] and L[2] <> F[10000000000, 10000000000] then return 2*ldegree(coeff(L[3], L[2]), indets(L[3], mutype))+op(2, L[2]) end if end proc:

GRADE := proc (V) local J, w; return max(map(grade1, {op(V+E[10000000000, 10000000000]+F[10000000000, 10000000000])})) end proc:
                
ELKTRASFORMATION := proc (V1, l, k, a0) local c; c := 0; if l <> k then c := E[l+1, k]*coeff(V1, E[l, k])/((2*l+2)*a0) end if; return c end proc:


FLKTRASFORMATION := proc (V1, l, k, a0) local d; d := 0; if l <> k then d := (1/2)*F[l+1, k]*coeff(V1, F[l, k])/(a0*(l+2)) end if; return d end proc:


ThetaLKTRASFORMATION:= proc (V1, l, k, a0) local e; e := 0; if l <> k then e := (1/2)*Theta[l+1, k]*coeff(V1, Theta[l, k])/(a0*(l+1)) end if; return e end proc:


TRANSFORMATION1 := proc (n, VF) local TRANSFORMATION1, trans, i, W, INDETS, NEWVF, a0, a1; TRANSFORMATION1 := 0; trans := 0; NEWVF := expand(VF+E[20000, 20000]+F[2000, 2000]); a0 := coeff(VF, F[-1, 0]); a1 := subs(mu[1] = 0, mu[2] = 0, mu[3] = 0, mu[4] = 0, mu[5] = 0, mu[6] = 0, mu[7] = 0, mu[8] = 0, mu[9] = 0, mu[10] = 0, mu[11] = 0, a0);
 for i to nops(NEWVF) do if E[20000, 20000] = op(i, NEWVF) or F[2000, 2000] = op(i, NEWVF) then
trans := 0; 
TRANSFORMATION1 := TRANSFORMATION1+trans 
else
W := op(i, NEWVF); INDETS := indets(W, mytype1);
if n = GRADE(W) then 
 if op(0, INDETS[1]) = E then
 trans := ELKTRASFORMATION(op(i, NEWVF), op(1, INDETS[1]), op(2, INDETS[1]), a1);  #print(W, trans);
TRANSFORMATION1 := TRANSFORMATION1+trans 
elif op(0, INDETS[1]) = F then 
trans := FLKTRASFORMATION(op(i, NEWVF), op(1, INDETS[1]), op(2, INDETS[1]), a1); #print(W, trans);
TRANSFORMATION1 := TRANSFORMATION1+trans 
elif op(0, INDETS[1]) = Theta then 
trans := ThetaLKTRASFORMATION(op(i, NEWVF), op(1, INDETS[1]), op(2, INDETS[1]), a1); #print(W, trans);
TRANSFORMATION1 := TRANSFORMATION1+trans end if else trans := 0;
TRANSFORMATION1 := TRANSFORMATION1+trans end if end if end do; 
return TRANSFORMATION1 end proc:

LIEBRACKETEE := proc (l, k, m, n) return (n-k)*E[l+m, k+n] end proc:
 
LIEBRACKETFF := proc (l, k, m, n) return ((m+1)*(k+2)-(l+1)*(n+2))*F[l+m, k+n] end proc:
 
LIEBRACKETThetaTheta := proc (l, k, m, n) return 0 end proc:

LIEBRACKETFE := proc (l, k, m, n) return (n+2)*(m*(k+2)-n*(l+1))*E[l+m, k+n]/(k+n+2)-k*(k+2)*F[l+m, k+n]/(k+n+2) end proc:

LIEBRACKETEF := proc (m, n, l, k) return (n+2)*(-m*(k+2)+n*(l+1))*E[m+l, n+k]/(n+k+2)+k*(k+2)*F[m+l, n+k]/(n+k+2) end proc:
 
LIEBRACKETFTheta:= proc (l, k, m, n) return (m*(k+2)-n*(l+1))*Theta[l+m, k+n] end proc:

LIEBRACKETThetaF := proc (m, n, l, k) return (-m*(k+2)+n*(l+1))*Theta[m+l, n+k] end proc:
 
LIEBRACKETETheta := proc (l, k, m, n) return n*Theta[l+m, k+n] end proc:

LIEBRACKETThetaE:= proc (m, n, l, k) return -n*Theta[m+l, n+k] end proc:


LIEPRODUCT1 := proc (V1, V2) local INDETS1, INDETS2; INDETS1 := indets(V1, mytype1); INDETS2 := indets(V2, mytype1); if V1 = 0 or V2 = 0 then return 0 elif op(0, INDETS1[1]) = E and op(0, INDETS2[1]) = E then return coeff(V1, INDETS1[1], 1)*coeff(V2, INDETS2[1], 1)*LIEBRACKETEE(op(1, INDETS1[1]), op(2, INDETS1[1]), op(1, INDETS2[1]), op(2, INDETS2[1])) elif op(0, INDETS1[1]) = F and op(0, INDETS2[1]) = F then return coeff(V1, INDETS1[1], 1)*coeff(V2, INDETS2[1], 1)*LIEBRACKETFF(op(1, INDETS1[1]), op(2, INDETS1[1]), op(1, INDETS2[1]), op(2, INDETS2[1])) elif op(0, INDETS1[1]) = Theta and op(0, INDETS2[1]) = Theta then return coeff(V1, INDETS1[1], 1)*coeff(V2, INDETS2[1], 1)*LIEBRACKETThetaTheta(op(1, INDETS1[1]), op(2, INDETS1[1]), op(1, INDETS2[1]), op(2, INDETS2[1])) elif op(0, INDETS1[1]) = E and op(0, INDETS2[1]) = F then return coeff(V1, INDETS1[1], 1)*coeff(V2, INDETS2[1], 1)*LIEBRACKETEF(op(1, INDETS1[1]), op(2, INDETS1[1]), op(1, INDETS2[1]), op(2, INDETS2[1])) elif op(0, INDETS1[1]) = F and op(0, INDETS2[1]) = E then return coeff(V1, INDETS1[1], 1)*coeff(V2, INDETS2[1], 1)*LIEBRACKETFE(op(1, INDETS1[1]), op(2, INDETS1[1]), op(1, INDETS2[1]), op(2, INDETS2[1])) elif op(0, INDETS1[1]) = E and op(0, INDETS2[1]) = Theta then return coeff(V1, INDETS1[1], 1)*coeff(V2, INDETS2[1], 1)*LIEBRACKETETheta(op(1, INDETS1[1]), op(2, INDETS1[1]), op(1, INDETS2[1]), op(2, INDETS2[1])) elif op(0, INDETS1[1]) = Theta and op(0, INDETS2[1]) = E then return coeff(V1, INDETS1[1], 1)*coeff(V2, INDETS2[1], 1)*LIEBRACKETThetaE(op(1, INDETS1[1]), op(2, INDETS1[1]), op(1, INDETS2[1]), op(2, INDETS2[1])) elif op(0, INDETS1[1]) = F and op(0, INDETS2[1]) = Theta then return coeff(V1, INDETS1[1], 1)*coeff(V2, INDETS2[1], 1)*LIEBRACKETFTheta(op(1, INDETS1[1]), op(2, INDETS1[1]), op(1, INDETS2[1]), op(2, INDETS2[1])) elif op(0, INDETS1[1]) = Theta and op(0, INDETS2[1]) = F then return coeff(V1, INDETS1[1], 1)*coeff(V2, INDETS2[1], 1)*LIEBRACKETThetaF(op(1, INDETS1[1]), op(2, INDETS1[1]), op(1, INDETS2[1]), op(2, INDETS2[1])) end if end proc:
                       
LIEPRODUCTs1 := proc (f, g) local NEWF, NEWG, i, j, lie, LIEPRODUCTs1; lie := 0; LIEPRODUCTs1 := 0; if f = 0 or g = 0 then return 0 else NEWF := f+E[20000, 20000]+F[2000, 2000]; NEWG := g+E[20000, 20000]+F[2000, 2000]; for i to nops(NEWF) do for j to nops(NEWG) do if E[20000, 20000] = op(i, NEWF) or E[20000, 20000] = op(j, NEWG) or F[2000, 2000] = op(i, NEWF) or F[2000, 2000] = op(j, NEWG) then lie := 0 else lie := LIEPRODUCT1(op(i, NEWF), op(j, NEWG)) end if; LIEPRODUCTs1 := LIEPRODUCTs1+lie end do end do; return LIEPRODUCTs1 end if end proc:


ADJOINT11 := proc (N, Y, VF) local i, n, N10, NEWVF, ADJOINT1; if Y = 0 then ADJOINT1:= VF else N10 := GRADE(Y); n := floor(N/N10); NEWVF := expand(simplify(VF)); ADJOINT1 := VF; for i to n do NEWVF := LIEPRODUCTs1(Y, NEWVF); ADJOINT1 := ADJOINT1+NEWVF/factorial(i) end do end if; ADJOINT1 := expand(simplify(ADJOINT1)); return ADJOINT1 end proc:


TRUNCATE1 := proc (VF, n) local i, NEWVF, W, trun, TRUNCATE1; trun := 0; TRUNCATE1 := 0; NEWVF := expand(VF+E[20000, 20000]+F[2000, 2000]); for i to nops(NEWVF) do W := op(i, NEWVF); if W <> E[20000, 20000] and W <> F[2000, 2000] and GRADE(W) <= n then trun := op(i, NEWVF) else trun := 0 end if; TRUNCATE1 := TRUNCATE1+trun end do; return TRUNCATE1 end proc:


#SECONDNORMALFORM := proc (N, VF) local newvf1, newvf2, i, secondnormalform; 
#secondnormalform := expand(simplify(TRUNCATE1(VF, N)));
# for i to N do 
#newvf1 := TRANSFORMATION1(i, expand(secondnormalform)); print(newvf1,secondlevel);
#newvf2 := TRUNCATE1(ADJOINT11(N, newvf1, expand(secondnormalform)), N); 
#secondnormalform := expand(newvf2) end do; 
 #return Arrange13(secondnormalform); end proc:
 
SECONDNORMALFORM := proc (N, VF) local newvf1, newvf2, i, secondnormalform,K;
K:= [seq(k[i], i = 1 .. N)]; 
secondnormalform := expand(simplify(TRUNCATE1(VF, N)));
for i to N do 
newvf1 := TRANSFORMATION1(i, expand(secondnormalform)); 
K[i] := [Arrange1(newvf1)[3],second]; #print(K[i]);
newvf2 := TRUNCATE1(ADJOINT11(N, newvf1, expand(secondnormalform)), N); #print(Arrange1(newvf2)[3]);
secondnormalform := expand(newvf2) end do; 
#return([Arrange13(secondnormalform),K]); 
return((Arrange13(secondnormalform))); 
 end proc:


Arrange13 := proc (v) local L, m; if v = 0 then return [0, 0, 0] else L := indets(v, mytype1); m := nops(L) end if; if 1 < m then return add(i, i = normal([op(collect(v, L, distributed))])) elif m = 1 then return coeff(v, L[1])*L[1] end if end proc:

twolist := proc (T1, T2) local T, t1, t2;  t1 := op(T1); t2 := op(T2); T := [t1, t2]; return T end proc:

threelist := proc (T1, T2, T3) local T, t1, t2,t3;  t1 := op(T1); t2 := op(T2);  t3:= op(T3); T := [t1, t2, t3]; return T end proc:

