# Solve univariate or bivariate equations over a field K SolveOverK := proc(P::set, vars::set, K::set) local x,A,i,j; x := vars[1]; if P minus {0} = {} then error "SolveOverK only meant for systems with at most 2 variables and finitely many solutions" elif nops(vars)=1 then if nops(P)>1 then procname({gcd(P[1],P[2]), op(P[3..-1])}, vars, K) elif indets(P,name)={x} then {seq({x=i[1]}, i=roots(P[1], K))} else {seq(`if`(degree(i[1],x)=1, {x=evala(-coeff(i[1],x,0)/coeff(i[1],x,1))}, NULL), i=factors(P[1], K)[2])} fi else if add(degree(i,x),i=P) > add(degree(i,vars[2]),i=P) then x := vars[2] fi; A := procname({seq(seq(primpart(resultant(P[i],P[j],x)),j=i+1..nops(P)),i=1..nops(P)-1)}, vars minus {x}, K); {seq(seq(i union j, j=procname(map(numer,evala(eval(P, i))), {x}, K)), i=A)} fi end: # The field K is represented by a set of field extensions (RootOf's and radicals) # P is a square-free polynomial of degree 4 or 5, representing 5 points # (if the degree is 4 then infinity is one of the 5 points). # FindBelyi2 := proc(P, x::name, K::set) local R,p,ANS,m,Ptilde,EQ,a,b,c,d,bc,i,j,f1,f2,su,p0,p1,p2,nz,av,mtilde,EQa,cv; if not member(degree(P,x), {4,5}) then error "P should have degree 4 or 5" fi; R := {seq(eval(x,i),i=SolveOverK({P},{x},K)), `if`(degree(P,x)=4,infinity,NULL)}; ANS := NULL; for p in R do # Step 1: if p=infinity then m, mtilde := x, x else m, mtilde := 1/(x-p), 1/x + p fi; # Step 2: Ptilde := numer(evala(subs(x=mtilde, P))); if degree(Ptilde,x)=3 then # (happens when P(0)=0) Ptilde := Ptilde * x fi; Ptilde := collect(Ptilde/lcoeff(Ptilde,x), x, evala); # # Ptilde should be the numerator of f(mtilde) # # F4 = 1-(x^2+a*x+b)^2 / (c*(x+d)^3) # # The numerator of F4 should be divisible by Ptilde, so this should be zero: EQ := rem(c*(x+d)^3 - (x^2+a*x+b)^2, Ptilde, x); # Step 3: bc := SolveTools:-Linear({coeff(EQ,x,3),coeff(EQ,x,2)}, {b,c}); nz := eval((d^2-a*d+b)*c, bc); # Discard solutions with nz=0 f1 := eval((x^2+a*x+b)^2/c/(x+d)^3, bc); # f1 = 1-F4 EQ := map(numer,map(evala,eval({coeff(EQ,x,1), coeff(EQ,x,0)}, bc))); # Step 4: EQ := SolveOverK(EQ, {d, a}, K); # Step 5: F4 = 1-subs(solution, f1) ANS := ANS, seq(`if`(evala(eval(nz,i))=0, NULL, 1-evala(subs(i,x=m,f1))), i=EQ); # Step 7: su := coeff(Ptilde,x,3)/4; Ptilde := collect(subs(x=x-su, Ptilde), x, evala); # Erase x^3 coefficient p0,p1,p2 := seq(coeff(Ptilde,x,i),i=0..2); # p3 = 0 EQa := 1048576*a^12+524288*a^10*p2+131072*a^9*p1-73728*(4*p0-p2^2)*a^8+49152*a^7*p1*p2-21504*a^6*p1^2-4608*p1*(4*p0-p2^2)*a^5-1920*a^4*p1^2*p2-432*a^4*(4*p0-p2^2)^2-736*a^3*p1^3-72*p1^2*(4*p0-p2^2)*a^2+16*a*p1^3*p2+p1^4; # Step 8: av := SolveOverK({EQa}, {a}, K); if av<>{} then cv := 4*a^3-3*b*a+6*a*d; # cv = the value of c, computed from a linear equation, namely, the x^3-coefficient of: EQ := rem( (x^2+2*a*x+d)^3 - (x^3+3*a*x^2+b*x+cv)^2, Ptilde, x); f1 := (x^3+3*a*x^2+b*x+cv)^2 / (x^2+2*a*x+d)^3; EQ := map(numer,map(evala,{coeff(EQ,x,2), coeff(EQ,x,1), coeff(EQ,x,0)})); # Step 9: for i in av do for j in SolveOverK(map(numer,evala(eval(EQ,i))), {b,d}, K) do f2 := evala(subs(i,j,x=m+su,f1)); if max(degree(numer(f2),x),degree(denom(f2),x))=6 then ANS := ANS, 1-f2 fi od od fi; od: {ANS} end: # Example: P := 14*x^4+72*x^3-37/4*x^2+7*x-24; # Since P has degree 4, the five points are: {infinity} union roots of P. FindBelyi2(P, x, {});