restart; with(LinearAlgebra): # Define indeterminates QParam := [q1,q2,q3,q4,q5]: PParam := Matrix([[p1],[p2],[p3],[p4],[p5],[p6]]): # Special Fourier parameterization and inverse F := Matrix([ [1,1,1,1,1,1], [1,7/15,1/5,1/15,-1/15,-1/5], [1,1/5,-1/5,0,-1/15,2/15], [1,-1/15,1/105,-11/105,3/35,-1/35], [1,-1/3,1/15,2/15,-1/15,0]]): FI := Matrix([ [1/256,15/128,15/64,105/256,15/64], [15/256,105/128,45/64,-105/256,-75/64], [15/128,45/64,-45/32,15/128,15/32], [15/64,15/32,0,-165/64,15/8], [45/128,-45/64,-45/32,405/128,-45/32], [15/64,-45/32,15/8,-45/64,0]]): # List of polynomial parametrizations P0 := [ e0^5+3*e1^5, 15*e0^4*e1+15*e0*e1^4+30*e1^5, 30*e0^3*e1^2+30*e0^2*e1^3+60*e1^5, 60*e0^3*e1^2+120*e0*e1^4+60*e1^5, 180*e0^2*e1^3+90*e0*e1^4+90*e1^5, 60*e0^2*e1^3+180*e0*e1^4]: # Substitutions based on the model P := P0: P := subs(e0 = 1-3*e1, P): # Check that the polynomial parametrization lies in the probability simplex suma := 0: for i from 1 to nops(P) do suma := suma + P[i]: od: normal(expand(suma)); # Ideal of Invariants in Fourier coordinates Invariants := Matrix([ q4^2-q3*q5, q3*q4-q2*q5, q3^2-q2*q4, q2*q3-q1*q5, q2^2-q1*q4]): # Ideal of Invariants in probability coordinates Fourier := MatrixMatrixMultiply(F,PParam): PInvariants := Invariants: for i from 1 to nops(QParam) do PInvariants := subs(QParam[i] = Fourier[i, 1], PInvariants): od: # Evaluation of Invariants at the polynomial/rational parametrization num := op(PInvariants[1,1..-1])[1]: for j from 1 to num do coordpoly := PInvariants[1, j]: for i from 1 to op(PParam[1..-1,1])[1] do coordpoly := subs(PParam[i, 1] = P0[i], coordpoly): od: coordpoly :=expand(coordpoly): lprint(j,coordpoly); od: