# This program finds 2F1 type solution: y(x) = exp(int(r,x))*(r_0*S(f) + r_1*diff(S(f),x)), of a second order linear differential operator L # where r,r_0,r_1 are rational functions and S(f)=2F1(a,b;c|f) with degree(f) = 3: _Envdiffopdomain := [Dx,x]: with(DEtools): hypergeomdeg3:= proc(Fld,L,x) # Here, L is a second order differential operator and Fld is the specified field. local a,b,c,G,B1,e0,e1,ei,L1,LH,LH1,Sing_L1,i,j,n_sing,soln,check,Cases,Res,Field_L,Sings; # If the base field is not given, insert it. That also helps while the user wants to insert the extension field for B. if nargs = 2 then Field_L:= indets([args], {RootOf, radical}) union `if`(has([args],I),{I},{}); return procname(Field_L,args); fi; LH:= Dx^2-(-2*x+x*e0+x*e1+1-e0)*Dx/(x*(x-1))+(1/4)*(e0+e1-ei-1)*(e0+e1+ei-1)/(x*(x-1)); L1:= L; B1:= Fld; Sing_L1:= eval(printsing(L1,B1),infinity = 1); soln:= NULL; Sings:= [seq(points(i[1],x),i=Sing_L1)]; n_sing:= add(i,i=Sings); if n_sing < 4 or n_sing > 9 then if n_sing = 3 then return "3-descent not required"; else return "doesn't have a 3-descent"; fi; fi; Cases:= [cubic4to3,cubic5to3,cubic6to3,cubic7to3,cubic8to3,cubic9to3]; Res:= Cases[n_sing-3](B1,Sing_L1); if Res <> {} and not(type(Res,string)) then for i in Res do if normal(add(makemin(i[2][j]),j=1..3)) >=1 then lprint("This selection leads to Liouvillian solution"); next; fi; # We don't want c in 2F1(a,b;c|f) to be 0,-1,-2,... We can convert such c to 1 upto equivalence; if denom(i[2][1]) = 1 and i[2][1] >= 1 then if irem(i[2][1],2) = 0 or has({denom(i[2][2]),denom(i[2][3])},2) then i[2][1] := 0; else if i[2][2] < 0 then i[2][1]:= 0; i[2][2]:= i[2][2]+1; else i[2][1]:= 0; i[2][2]:= i[2][2]-1; fi; fi; fi; LH1:= transfo(eval(LH,{e0=i[2][1],e1=i[2][2],ei=i[2][3]}),i[1]); a:=normal((1-i[2][1]-i[2][2]-i[2][3])/2); b:= normal((1-i[2][1]-i[2][2]+i[2][3])/2); c:=normal(1-i[2][1]); G := equiv(LH1, L); if G = 0 then next; fi; G := eval(diffop2de(G, y(x)), y(x) = hypergeom([a,b],[c],i[1])); if not(has(indets(G, function),hypergeom)) then next; fi; G := collect(G, select(has,indets(G, function),hypergeom)); soln := soln,G; od; fi; if soln <> NULL then {sort([op({soln})], length)[1]}; else {}; fi; end: # This program (cubic4to3) takes the singularity structure (set of lists of irreducible polys and their exp. differences) and returns the set of f's # of degree 3 which carries those 4 points to 3 points (0,1,infty). # We have the following 5 possibilities: # say S:= {0,1,infinity}. # 1. at most 1 ram above S gives at least 6 sings. # 2. 2 rams above S gives 4 sings in the following cases: # i. of order 3 above the points with exp diff */3, <>*/3 ------> Case1 # ii. of order 2,3 above the points with exp diff */2,*/3 resp ---> Case2 # 3. 3 rams gives 4 singularities in the following cases: # i. of order 2,2,3 above the points with exp diff <>*/2, */3 ---> Case3 # ii. of order 2,2,3 above points with exp diff */2, <> */2, <> */3 ---> Case4 # iii. of order 2,2,2 above the points with exp diff <> */2, */2, */2 ---> Case5 (Liouvillian solutions) cubic4to3:= proc(Fld,Ls) # Ls is a set of lists [pi,ei] where pi is an irreducible poly in x and ei its corresponding exponent difference. # and Fld is the specified field. local B,i,H,t,Cases,Fs,Ls1; # we are looking for the rational f which carries 4 points to 0,1,infinity. # So, we must have at least 2 irreducible polys and the polys may have at most degree 3. Ls1:= Ls; if nops(Ls1) < 2 or nops(Ls1) > 4 then return "wrong input"; fi; B:= add(points(t[1],x),t= Ls1); if B <> 4 then return "wrong input"; fi; Cases:= {Case41,Case42,Case43,Case44}; Fs:= {}; for i in Cases do H:= i(Fld,Ls1); if type(H,string) then next; fi; Fs := Fs union H; od; Fs; end: # Case1: # This case computes f which produces 4 singularities above {0,1,infty}. # 2 rams. of order 3 above points with exponent difference <> */3 and */3 respectively. Case41:= proc(Fld,S) local s,a1,a2,c,e,i,i1,i2,j,k,k1,p1,Ps,Es,N,N1,N2,n,f,f1,f2,F,Sol,sq,E0,E1,E_i,Fld_f; #Ei is protected!(Exponential integral). # option trace; # Let our 2F1 has exp. diff. [e0,e1,ei]. # Let, f ramifies above 0 with exp diff <> */3 and above 1 with exp diff */3 respectively. # Then for our case: E:=[3*e0,ei,ei,ei]. # We must have at least one linear poly: s:= S; Ps:=[seq(i[1],i=s)]; Es:= [seq(i[2],i=s)]; N:= {seq(i,i=1..nops(s))}; n:= nops(N); p1:= 0; for i in N do if points(Ps[i],x) = 1 then p1:= p1 + points(Ps[i],x); fi; od; if p1 < 1 then return "not in Case1"; fi; # Let's check conditions on Es. Any 3 of them have to be equal mod Z: for i in N do e:= Es[i]; a1:= points(Ps[i],x); for i1 in N minus {i} do if type(evala(Es[i1]-e),integer) or type(evala(Es[i1]+e),integer) then a1:= a1 + points(Ps[i1],x); fi; od; if a1 > 2 then break; fi; od; if a1 < 3 then return "not in Case1"; fi; # Let's find candidates for f now. Set order 3 ramifications above 0 (with exp diff <> */3) and 1 (with exp diff */3): F:= {}; E1:= {1/3,2/3}; for i in N do if points(Ps[i],x) = 1 then f1:= c*Ps[i]^3; E0:= {normal(Es[i]/3), normal((Es[i]-1)/3), normal((Es[i]+1)/3)}; # Thas's because Es[i] is known (only) up to mod Z. for i1 in N minus {i} do f2:= f1/Ps[i1]; a2:= points(Ps[i1],x); E_i:= Es[i1]; for i2 in N minus {i,i1} do if type(evala(Es[i2]-Es[i1]),integer) or type(evala(Es[i2]+Es[i1]),integer) then f2:= f2/Ps[i2]; a2:= a2+points(Ps[i2],x); else break; fi; od; if a2 <> 3 then break; fi; Sol:= {solve(discrim(numer(1-f2),x))}; if Sol <> {} then for j in Sol do f:= evala(eval(f2,c=j)); Fld_f:= indets(f, {RootOf, radical}) union `if`(has(f,I),{I},{}); if nops(Fld_f minus Fld) <> 0 then next; fi; if max(degree(numer(f),x),degree(denom(f),x)) <> 3 then next; fi; sq:= sqrfree(numer(1-f),x)[2]; if nops(sq) = 0 or (nops(sq) = 1 and sq[1][2] = 3) then F:= F union {seq(seq([factor(f),[k,k1,E_i]], k=E0),k1=E1)}; fi; od; fi; od; fi; od; F; end: # Case2: # This case computes f which produces 4 singularities above {0,1,infty}. # 2 rams. of order 2,3 above points with exponent difference */2,*/3 respectively. Case42:= proc(Fld,S) local s,a1,b,c,e,i,i1,i2,j,j1,k,k1,n,p1,p2,f,f1,f2,F,Es,Ps,N,N1,P,Sol,eqns,Eshalf,E0,E1,E_i,Fld_f; # option trace; # Let our 2F1 has exp. diff. [e0,e1,ei]. # Put exp diffs */2,*/3 at 0,infty respectively. # Then for our case: E:=[1/2,e1,e1,e1]. # We must have at least one linear poly: s:= S; Ps:=[seq(i[1],i=s)]; Es:= [seq(i[2],i=s)]; N:= {seq(i,i=1..nops(s))}; n:= nops(N); p1:= 0; for i in N do if points(Ps[i],x) = 1 then p1:= p1 + points(Ps[i],x); fi; od; if p1 < 1 then return "not in Case2"; fi; # Let's check conditions on Es. One of them must be 1/2 and rest of them must be equal mod Z: Eshalf:= {}; for i in N do if denom(Es[i]) = 2 and type(numer(Es[i]),integer) then N1:= N minus {i}; Eshalf:= Eshalf union {i}; fi; if nops(Eshalf) = 1 then break; fi; od; if nops(Eshalf) <> 1 then return "not in Case2"; fi; e:= Es[N1[1]]; for i in N1 minus {N1[1]} do if not(type(evala(Es[i]-e),integer) or type(evala(Es[i]+e),integer)) then return "not in Case2"; fi; od; # Let's find candidates for f now. Set order 2 ram above 0 and order 3 ram above infinity: F:= {}; f1:= {c, c/(x-b)^3}; E_i:= {1/3,2/3}; # b could be at infinity. for i in N do if points(Ps[i],x) = 1 and (denom(Es[i]) = 2 and type(numer(Es[i]),integer)) then f2:= {seq(k*Ps[i],k=f1)} union {seq(k*Ps[i]*(x-a1)^2,k=f1)}; E0:= Es[i]; f2:= {seq(`if`(max(degree(numer(k),x),degree(denom(k),x)) = 3,k,NULL),k=f2)}; for i1 in N minus {i} do P:= Ps[i1]; p2:= points(Ps[i1],x); E1:= Es[i1]; for i2 in N minus {i,i1} do if type(evala(Es[i2]-Es[i1]),integer) or type(evala(Es[i2]+Es[i1]),integer) then P:= P*Ps[i2]; p2:= p2+points(Ps[i2],x); else break; fi; od; if p2 = 3 then for j in f2 do if degree(P,x) = 3 then eqns:= {coeffs(rem(numer(1-j),P,x),x)}; else eqns:= {coeffs(rem(numer(1-j),P,x),x),lcoeff(numer(1-j),x)}; fi; Sol:= {solve(eqns,{a1,b,c})}; if Sol <> {} and Sol <> {{}} then for j1 in Sol do f:= evala(eval(j,j1)); Fld_f:= indets(f, {RootOf, radical}) union `if`(has(f,I),{I},{}); if nops(Fld_f minus Fld) <> 0 then next; fi; if max(degree(numer(f),x),degree(denom(f),x)) <> 3 or nops(indets(f)) <> 1 then next; fi; F:= F union {seq([factor(f),[E0,E1,k1]],k1=E_i)};od; fi; od; fi; od; fi; od; F; end: # Case3: # This case computes f which produces 4 singularities above {0,1,infty}. # 3 rams. of order 2,2,3 with exponent difference <> */2 , <> */2 and */3 respectively. Case43:= proc(Fld,S) local s,c,i,i1,j,j1,j2,Ps,Es,N,N1,N2,n,f,f1,f2,f3,f4,F,Sol,sq,E0,E1,E_i,Fld_f; # option trace; # Let our 2F1 has exp. diff. [e0,e1,ei]. # Let, f ramifies above 0,1 and infinity with order 2,2 and 3 respectively. # Then for our case: E:=[e0,2*e0,e1,2*e1]. # We must have all linear polys: 1,1,1,1 Case: s:= S; Ps:=[seq(i[1],i=s)]; Es:= [seq(i[2],i=s)]; N:= {seq(i,i=1..nops(s))}; n:= nops(N); for i in N do if points(Ps[i],x) <> 1 then return "not in Case3"; fi; od; # Let's check conditions on Es. Any two pairs of them have to be in the form e, 2*e: for i in N do if denom(Es[i]) <> 2 then N1:= N minus {i}; for i1 in N1 do if type(evala(Es[i1]-2*Es[i]),integer) or type(evala(Es[i1]+2*Es[i]),integer) then N1:= N1 minus {i1}; for j in N1 do if denom(Es[j]) <> 2 then N2:= N1 minus {j}; for j1 in N2 do if type(evala(Es[j1]-2*Es[j]),integer) or type(evala(Es[j1]+2*Es[j]),integer) then N2:= N2 minus {j1}; fi; od; if nops(N2) = 0 then break; fi; fi; od; if nops(N2) = 0 then break; fi; fi; od; if nops(N2) = 0 then break; fi; fi; od; if nops(N2) <> 0 then return "not in Case3"; fi; N2; # Let's find candidates for f now: Set ram of order 3 above 1: F:= {}; E1:= {1/3,2/3}; for i in N do if denom(Es[i]) <> 2 then f1:= c*Ps[i]; E0:= Es[i]; for i1 in N minus {i} do if type(evala(Es[i1]-2*Es[i]),integer) or type(evala(Es[i1]+2*Es[i]),integer) then f2:= f1*Ps[i1]^2; for j in N minus {i,i1} do if denom(Es[j]) <> 2 then f3:= f2/Ps[j]; E_i:= Es[j]; for j1 in N minus {i,i1,j} do if type(evala(Es[j1]-2*Es[j]),integer) or type(evala(Es[j1]+2*Es[j]),integer) then f4:= f3/Ps[j1]^2; # Now the numer(1-f4) must be a cube: Sol:= {solve(discrim(numer(1-f4),x))}; if Sol <> {} then for j2 in Sol do f:= evala(eval(f4,c=j2)); Fld_f:= indets(f, {RootOf, radical}) union `if`(has(f,I),{I},{}); if nops(Fld_f minus Fld) <> 0 then next; fi; if max(degree(numer(f),x),degree(denom(f),x)) <> 3 then next; fi; sq:= sqrfree(numer(1-f),x)[2]; if nops(sq) = 0 or (nops(sq) = 1 and sq[1][2] = 3) then F:= F union {seq([factor(f),[E0,k,E_i]],k=E1)}; fi; od; fi; fi; od; fi; od; fi; od; fi; od; F; end: # Case4: # This case computes f which produces 4 singularities above {0,1,infty}. # 3 rams. of order 2,2,3 with exponent difference <> */2 , = */2 and <> */3 respectively. Case44:= proc(Fld,S) local s,a1,c,i,i1,j,j1,j2,j3,k,k1,Ps,Es,N,N1,N2,N3,n,f,f1,f2,f3,e1,F,P1,P2,Eshalf,Sol,eqns,E0,E1,E_i,Fld_f; # option trace; # Let our 2F1 has exp. diff. [e0,e1,ei]. # Let, f ramifies above 0,1 and infinity with order 2,2 and 3 respectively,take 1/2 exp. diff. above infty and take ram order 3 above 0. # Then for our case: E:=[1/2,3*e0,e1,2*e1]. # We must have all linear polys: 1,1,1,1 Case: s:= S; Ps:=[seq(i[1],i=s)]; Es:= [seq(i[2],i=s)]; N:= {seq(i,i=1..nops(s))}; n:= nops(N); for i in N do if points(Ps[i],x) <> 1 then return "not in Case4"; fi; od; # Let's check conditions on Es. One of them have to be 1/2 and two others have to be in the form e, 2*e: Eshalf:= {}; N1:= {}; for i in N do if denom(Es[i]) = 2 and type(numer(Es[i]),integer) then N1:= N1 union {i}; Eshalf:= Eshalf union {i}; fi; if nops(Eshalf) = 1 then break; fi; od; if nops(Eshalf) <> 1 then return "not in Case4"; fi; N2:= N minus N1; for i in N2 do if denom(Es[i]) <> 2 then e1:= Es[i]; N3:= {i}; for i1 in N2 minus {i} do if type(evala(Es[i1]-2*e1),integer) or type(evala(Es[i1]+2*e1),integer) then N3:= N3 union {i1}; fi; if nops(N3) = 2 then break; fi; od; if nops(N3) = 2 then break; fi; fi; od; if nops(N3) <> 2 then return "not in Case4"; fi; # Let's find candidates for f now: Set 1/2 exp. diff. above 0 and set ram of order 3 above infty: F:= {}; for i in N do if denom(Es[i]) = 2 and type(numer(Es[i]),integer) then f1:= {c*Ps[i], c*Ps[i]*(x-a1)^2}; E0:= Es[i]; # a1 could be at infty for i1 in N minus {i} do f2:= {seq(k/Ps[i1]^3,k=f1)}; E_i:= {normal(Es[i1]/3), normal((Es[i1]-1)/3), normal((Es[i1]+1)/3)}; f3:= {seq(`if`(max(degree(numer(k),x),degree(denom(k),x))=3,k,NULL),k=f2)}; for j in N minus {i,i1} do if denom(Es[j]) <> 2 then P1:= Ps[j]; E1:= Es[j]; for j1 in N minus {i,i1,j} do if type(evala(Es[j1]-2*Es[j]),integer) or type(evala(Es[j1]+2*Es[j]),integer) then P2:= P1*Ps[j1]^2; for j2 in f3 do eqns:= {coeffs(rem(numer(1-j2),P2,x),x)}; Sol:= {solve(eqns,{a1,c})}; if Sol <> {} and Sol <> {{}} then for j3 in Sol do f:= evala(eval(j2,j3)); Fld_f:= indets(f, {RootOf, radical}) union `if`(has(f,I),{I},{}); if nops(Fld_f minus Fld) <> 0 then next; fi; if nops(indets(f)) <> 1 or max(degree(numer(f),x),degree(denom(f),x)) <> 3 or has(factor(numer(1-f)/P2),x) then next; fi; F:= F union {seq([factor(f),[E0,E1,k1]], k1 = E_i)}; od; fi; od; fi; od;fi; od; od;fi; od; F; end: # This program (5to3cubic) takes the singularity structure (set of lists of irreducible polys and their exp. differences) and returns the set of f's # of degree 3 which carries those 5 points to 3 points (0,1,infty). # We have the following 6 possibilities: # say S:= {0,1,infinity}. # At most 1 ramification above S gives at least 6 singularities. # 2 rams. above S gives 5 singularities in the following cases: # of order 3 with exponent difference <> */3.----> Case1. # of order 2 with exponent difference = */2.----> Case2. (Liouvillian solutions) # of order 3,2 with exp. diff. = */3 and <> */2 respectively.----> Case3. # of order 3,2 with exp. diff. <> */3 and = */2 respectively.----> Case4. # 3 rams. above S give 5 singularities in the following cases: # of order 3,2,2 with exp. diff. <> */3,<> */2, <> */2 respectively.----> Case5. # of order 2,2,2 with exp. diff. <> */2, <> */2, = */2 respectively.----> Case6. cubic5to3:= proc(Fld,Ls) # Ls is a set of lists [pi,ei] where pi is an irreducible poly in x and ei its corresponding exponent difference. local b,i,H,Cases,Fs,Ls1,Ls2,Ls3,Mbs; # we are looking for the rational f which carries 5 points to 0,1,infinity. # So, we must have at least three irreducible polys and the polys may have at most degree 3. Ls1:= Ls; if nops(Ls1) < 2 or nops(Ls1) > 5 then return "wrong input"; fi; b:= add(points(t[1],x),t= Ls1); if b <> 5 then return "wrong input"; fi; Cases:= {Case51,Case53,Case54,Case55,Case56}; Fs:= {}; for i in Cases do H:= i(Fld,Ls1); if not(type(H,string)) then Fs:= Fs union H; fi; od; Fs; end: #This case computes f which produces 5 singularities above {0,1,infty}: # Case1: 2 ramifications of order 3 above points with exp. diff. <> 1/3. Case51:= proc(Fld,S) local a,a1,c,e,e1,f,f1,f2,i,i1,i2,j,j1,k,k1,n,p1,p2,p3,s,F,N,P,Es,Ps,eqns,Sol,E0,E1,E_i,Fld_f1; # option trace; s:= S; Ps:=[seq(i[1],i=s)]; Es:= [seq(i[2],i=s)]; N:= {seq(i,i=1..nops(s))}; n:= nops(N); p1:={}; p2:={}; p3:={}; for i in N do if points(Ps[i],x)=1 then p1:= p1 union {i}; elif points(Ps[i],x)=2 then p2:= p2 union {i}; elif points(Ps[i],x)=3 then p3:= p3 union {i}; else return "not in Case1"; fi; od; # In this case there can be at most 1 poly of degree 2 or 3: if nops(p2) > 1 or (nops(p2) = 1 and nops(p3) = 1) then return "not in Case1"; fi; # Now, lets check the conditions on Es; At least 3 of them must be equal mod Z: for i in N do e1:= Es[i]; a:= points(Ps[i],x); for i1 in N minus {i} do if type(evala(Es[i1]-e1),integer) or type(evala(Es[i1]+e1),integer) then a:= a+points(Ps[i1],x); fi; od; if a >= 3 then break; fi; od; if a < 3 then return "wrong input"; fi; # Let's find all possible candidates f now: Set 1 as unramified point. F:={}; for i in N do if points(Ps[i],x) <> 1 then next; fi; f:= c*(Ps[i])^3; E0:= {normal(Es[i]/3), normal((Es[i]-1)/3), normal((Es[i]+1)/3)}; for j in N minus {i} do if points(Ps[j],x) <> 1 then next; fi; f1:= f/(Ps[j])^3; E_i:= {normal(Es[j]/3), normal((Es[j]-1)/3), normal((Es[j]+1)/3)}; for k in N minus {i,j} do a1:= points(Ps[k],x); P:= Ps[k]; e:= Es[k]; for i1 in N minus {i,j,k} do if not(type(evala(Es[i1]-e),integer) or type(evala(Es[i1]+e),integer)) then break; fi; a1:= a1+points(Ps[i1],x); P:= P*Ps[i1]; od; if a1 <> 3 then next; fi; f2:= numer(evala(1-f1)); E1:= Es[k]; if degree(P,x) = 3 then eqns:= {coeffs(rem((f2),P,x),x)}; else eqns:= {coeff(f2,x,3)} union {coeffs(rem((f2),P,x),x)}; fi; Sol:= solve(eqns,c); if Sol <> {} then for i2 in Sol do f1:= evala(eval(f1,i2)); Fld_f1:= indets(f1, {RootOf, radical}) union `if`(has(f1,I),{I},{}); if nops(Fld_f1 minus Fld) <> 0 then next; fi; if max(degree(numer(f1),x),degree(denom(f1),x))=3 and not has(factor(numer(1-f1)/P),x) then F:= F union {seq(seq([factor(f1),[j1,E1,k1]],j1=E0),k1=E_i)}; fi; od; fi; break; od; od; od; F; end: # Case3: 2 rams. of order 2,3 with exponent difference <> */2, = */3 respectively . Case53:= proc(Fld,S) #option trace; local a,a1,c,c1,s,i,i1,j,j1,k,k1,k2,n,f,f1,f2,f3,e,e1,e2,n1,n2,n3,E0,E1,E_i,N,P,Es,Ps,F,Sol,eqns,Fld_f3; # option trace; # Let our 2F1 has exp. diff. [e0,e1,ei]. # Let, f ramifies above 0 and infinity with order 2 and 3 resp. # Then 3 of the exp. diffs must be equal mod Z and rest two must be e and 2*e. s:= S; Ps:=[seq(i[1],i=s)]; Es:= [seq(i[2],i=s)]; N:= {seq(i,i=1..nops(s))}; n:= nops(N); n1:={}; n2:={}; n3:={}; for i from 1 to nops(s) do if points(Ps[i],x)=1 then n1:= n1 union {i}; elif points(Ps[i],x)=2 then n2:= n2 union {i}; elif points(Ps[i],x)=3 then n3:= n3 union {i}; else return "not in Case3"; fi; od; # In this case there can be at most 1 poly of degree 2 or 3: if nops(n2) > 1 or (nops(n2) = 1 and nops(n3) = 1) then return "not in Case3"; fi; # Let's check the conditions on e's now. i. one pair must be e,2*e. ii. the rest must be equal mod Z: for i in N do if points(Ps[i],x) <> 1 then next; fi; e1:= Es[i]; for j in N minus {i} do if points(Ps[j],x) <> 1 or not(type(evala(2*e1- Es[j]),integer) or type(evala(2*e1+Es[j]),integer)) then next; fi; for k in N minus {i,j} do e2:= Es[k]; a:= points(Ps[k],x); for k1 in N minus {i,j,k} do if not(type(evala(e2- Es[k1]),integer) or type(evala(e2+Es[k1]),integer)) then break; fi; a:= a+points(Ps[k1],x); od; break; od; if a = 3 then break; fi; od; if a = 3 then break; fi; od; if a <> 3 then return "not in Case3"; fi; # Lets compute candidate f's now: Set 1 as unramified point and put ram. of order 2 above 0: F:= {}; for i in N do if points(Ps[i],x) <> 1 or denom(Es[i]) = 2 then next; fi; f:= c* Ps[i]; E0:= Es[i]; for j in N minus {i} do if points(Ps[j],x) <> 1 or not(type(evala(Es[j] - 2*E0),integer) or type(evala(Es[j] + 2*E0),integer)) then next; fi; f1:= {f*(Ps[j])^2,f*(Ps[j])^2/(x-c1)^3}; # c1 could be at infinity. for k in N minus {i,j} do e:= Es[k]; P:= Ps[k]; a1:= points(Ps[k],x); for j1 in N minus {i,j,k} do if not(type(evala(Es[j1]-e),integer) or type(evala(Es[j1]+e),integer)) then break; fi; P:= P*Ps[j1]; a1:= a1+points(Ps[j1],x); od; break; od; if a1 <> 3 then next; fi; E1:= e; E_i:= {1/3,2/3}; # Here Ei disappears above, so that could be int/3. Let's take both 1/3 and 2/3. f1:= {seq(`if`(max(degree(numer(h),x),degree(denom(h),x)) = 3, h, NULL),h=f1)}; for f2 in f1 do if degree(P,x) = 3 then eqns:= {coeffs(rem(evala(numer(1-f2)),P,x),x)}; else eqns:= {coeff(evala(numer(1-f2)),x,3)} union {coeffs(rem(evala(numer(1-f2)),P,x),x)}; fi; Sol:= {solve(eqns,{c,c1})}; if Sol = {} or Sol = {{}} then next; fi; for k2 in Sol do f3:= factor(evala(eval(f2,k2))); Fld_f3:= indets(f3, {RootOf, radical}) union `if`(has(f3,I),{I},{}); if nops(Fld_f3 minus Fld) <> 0 then next; fi; # At this point, we want to select only valid f3's.Check if they have degree 3 and normal(numer(1-f3)/P) is a constant. if max(degree(numer(f3),x),degree(denom(f3),x)) <> 3 or has(factor(numer(1-f3)/P),x) then next; fi; F:= F union {seq([factor(f3),[E0,E1,i1]],i1=E_i)}; od; od; od; od; F; end: # Case4: 2 rams. of order 2,3 with exponent difference = */2 and <> */3 respectively. Case54:= proc(Fld,S) local s,a,a1,c,c1,e1,Ps,Es,N,N1,n,i,i1,j,k,k1,k2,p1,p2,p3,Eshalf,F,f,f1,f2,f3,sqr,eqns,Sol,E0,E1,E_i,P,Fld_f; # option trace; # Let our 2F1 has exp. diff. [e0,e1,ei]. # Let, f ramifies above 0 and infinity with order 2 and 3. # Then for our case: E:=[e0,e1,e1,e1,3*ei] with e0 = */2. s:= S; Ps:=[seq(i[1],i=s)]; Es:= [seq(i[2],i=s)]; N:= {seq(i,i=1..nops(s))}; n:= nops(s); p1:={}; p2:={}; p3:={}; for i in N do if points(Ps[i],x)=1 then p1:= p1 union {i}; elif points(Ps[i],x)=2 then p2:= p2 union {i}; elif points(Ps[i],x)=3 then p3:= p3 union {i}; else return "not in Case4"; fi; od; # In this case there can be at most 1 polys of degree 2 or 3: if nops(p2) > 1 or (nops(p2) = 1 and nops(p3) = 1) then return "not in Case4"; fi; # Now, lets check the conditions on Es; # 3 of the exp. diff. have to be equal mod Z and at least one exp. diff. from p1 must have the form */2. Eshalf:= {}; for i in N do if denom(Es[i]) = 2 and type(numer(Es[i]),integer) then Eshalf:= Eshalf union {i}; N1:= N minus {i}; fi; if nops(Eshalf) = 1 then break; fi; od; if nops(Eshalf) <> 1 then return "not in Case4"; fi; for i in N1 do e1:= Es[i]; a:= points(Ps[i],x); for j in N1 minus {i} while a <> 3 do if type(evala(Es[j]-e1),integer) or type(evala(Es[j]+e1),integer) then a:= a+points(Ps[j],x); fi; od; if a = 3 then break; fi; od; if a <> 3 then return "not in Case4"; fi; # Lets compute the candidate f's now: # We are assuming the ramifications above 0 and infinity.Set order 3 ramification above infinity. F:= {}; for i in N do if points(Ps[i],x) <> 1 or denom(Es[i]) <> 2 then next; fi; f:= {c*Ps[i],c*Ps[i]*(x-c1)^2}; E0:= Es[i]; # c1 might be infinity. for j in N minus {i} do if points(Ps[j],x) <> 1 then next; fi; f1:= {seq(i/(Ps[j])^3,i=f)}; E_i:= {normal(Es[j]/3),normal((Es[j]-1)/3),normal((Es[j]+1)/3)} ; for k in N minus {i,j} do P:= Ps[k]; a1:= points(Ps[k],x); E1:= Es[k]; for k1 in N minus {i,j,k} while a1 <> 3 do if not(type(evala(Es[k1]- Es[k]),integer) or type(evala(Es[k1]+ Es[k]),integer)) then break; fi; P:= P*Ps[k1]; a1:= a1+points(Ps[k1],x); od; break; od; if a1 <> 3 then next; fi; f1:= {seq(`if`(max(degree(numer(h),x),degree(denom(h),x)) = 3, h, NULL),h=f1)}; for f2 in f1 do if degree(P,x) = 3 then eqns:= {coeffs(rem(evala(numer(1-f2)),P,x),x)}; else eqns:= {coeff(evala(numer(1-f2)),x,3)} union {coeffs(rem(evala(numer(1-f2)),P,x),x)}; fi; Sol:= {solve(eqns,{c,c1})}; if Sol = {} or Sol = {{}} then next; fi; for k2 in Sol do f3:= factor(evala(eval(f2,k2))); Fld_f:= indets(f3, {RootOf, radical}) union `if`(has(f3,I),{I},{}); if nops(Fld_f minus Fld) <> 0 then next; fi; # Now check that deg(f3) = 3, numer(f3) is not a cube and normal(numer(1-f3)/P) is a constant: if max(degree(numer(f3),x),degree(denom(f3),x)) <> 3 or has(factor(numer(1-f3)/P),x)then next; fi; sqr:= sqrfree(numer(f3),x)[2]; if nops(sqr) = 0 or (nops(sqr) = 1 and sqr[1][2] = 3) then next; fi; F:= F union {seq([factor(f3),[E0,E1,i1]],i1=E_i)}; od; od; od; od; F; end: # Case5: 3 rams. of order 2,2,3 with exponent difference <> */2 , <> */2 and <> */3 respectively. Case55:= proc(Fld,S) local a,c,s,i,i1,i2,i3,i4,j,e1,e2,F,f,f1,f2,f3,f4,h,Ps,Es,N,N1,N2,N3,N4,n,E0,E1,E_i,eqns,Sol,sqr,eqn,P,Fld_f; # option trace; # Let our 2F1 has exp. diff. [e0,e1,ei]. # Our f ramifies above 0,1 and infinity with order 2,2 and 3. # The situations 3,1,1, 2,2,1 and 2,1,1,1 don't appear for this case(There are no different points with same e above any {0,1,infinity}) # So, we must have all linear polys: 1,1,1,1,1 Case: s:= S; Ps:=[seq(i[1],i=s)]; Es:= [seq(i[2],i=s)]; N:= {seq(i,i=1..nops(s))}; n:= nops(N); for i in N do if points(Ps[i],x) <> 1 then return "not in Case5"; fi; od; # Let's check conditions on Es now: There must be at least two pairs from Es of the form e, 2*e: for i in N do if denom(Es[i]) = 2 then next; fi; N1:= {i}; e1:= Es[i]; for i1 in N minus {i} do if not(type(evala(Es[i1]-2*e1),integer) or type(evala(Es[i1]+2*e1),integer)) then next; fi; N2:= N1 union {i1}; for i2 in N minus {i,i1} do if denom(Es[i2]) = 2 then next; fi; N3:= {i2}; e2:= Es[i2]; for i3 in N minus {i,i1,i2} do if not(type(evala(Es[i3]-2*e2),integer) or type(evala(Es[i3]+2*e2),integer)) then next; fi; N4:= N3 union {i3}; if nops(N4) = 2 then break; fi; od; if nops(N4) = 2 then break; fi; od; if nops(N4) = 2 then break; fi; od; if nops(N4) = 2 then break; fi; od; if nops(N4) <> 2 then return "not in Case5"; fi; # Lets find candidate f's now. Lets set ramification of order 3 above 1: F:= {}; for i in N do if denom(Es[i]) = 2 then next; fi; f:= c*Ps[i]; for i1 in N minus {i} do if not(type(evala(Es[i1]-2*Es[i]),integer) or type(evala(Es[i1]+2*Es[i]),integer)) then next; fi; f1:= f*(Ps[i1])^2; for i2 in N minus {i,i1} do if denom(Es[i2]) = 2 then next; fi; f2:= f1/Ps[i2]; for i3 in N minus {i,i1,i2} do if not(type(evala(Es[i3]-2*Es[i2]),integer) or type(evala(Es[i3]+2*Es[i2]),integer)) then next; fi; f3:= f2/(Ps[i3])^2; h:= numer(evala(1-f3)); i4:= op(N minus {i,i1,i2,i3}); P:= Ps[i4]; E0:= Es[i]; E1:= {normal(Es[i4]/3),normal((Es[i4]+1)/3),normal((Es[i4]-1)/3)} ; E_i:= Es[i2]; if degree(P,x) = 1 then eqn:= rem(h,P,x) else eqn:= coeff(h,x,3); fi; Sol:= solve(eqn); if Sol = NULL then next; fi; f4:= factor(evala(eval(f3,c=Sol))); Fld_f:= indets(f4, {RootOf, radical}) union `if`(has(f4,I),{I},{}); if nops(Fld_f minus Fld) <> 0 then next; fi; # Now we check two things: i. f4 has degree 3. ii. numer(1-f4) is a cube: if max(degree(numer(f4),x),degree(denom(f4),x)) <> 3 then next; fi; sqr:= sqrfree(numer(1-f4),x)[2]; if nops(sqr) = 0 or (nops(sqr) = 1 and sqr[1][2] = 3) then F:= F union {seq([factor(f4),[E0,j,E_i]],j=E1)}; fi; od;od; od; od; F; end: # Ramifications of order 2,2,2 above the points with exp diffs <> */2, <> */2, */2 respectively: Case56:= proc(Fld,S) local a,c,i,i1,i2,i3,i4,e1,e2,f,f1,f2,f3,f4,h,s,F,N,N1,N2,N3,N4,n,Ps,Es,eqn,sqr,Sol,E0,E1,E_i,P,Fld_f; # option trace; # Let our 2F1 has exp. diff. [e0,e1,ei]. # Let, f ramifies above 0,1 and infinity with order 2,2 and 2 respectively,take 1/2 exp. diff. above 1. # Then for our case: E:=[e0,2*e0,e1,ei,2*ei]. # The situations 3,1,1, 2,2,1 and 2,1,1,1 don't appear for this case(There are no different points with same e above any {0,1,infinity}) # So, we must have all linear polys: 1,1,1,1,1 Case: s:= S; Ps:=[seq(i[1],i=s)]; Es:= [seq(i[2],i=s)]; N:= {seq(i,i=1..nops(s))}; n:= nops(N); for i in N do if points(Ps[i],x) <> 1 then return "not in Case6"; fi; od; # Let's check conditions on Es. At least one has to be 1/2 and rest two pairs have to be in the form e, 2*e: for i in N do if denom(Es[i]) = 2 and type(numer(Es[i]),integer) then N1:= {i}; if nops(N1) = 1 then break; fi; fi; od; if nops(N1) <> 1 then return "not in Case6"; fi; N2:= N minus N1; for i in N2 do if denom(Es[i]) = 2 then next; fi; N3:= {i}; e1:= Es[i]; for i1 in N2 minus {i} do if not(type(evala(Es[i1]-2*e1),integer) or type(evala(Es[i1]+2*e1),integer)) then next; fi; N3:= N3 union {i1}; for i2 in N2 minus {i1,i} do if denom(Es[i2]) = 2 then next; fi; N4:= {i2}; e2:= Es[i2]; for i3 in N2 minus {i1,i2,i} do if not(type(evala(Es[i3]-2*e2),integer) or type(evala(Es[i3]+2*e2),integer)) then break; fi; N4:= N4 union {i3}; break; od; if nops(N4) = 2 then break; fi; od; if nops(N4) = 2 then break; fi; od; if nops(N4) = 2 then break; fi; od; if nops(N4) <> 2 then return "not in Case6"; fi; # Let's find candidates for f now: Set */2 exp. diff. above 1: F:= {}; for i in N do if denom(Es[i]) = 2 then next; fi; f1:= c*Ps[i]; for i1 in N minus {i} do if not(type(evala(Es[i1]-2*Es[i]),integer) or type(evala(Es[i1]+2*Es[i]),integer)) then next; fi; f2:= f1*(Ps[i1])^2; for i2 in N minus {i1,i} do if denom(Es[i2]) = 2 then next; fi; f3:= f2/Ps[i2]; for i3 in N minus {i1,i2,i} do if not(type(evala(Es[i3]-2*Es[i2]),integer) or type(evala(Es[i3]+2*Es[i2]),integer)) then next; fi; f4:= f3/(Ps[i3])^2; i4:= op(N minus {i1,i2,i3,i}); P:= Ps[i4]; if denom(Es[i4]) <> 2 then break; fi; E0:= Es[i]; E1:= Es[i4]; E_i:= Es[i2]; h:= numer(evala(1-f4)); if degree(P,x) = 1 then eqn:= rem(h,P,x) else eqn:= coeff(h,x,3); fi; Sol:= solve(eqn); if Sol = NULL then next; fi; f:= factor(evala(eval(f4,c=Sol))); Fld_f:= indets(f, {RootOf, radical}) union `if`(has(f,I),{I},{}); if nops(Fld_f minus Fld) <> 0 then next; fi; # Now we check two things: i. degree(f) = 3. ii. numer(1-f)/P is a square: if max(degree(numer(f),x),degree(denom(f),x)) <> 3 then next; fi; sqr:= sqrfree(factor(numer(1-f)/P),x)[2]; if nops(sqr) = 0 or (nops(sqr) = 1 and sqr[1][2] = 2) then F:= F union {[factor(f),[E0,E1,E_i]]}; fi; od;od; od; od; F; end: # This program (cubic6to3) takes the singularity structure (set of lists of irreducible polys and their exp. differences) and returns the set of f's # of degree 3 which carries those 6 points to 3 points (0,1,infty). # We have the following 4 possibilities: # say S:= {0,1,infinity}. # 1 ramification of order 3 above S with exp diff */3 gives 6 singularities ----> Case1 # 2 rams. above S gives 6 singularities in the following cases: # of order 3,2 above the points with exponent difference <>*/3, <>*/2 respectively ----> Case2. # of order 2,2 above the points with exponent difference = */2, <>*/2 respectively ----> Case3. # 3 rams. above S give 6 singularities in the following cases: # of order 2,2,2 above the points with exp. diff. <>*/2 ----> Case4. cubic6to3:= proc(Fld,Ls) # Ls is a set of lists [pi,ei] where pi is an irreducible poly in x and ei its corresponding exponent difference. local b,i,H,Cases,Fs,Ls1,Ls2,Ls3,Mbs; # we are looking for the rational f which carries 6 points to 0,1,infinity. # So, we must have at least 2 irreducible polys and the polys may have at most degree 3. Ls1:= Ls; if nops(Ls1) < 2 or nops(Ls1) > 6 then return "wrong input"; fi; b:= add(points(t[1],x),t= Ls1); if b <> 6 then return "wrong input"; fi; Cases:= {Case61,Case62,Case63,Case64}; Fs:= {}; for i in Cases do H:= i(Fld,Ls1); if not(type(H,string)) then Fs:= Fs union H; fi; od; Fs; end: # 1 ramification of order 3 above a point with exp diff */3. Case61:= proc(Fld,S) local a1,a2,a3,a4,c,e1,e2,i,i1,i2,j,j1,k,k1,k2,n,N,N1,N2,N3,A1,f,f1,F,s,P,Ps,Es,c_val,sq,cand,E0,E1,E_i,Fld_f; # option trace; s:= S; Ps:=[seq(i[1],i=s)]; Es:= [seq(i[2],i=s)]; N:= {seq(i,i=1..nops(s))}; n:= nops(N); for i in N do if points(Ps[i],x)>3 then return "not in Case1"; fi; od; # Now, lets check the conditions on Es; two sets of Es must be equal mod Z: e1:= Es[N[1]]; a1:= points(Ps[N[1]],x); N1:= N minus {N[1]}; for j in N1 do if type(evala(Es[j]-e1),integer) or type(evala(Es[j]+e1),integer) then a1:= a1+points(Ps[j],x); N1:= N1 minus {j}; fi; od; if irem(a1,3) <> 0 then return "wrong input"; fi; if a1 = 3 then k:= N1[1]; e2:= Es[k]; a2:= points(Ps[k],x); for i in N1 minus {k} do if type(evala(Es[i]-e2),integer) or type(evala(Es[i]+e2),integer) then a2:= a2+points(Ps[i],x); else return "wrong input"; fi; od; fi; # Now let's compute f. Let's put the removable singularity at the numerator of 1-f: cand:= {}; N2:= {}; E1:= {1/3,2/3}; for i in N do a3:= points(Ps[i],x); N1 := {i}; E_i:= Es[i]; for j in N minus {i} while a3 <> 3 do if type(evala(Es[j]-Es[i]),integer) or type(evala(Es[j]+Es[i]),integer) then a3:= a3+points(Ps[j],x); N1:= N1 union {j}; fi; od; if a3 <> 3 then next; fi; N2:= N minus N1; P:= Ps[N2[1]]; a4:= points(Ps[N2[1]],x); E0:= Es[N2[1]]; for k in N2 minus {N2[1]} do if type(evala(Es[N2[1]]-Es[k]),integer) or type(evala(Es[N2[1]]+Es[k]),integer) then P:= P*Ps[k]; a4:= a4+points(Ps[k],x); else break; fi; od; if a4 <> 3 then next; fi; F:= {[c*P/mul(Ps[k1],k1=N1),E0,E_i], [c*mul(Ps[k1],k1=N1)/P,E_i,E0]}; for i1 in F do # Now recall that numer(1-F) must be a cube. c_val:= {solve(discrim(numer(1-i1[1]),x))}; if c_val = {} then next; fi; for k2 in c_val do f1:= eval(i1[1],c=k2); Fld_f:= indets(f1, {RootOf, radical}) union `if`(has(f1,I),{I},{}); if nops(Fld_f minus Fld) <> 0 then next; fi; sq:= sqrfree(numer(1-f1)); if max(degree(numer(f1),x),degree(denom(f1),x)) = 3 and (sq[2] = [] or sq[2][1][2] = 3) then cand:= cand union {seq([factor(f1),[i1[2], j1, i1[3]]],j1=E1)}; fi; od; od; od; cand; end: # 2 ramifications of order 2,3 above points with exp diff <> */2 and <> */3 resp: Case62:= proc(Fld,S) local a1,a2,b,c,e1,e2,i,i1,j,j1,k,k1,k2,n,f,fs,s,Ps,Es,n1,n2,n3,N,N1,N2,N3,N4,F,P,c_val,A,B,C,E0,E1,E_i,Fld_f; # option trace; s:= S; Ps:=[seq(i[1],i=s)]; Es:= [seq(i[2],i=s)]; N:= {seq(i,i=1..nops(s))}; n:= nops(N); n1:={}; n2:={}; n3:={}; for i in N do if points(Ps[i],x)=1 then n1:= n1 union {i}; elif points(Ps[i],x)=2 then n2:= n2 union {i}; elif points(Ps[i],x)=3 then n3:= n3 union {i}; else return "not in Case3"; fi; od; # In this case, we must have at least 3 linear polys: if nops(n1) < 3 then return "wrong input"; fi; # Now, lets check the conditions on Es; any 3 of Es must be equal mod Z and two of rest must be e,2*e: for i in N do a1:= points(Ps[i],x); e1:= Es[i]; N1:= {i}; if a1 = 3 then break; fi; for j in N minus {i} do if type(evala(Es[j]-e1),integer) or type(evala(Es[j]+e1),integer) then a1:= a1+points(Ps[j],x); N1:= N1 union {j}; fi; if a1 = 3 then break; fi; od; od; N2:= N minus N1; for i in N2 do if points(Ps[i],x) = 1 and denom(Es[i]) <> 2 then a2:= points(Ps[i],x); e2:= Es[i]; N3:= {i}; for j in N2 minus {i} do if points(Ps[j],x) = 1 and (type(evala(Es[j]- 2*e2),integer) or type(evala(Es[j]+ 2*e2),integer)) then a2:= a2+points(Ps[j],x); N3:= N3 union {j}; fi; if a2 = 2 then break; fi; od; if a2 = 2 then break; fi; fi; od; N4:= N2 minus N3; if nops(N4) <> 1 or points(Ps[N4[1]],x) <> 1 then return "wrong input"; fi; # Now compute f. Put ramification of order 3,2 above 0,infty resp: fs:= {}; for i in N do if points(Ps[i],x) <> 1 then next; fi; f:= c*(Ps[i])^3; E0:= {normal(Es[i]/3),normal((Es[i]-1)/3),normal((Es[i]+1)/3)}; for j in N minus {i} do if points(Ps[j],x) <> 1 or denom(Es[j]) = 2 then next; fi; for j1 in N minus {i,j} do if points(Ps[j1],x) = 1 and (type(evala(Es[j1]-2*Es[j]),integer) or type(evala(Es[j1]+2*Es[j]),integer)) then F:= f/Ps[j]/(Ps[j1])^2; E_i:= Es[j]; for k in N minus {i,j,j1} do P:= Ps[k]; b:= points(Ps[k],x); E1:= Es[k]; for k1 in N minus {i,j,j1,k} do if type(evala(Es[k1]- Es[k]),integer) or type(evala(Es[k1]+Es[k]),integer) then P:= P*Ps[k1]; b:= b+points(Ps[k1],x); else break; fi; od; if b <> 3 then next; fi; c_val:= {solve({coeffs(rem(numer(1-F),P,x),x)})}; if c_val = {} or c_val = {{}} then next; fi; for k2 in c_val do F:= eval(F,k2); Fld_f:= indets(F, {RootOf, radical}) union `if`(has(F,I),{I},{}); if nops(Fld_f minus Fld) <> 0 then next; fi; if max(degree(numer(F),x),degree(denom(F),x)) = 3 and not has(factor(numer(1-F)/P),x) then fs:= fs union {seq([factor(F),[i1,E1,E_i]],i1=E0)}; fi; od; od;fi;od;od;od; fs; end: # 2 ramifications of order 2,2 above the points with exponent difference = */2, <>*/2 resp Case63:= proc(Fld,S) local a1,b,c,i,j,j1,k,k1,k2,n,f,fs,s,n1,n2,n3,Ps,Es,e1,e2,E3,N,N1,N2,N3,N4,F,P,P1,c_val,A,B,C,E0,E1,E_i,Fld_f; # option trace; s:= S; Ps:=[seq(i[1],i=s)]; Es:= [seq(i[2],i=s)]; N:= {seq(i,i=1..nops(s))}; n:= nops(N); n1:={}; n2:={}; n3:={}; for i in N do if points(Ps[i],x)=1 then n1:= n1 union {i}; elif points(Ps[i],x)=2 then n2:= n2 union {i}; elif points(Ps[i],x)=3 then n3:= n3 union {i}; else return "not in Case3"; fi; od; # In this case, we must have at least 3 linear polys: if nops(n1) < 3 then return "wrong input"; fi; # Now, lets check the conditions on Es; i.3 of Es must be equal mod Z ii.two of rest must be e,2*e iii. the last one must be int/2: for i in N do if points(Ps[i],x) = 1 and (denom(Es[i])=2 and type(numer(Es[i]),integer)) then e1:=Es[i]; N1:= {i}; if nops(N1) = 1 then break; fi; fi; od; if nops(N1) <> 1 then return "wrong input"; fi; for i in N minus N1 do a1:= points(Ps[i],x); e2:= Es[i]; N2:= {i}; if a1 = 3 then break; fi; for j in N minus (N1 union {i}) do if type(evala(Es[j]-e2),integer) or type(evala(Es[j]+e2),integer) then a1:= a1+points(Ps[j],x); N2:= N2 union {j}; fi; if a1 = 3 then break; fi; od; od; if a1 <> 3 then return "wrong input"; fi; N3:= N minus (N1 union N2); if nops(N3) <> 2 then return "wrong input"; fi; for i in N3 do if points(Ps[i],x) = 1 and denom(Es[i]) <> 2 then E3:= Es[i]; N4:= {i}; for j in N3 minus {i} do if points(Ps[j],x) = 1 and (type(evala(Es[j]-2*E3),integer) or type(evala(Es[j]+2*E3),integer)) then N4:= N4 union {j}; fi; od; if nops(N4) = 2 then break; fi; fi;od; if nops(N4) <> 2 then return "wrong input"; fi; # Now compute f: Let ramifications be above 0 and 1. Set exp diff */2 above 1 and <> */2 above 0: fs:= {}; for i in N do if points(Ps[i],x) = 1 and (denom(Es[i])=2 and type(numer(Es[i]),integer)) then P:= Ps[i]; E1:= Es[i]; for j in N minus {i} do if points(Ps[j],x) = 1 and denom(Es[j]) <> 2 then for j1 in N minus {i,j} do if points(Ps[j1],x) = 1 and (type(evala(Es[j1]-2*Es[j]),integer) or type(evala(Es[j1]+2*Es[j]),integer)) then f:= c*Ps[j]*(Ps[j1])^2; E0:= Es[j]; for k in N minus {i,j,j1} do P1:= Ps[k]; b:= points(Ps[k],x); E_i:= Es[k]; for k1 in N minus {i,j,j1,k} do if type(evala(Es[k1]- Es[k]),integer) or type(evala(Es[k1]+Es[k]),integer) then P1:= P1*Ps[k1]; b:= b+points(Ps[k1],x); fi; od; if b <> 3 then next; fi; F:= f/P1; if P = 1 then c_val:= {c=solve(coeff(numer(1-F),x,3))}; else c_val:= {solve({coeffs(rem(numer(1-F),P,x),x)})}; fi; if c_val = {} or c_val = {{}} then next; fi; for k2 in c_val do F:= eval(F,k2); Fld_f:= indets(F, {RootOf, radical}) union `if`(has(F,I),{I},{}); if nops(Fld_f minus Fld) <> 0 then next; fi; if max(degree(numer(F),x),degree(denom(F),x)) = 3 and discrim(factor(numer(1-F)/P),x) = 0 then fs:= fs union {[factor(F),[E0,E1,E_i]]}; fi; od; od;fi;od;fi;od; fi;od; fs; end: # 3 ramifications of order 2,2,2 above the points with exp. diff. <>*/2: Case64:= proc(Fld,S) local c,i,i1,j,j1,k,k1,k2,f,f1,f2,f3,fs,p1,n,s,e1,e2,E3,E4,N,N1,N2,N3,P,P1,Ps,Es,cand,c_val,A,B,C,E0,E1,E_i,Fld_f; # option trace; s:= S; Ps:=[seq(i[1],i=s)]; Es:= [seq(i[2],i=s)]; N:= {seq(i,i=1..nops(s))}; n:= nops(N); # In this case each irred. factor must be linear: p1:={}; for i in N do if points(Ps[i],x)=1 then p1:= p1 union {i}; else return "not in Case4"; fi;od; # Now, lets check the conditions on Es; There must be 3 sets of the form e,2*e : for i in N do if denom(Es[i]) <> 2 then e1:= Es[i]; for i1 in N minus {i} do if type(evala(Es[i1]-2*e1),integer) or type(evala(Es[i1]+2*e1),integer) then N1:= N minus {i,i1}; for j in N1 do if denom(Es[j]) <> 2 then e2:= Es[j]; for j1 in N1 minus {j} do if type(evala(Es[j1]-2*e2),integer) or type(evala(Es[j1]+2*e2),integer) then N2:= N1 minus {j,j1}; E3:= Es[N2[1]]; E4:= Es[N2[2]]; if denom(E4) <> 2 then if type(evala(E3-2*E4),integer) or type(evala(E3+2*E4),integer) then N3:= 0; fi; fi; break; fi; od; fi;if N3 = 0 then break; fi; od; fi; if N3=0 then break; fi; od; fi; if N3 = 0 then break; fi; od; if N3 <> 0 then return "wrong input"; fi; # Now compute f: fs:= {}; for i in N do if denom(Es[i]) = 2 then next; fi; f:= c*Ps[i]; E0:= Es[i]; for i1 in N minus {i} do if type(evala(Es[i1]-2*Es[i]),integer) or type(evala(Es[i1]+2*Es[i]),integer) then f1:= f* (Ps[i1])^2; for j in N minus {i,i1} do if denom(Es[j]) = 2 then next; fi; f2:= f1/Ps[j]; E_i:= Es[j]; for j1 in N minus {i,i1,j} do if type(evala(Es[j1]-2*Es[j]),integer) or type(evala(Es[j1]+2*Es[j]),integer) then f3:= f2/(Ps[j1])^2; for k in N minus {i,i1,j,j1} do if denom(Es[k]) = 2 then next; fi; P:= Ps[k]; E1:= Es[k]; for k1 in N minus {i,i1,j,j1,k} do if type(evala(Es[k1]- 2*Es[k]),integer) or type(evala(Es[k1]+2*Es[k]),integer) then P1:= P*(Ps[k1])^2; c_val:= {solve({coeffs(rem(numer(1-f3),P1,x),x)})}; if c_val = {} or c_val = {{}} then next; fi; for k2 in c_val do cand:= eval(f3,k2); Fld_f:= indets(cand, {RootOf, radical}) union `if`(has(cand,I),{I},{}); if nops(Fld_f minus Fld) <> 0 then next; fi; if max(degree(numer(cand),x),degree(denom(cand),x)) = 3 and not(has(factor(numer(1-cand)/P1),x)) then fs:= fs union {[factor(cand),[E0,E1,E_i]]}; fi; od; fi; od; od; fi;od;od;fi;od;od; fs; end: # This program (cubic7to3) takes the singularity structure (set of lists of irreducible polys and their exp. differences) and returns the set of f's # of degree 3 which carries those 7 points to 3 points (0,1,infty). # We have the following 3 possibilities: # say S:= {0,1,infinity}. # 1 ramification above S gives 7 singularities in the following cases: # of order 3 above a point with exp diff <>*/3 ----> Case1 # of order 2 above a point with exp diff */2 ----> Case2 # 2 rams. of order 2 above points with exp diff <> */2 ----> Case3 cubic7to3:= proc(Fld,Ls) # Ls is a set of lists [pi,ei] where pi is an irreducible poly in x and ei its corresponding exponent difference. local b,i,H,Cases,Fs,Ls1,Ls2,Ls3,Mbs; # we are looking for the rational f which carries 7 points to 0,1,infinity. # So, we must have at least 3 irreducible polys and the polys may have at most degree 3. Ls1:= Ls; if nops(Ls1) < 3 or nops(Ls1) > 7 then return "wrong input"; fi; b:= add(points(t[1],x),t= Ls1); if b <> 7 then return "wrong input"; fi; Cases:= {Case71,Case72,Case73}; Fs:= {}; for i in Cases do H:= i(Fld,Ls1); if not(type(H,string)) then Fs:= Fs union H; fi; od; Fs; end: # This case computes the degree 3 rational map which produces 7 reg singularities above 0,1,infty. # f ramifies of order 3 (let above 0 with exp diff <> */3). Case71:= proc(Fld,S) local a,a1,a2,a3,as,c,es,A1,A2,B1,B2,B3,C1,C2,C3,e1,e2,s,n,i,i1,j,j1,j2,k,k1,f,F,fs,Ps,Es,N,N1,N2,Ms,Ns,Bs,Cs,P,c_val,cand,E0,E1,E_i,Fld_f; # option trace; s:= S; Ps:=[seq(i[1],i=s)]; Es:= [seq(i[2],i=s)]; N:= {seq(i,i=1..nops(s))}; n:= nops(N); for i in N do if points(Ps[i],x)>3 then return "not in Case1"; fi; od; # Now, lets check the conditions on Es; two sets of Es must be equal mod Z: for i in N do e1:= Es[i]; A1:= points(Ps[i],x); N1:= N minus {i}; for i1 in N1 do if type(evala(Es[i1]-e1),integer) or type(evala(Es[i1]+e1),integer) then A1:= A1+points(Ps[i1],x); N1:= N1 minus {i1}; fi; od; if A1 > 1 then break; fi; od; if {A1} intersect {3,4,6,7} = {} then return "wrong input"; fi; if nops(N1) <> 1 then for i in N1 do e2:= Es[i]; A2:= points(Ps[i],x); N2:= N1 minus {i}; for i1 in N2 do if type(evala(Es[i1]-e2),integer) or type(evala(Es[i1]+e2),integer) then A2:= A2+points(Ps[i1],x); N2:= N2 minus {i1}; fi; od; if A2 > 1 then break; fi; od; else A2:= points(Ps[N1[1]],x); fi; if A1 < 5 and {A2} intersect {3,4} = {} then return "wrong input"; fi; # Compute f now: Take order 3 ramification above 0: fs:= {}; cand:= {}; Ms:= {}; for i in N do if points(Ps[i],x) <> 1 then next; fi; Ns:= {i}; for j in N minus {i} do a1:= points(Ps[j],x); B1:= {j}; C1:= N minus (B1 union {i}); if a1 = 3 then Ms:= Ms union {[Ns,B1,C1]}; else for j1 in C1 do if type(evala(Es[j1]-Es[j]),integer) or type(evala(Es[j1]+Es[j]),integer) then a2:= a1+points(Ps[j1],x); B2:= B1 union {j1}; C2:= C1 minus {j1}; if a2 = 3 then Ms:= Ms union {[Ns,B2,C2]}; else for j2 in C2 do if type(evala(Es[j2]-Es[j]),integer) or type(evala(Es[j2]+Es[j]),integer) then a3:= a2+points(Ps[j2],x); B3:= B2 union {j2}; C3:= C2 minus {j2}; fi; if a3 = 3 then Ms:= Ms union {[Ns,B3,C3]}; fi; od; fi; fi;od; fi; od; od; for i in Ms do Bs:= i[2]; Cs:= i[3]; es:= Es[Cs[1]]; as:= points(Ps[Cs[1]],x); for j in Cs minus {Cs[1]} do if type(evala(Es[j]-es),integer) or type(evala(Es[j]+es),integer) then as:= as + points(Ps[j],x); else break; fi; od; if as = 3 then F:= c*(Ps[op(i[1])])^3/mul(Ps[k],k= Bs); P:= mul(Ps[k],k=Cs); E0:= {normal(Es[op(i[1])]/3),normal((Es[op(i[1])]-1)/3),normal((Es[op(i[1])]+1)/3)}; E_i:= Es[Bs[1]]; E1:= Es[Cs[1]]; c_val:= {solve({coeffs(rem(numer(1-F),P,x),x)})}; if c_val = {} or c_val = {{}} then next; fi; for j in c_val do F:= eval(F,j); Fld_f:= indets(F, {RootOf, radical}) union `if`(has(F,I),{I},{}); if nops(Fld_f minus Fld) <> 0 then next; fi; if max(degree(numer(F),x),degree(denom(F),x)) = 3 and not has(factor(numer(1-F)/P),x) then cand:= cand union {seq([factor(F),[k1,E1,E_i]],k1=E0)};fi;od; fi; od; cand; end: # This case computes the degree 3 rational map which produces 7 reg singularities above 0,1,infty. # f ramifies of order 2 above a point with exp diff */2. Case72:= proc(Fld,S) local a,a1,a2,a3,as,es,c,d,s,i,i1,j,j1,j2,k,k1,n,A0,A1,A2,B1,B2,B3,C1,C2,C3,e1,E2,E3,F,F1,N,N1,N2,P,Bs,Cs,Es,Ms,Ns,Ps,c_val,cand,sqr,E0,E1,E_i,Fld_f; # option trace; s:= S; Ps:=[seq(i[1],i=s)]; Es:= [seq(i[2],i=s)]; N:= {seq(i,i=1..nops(s))}; n:= nops(N); for i in N do if points(Ps[i],x)>3 then return "not in Case2"; fi; od; # Now, lets check the conditions on Es; two sets of Es must be equal mod Z and the last one */2: for i in N do if points(Ps[i],x) = 1 and denom(Es[i]) = 2 then e1:= Es[i]; A0:= points(Ps[i],x); N1:= N minus {i}; if A0 = 1 then break; fi; fi; od; if A0 <> 1 then return "wrong input"; fi; E2:= Es[N1[1]]; A1:=points(Ps[N1[1]],x); N2:= N1 minus {N1[1]}; for j in N2 do if type(evala(E2-Es[j]),integer) or type(evala(E2+Es[j]),integer) then A1:= A1 + points(Ps[j],x); N2:= N2 minus {j}; fi; od; if irem(A1,3) <> 0 then return "wrong input"; fi; if A1 = 3 then E3:= Es[N2[1]]; A2:= points(Ps[N2[1]],x); for k in N2 minus {N2[1]} do if type(evala(E3-Es[k]),integer) or type(evala(E3+Es[k]),integer) then A2:= A2+points(Ps[k],x); else return "wrong input" fi; od; fi; # Now compute f. Set order 2 ramification above 1: Ms:= {}; cand:= {}; for i in N do if points(Ps[i],x) <> 1 or denom(Es[i]) <> 2 then next; fi; Ns:= {i}; for j in N minus {i} do a1:= points(Ps[j],x); B1:= {j}; C1:= N minus (B1 union {i}); if a1 = 3 then Ms:= Ms union {[Ns,B1,C1,Es[i]]}; else for j1 in C1 do if type(evala(Es[j1]-Es[j]),integer) or type(evala(Es[j1]+Es[j]),integer) then a2:= a1+points(Ps[j1],x); B2:= B1 union {j1}; C2:= C1 minus {j1}; if a2 = 3 then Ms:= Ms union {[Ns,B2,C2,Es[i]]}; else for j2 in C2 do if type(evala(Es[j2]-Es[j]),integer) or type(evala(Es[j2]+Es[j]),integer) then a3:= a2+points(Ps[j2],x); B3:= B2 union {j2}; C3:= C2 minus {j2}; fi; if a3 = 3 then Ms:= Ms union {[Ns,B3,C3,Es[i]]}; fi; od; fi; fi;od; fi; od; od; for i in Ms do P:= Ps[op(i[1])]; Bs:= i[2]; Cs:= i[3]; es:= Es[Cs[1]]; as:= points(Ps[Cs[1]],x); for j in Cs minus {Cs[1]} do if type(evala(Es[j]-es),integer) or type(evala(Es[j]+es),integer) then as:= as + points(Ps[j],x); else break; fi; od; if as = 3 then F:= c* mul(Ps[k],k=Cs)/mul(Ps[k],k= Bs); E0:= Es[Cs[1]]; E_i:= Es[Bs[1]]; E1:= i[4]; if P <> 1 then c_val:= {solve({coeffs(rem(numer(1-F),P,x),x)})}; else c_val:= {solve({discrim(numer(1-F),x)})}; fi; if c_val = {} or c_val = {{}} then next; fi; for k1 in c_val do F1:= eval(F,k1); Fld_f:= indets(F1, {RootOf, radical}) union `if`(has(F1,I),{I},{}); if nops(Fld_f minus Fld) <> 0 then next; fi; if max(degree(numer(F1),x),degree(denom(F1),x)) <> 3 then next; fi; # Now check that numer(1-F1) is not a cube: sqr:= sqrfree(numer(1-F1))[2]; if nops(sqr) = 0 or (nops(sqr) = 1 and sqr[1][2] = 3) then next; fi; d:= discrim(normal(numer(1-F1)/P),x); if d = 0 then if P <> 1 then cand:= cand union {[factor(F1),[E0,E1,Ei]]}; else if degree(factor(numer(1-F1)/P),x) = 2 then cand:= cand union {[factor(F1),[E0,E1,E_i]]}; fi; fi; fi; od; fi; od; cand; end: # This case computes the degree 3 rational map which produces 7 reg singularities above 0,1,infty. # f ramifies of order 2 (let above 0,infty with exp diff <>*/2). Case73:= proc(Fld,S) local a,c,f,f1,f2,f3,fs,F,i,i1,j,j1,k,k1,k2,n,n1,n2,n3,s,A1,e1,E2,E3,e3,N,N1,N2,N3,N4,N5,P,Ps,Es,c_val,cand,E0,E1,E_i,Fld_f; # option trace; s:= S; Ps:=[seq(i[1],i=s)]; Es:= [seq(i[2],i=s)]; N:= {seq(i,i=1..nops(s))}; n:= nops(N); n1:={}; n2:={}; n3:={}; for i in N do if points(Ps[i],x)=1 then n1:= n1 union {i}; elif points(Ps[i],x)=2 then n2:= n2 union {i}; elif points(Ps[i],x)=3 then n3:= n3 union {i}; else return "not in Case3"; fi; od; # In this case, we need at least 4 linear factors: if nops(n1) < 4 then return "not in case 3"; fi; # Now, lets check the conditions on Es; two pairs of Es must be e,2*e and the rest 3 must be equal mod Z: for i in N do if points(Ps[i],x) = 1 and denom(Es[i]) <> 2 then e1:= Es[i]; N1:= N minus {i}; for i1 in N1 do if points(Ps[i1],x) = 1 and (type(evala(Es[i1]-2*e1),integer) or type(evala(Es[i1]+2*e1),integer)) then N1:= N1 minus {i1}; for j in N1 do if points(Ps[j],x) = 1 and denom(Es[j]) <> 2 then E2:= Es[j]; N2:= N1 minus {j}; for j1 in N2 do if points(Ps[j1],x) = 1 and (type(evala(Es[j1]-2*E2),integer) or type(evala(Es[j1]+2*E2),integer)) then N2:= N2 minus {j1}; for k in N2 do E3:= Es[k]; A1:= points(Ps[k],x); N3:= N2 minus {k}; if N3 = {} then break; else for k1 in N3 do if type(evala(Es[k1]-E3),integer) or type(evala(Es[k1]+E3),integer) then A1:= A1+points(Ps[k1],x); N3:= N3 minus {k1}; else break; fi; od; fi; if N3 = {} then break; fi; od; if N3 = {} then break; fi; fi; od; if N3 = {} then break; fi; fi; od; if N3 = {} then break; fi; fi; od; if N3 = {} then break; fi; fi; od; if A1 <> 3 or N3 <> {} then return "wrong input"; fi; # Compute f now: fs:= {}; cand:= {}; for i in N do if points(Ps[i],x) = 1 and denom(Es[i]) <> 2 then N1:= N minus {i}; f1:= c*Ps[i]; E0:= Es[i]; for i1 in N1 do if points(Ps[i1],x) = 1 and (type(evala(Es[i1]-2*E0),integer) or type(evala(Es[i1]+2*E0),integer)) then N2:= N1 minus {i1}; f2:= f1*(Ps[i1])^2; for j in N2 do if points(Ps[j],x) = 1 and denom(Es[j]) <> 2 then N3:= N2 minus {j}; f3:= f2/Ps[j]; E_i:= Es[j]; for j1 in N3 do if points(Ps[j1],x) = 1 and (type(evala(Es[j1]-2*E_i),integer) or type(evala(Es[j1]+2*E_i),integer)) then N4:= N3 minus {j1}; f:= f3/(Ps[j1])^2; e3:= Es[N4[1]]; P:= Ps[N4[1]]; N5:= N4 minus {N4[1]}; E1:= e3; for k in N5 do if type(evala(Es[k]-e3),integer) or type(evala(Es[k]+e3),integer) then P:= P*Ps[k]; N5:= N5 minus {k}; else break; fi; od; if N5 = {} and add(points(Ps[k1],x),k1=N4) = 3 then c_val:= {solve({coeffs(rem(numer(1-f),P,x),x)})}; if c_val = {} or c_val = {{}} then next; fi; for k2 in c_val do F:= eval(f,k2); Fld_f:= indets(F, {RootOf, radical}) union `if`(has(F,I),{I},{}); if nops(Fld_f minus Fld) <> 0 then next; fi; if max(degree(numer(F),x),degree(denom(F),x)) = 3 then fs:= fs union {[factor(F),[E0,E1,E_i]]}; fi; od; fi; fi; od; fi; od; fi; od; fi; od; fs; end: # This program (cubic8to3) takes the singularity structure (set of lists of irreducible polys and their exp. differences) and returns the set of f's # of degree 3 which carries those 8 points to 3 points (0,1,infty). # We have the following 1 possibility: # say S:= {0,1,infinity}. # 1 ramification above S gives 8 singularities in the following cases: # of order 2 above a point with exp diff <>*/2 (Let the point be 0). cubic8to3:= proc(Fld,S) # Ls is a set of lists [pi,ei] where pi is an irreducible poly in x and ei its corresponding exponent difference. local a1,a2,a3,a4,as,b,c,f1,f2,F,es,fs,i,i1,j,j1,j2,k,n,s,B1,B2,B3,Bs,C1,C2,C3,Cs,E,Ms,Ns,N,N1,N2,N3,N4,N5,P,Es,Ps,cand,c_val,E0,E1,E_i,Fld_f; # we are looking for the rational f which carries 8 points to 0,1,infinity. # So, we must have at least 3 irreducible polys and the polys may have at most degree 3. s:= S; if nops(s) < 3 or nops(s) > 8 then return "wrong input"; fi; b:= add(points(t[1],x),t= s); if b <> 8 then return "wrong input"; fi; Ps:=[seq(i[1],i=s)]; Es:= [seq(i[2],i=s)]; N:= {seq(i,i=1..nops(s))}; n:= nops(N); # Now, lets check the conditions on Es; two sets of 3 Es must be equal mod Z and the last pair must be one e,2*e: for i in N do if points(Ps[i],x) = 1 and denom(Es[i]) <> 2 then N1:= N minus {i}; for i1 in N1 do if points(Ps[i1],x) = 1 and (type(evala(Es[i1]-2*Es[i]),integer) or type(evala(Es[i1]+2*Es[i]),integer)) then N2:= N1 minus {i1}; for j in N2 do a1:= points(Ps[j],x); N3:= N2 minus {j}; if a1 = 3 then Ns:= N3; else for j1 in N2 do if type(evala(Es[j1]-Es[j]),integer) or type(evala(Es[j1]+Es[j]),integer) then a1:= a1+points(Ps[j1],x); N4:= N3 minus {j1}; if a1 = 3 then Ns:= N4; else for j2 in N4 do if type(evala(Es[j2]-Es[j]),integer) or type(evala(Es[j2]+Es[j]),integer) then a1:= a1+points(Ps[j2],x); N5:= N4 minus {j2}; if a1 = 3 then Ns:= N5; fi; break; fi; od; fi; if a1 = 3 then break; fi; fi; od; fi; if a1 = 3 then E:= Es[Ns[1]]; a4:= points(Ps[Ns[1]],x); for k in Ns minus {Ns[1]} do if type(evala(Es[k]-E),integer) or type(evala(Es[k]+E),integer) then a4:= a4+points(Ps[k],x); else break; fi; od; if a4 = 3 then break; fi;fi; od; fi; if a4 = 3 then break; fi; od; fi; if a4 = 3 then break; fi; od; if a4 <> 3 then return "wrong input"; fi; # Compute f now. Put ramification of order 2 above 0: cand:= {}; Ms:= {}; for i in N do if points(Ps[i],x) = 1 and denom(Es[i]) <> 2 then f1:= c*Ps[i]; for i1 in N minus {i} do if points(Ps[i1],x) = 1 and (type(evala(Es[i1]-2*Es[i]),integer) or type(evala(Es[i1]+2*Es[i]),integer)) then f2:= f1*(Ps[i1])^2; for j in N minus {i,i1} do a1:= points(Ps[j],x); B1:= {j}; C1:= N minus {i,i1,j}; if a1 = 3 then Ms:= Ms union {[f2,B1,C1,Es[i]]}; else for j1 in C1 do if type(evala(Es[j1]-Es[j]),integer) or type(evala(Es[j1]+Es[j]),integer) then a2:= a1+points(Ps[j1],x); B2:= B1 union {j1}; C2:= C1 minus {j1}; if a2 = 3 then Ms:= Ms union {[f2,B2,C2,Es[i]]}; else for j2 in C2 do if type(evala(Es[j2]-Es[j]),integer) or type(evala(Es[j2]+Es[j]),integer) then a3:= a2+points(Ps[j2],x); B3:= B2 union {j2}; C3:= C2 minus {j2}; fi; if a3 = 3 then Ms:= Ms union {[f2,B3,C3,Es[i]]}; fi; od; fi; fi;od; fi; od; fi; od; fi; od; Ms; for i in Ms do fs:= i[1]; Bs:= i[2]; Cs:= i[3]; es:= Es[Cs[1]]; as:= points(Ps[Cs[1]],x); for j in Cs minus {Cs[1]} do if type(evala(Es[j]-es),integer) or type(evala(Es[j]+es),integer) then as:= as + points(Ps[j],x); else break; fi; od; if as = 3 then F:= fs/mul(Ps[k],k= Bs); P:= mul(Ps[k],k=Cs); E_i:= Es[Bs[1]]; E1:= Es[Cs[1]]; E0:= i[4]; c_val:= {solve({coeffs(rem(numer(1-F),P,x),x)})}; if c_val = {} and c_val = {{}} then next; fi; for k in c_val do F:= eval(F,k); Fld_f:= indets(F, {RootOf, radical}) union `if`(has(F,I),{I},{}); if nops(Fld_f minus Fld) <> 0 then next; fi; if max(degree(numer(F),x),degree(denom(F),x)) = 3 and not has(factor(numer(1-F)/P),x) then cand:= cand union {[factor(F),[E0,E1,E_i]]};fi;od; fi; od; cand; end: # This program (cubic9to3) takes the singularity structure (set of lists of irreducible polys and their exp. differences) and returns the set of f's # of degree 3 which carries those 9 points to 3 points (0,1,infty). # We have the following 1 possibility: # say S:= {0,1,infinity}. # no ramification above S gives 9 singularities: cubic9to3:= proc(Fld,S) # Ls is a set of lists [pi,ei] where pi is an irreducible poly in x and ei its corresponding exponent difference. local a1,a2,b,c,e1,e2,s,f,i,i1,i2,j,k,k1,k2,n,A1,A2,A3,As,B1,B2,C1,C2,F,N,N1,N2,N3,P,E4,E2,E3,Es,Ps,list1,list2,cand,c_val,E0,E1,E_i,Fld_f; # we are looking for the rational f which carries 9 points to 0,1,infinity. # So, we must have at least 3 irreducible polys and the polys may have at most degree 3. s:= S; if nops(s) < 3 or nops(s) > 9 then return "wrong input"; fi; b:= add(points(t[1],x),t= s); if b <> 9 then return "wrong input"; fi; Ps:=[seq(i[1],i=s)]; Es:= [seq(i[2],i=s)]; N:= {seq(i,i=1..nops(s))}; n:= nops(N); # Now, lets check the conditions on Es; 3 sets of Es must be equal mod Z: E4:= Es[N[1]]; A1:= points(Ps[N[1]],x); N1:= N minus {N[1]}; for i1 in N1 do if type(evala(Es[i1]-E4),integer) or type(evala(Es[i1]+E4),integer) then A1:= A1+points(Ps[i1],x); N1:= N1 minus {i1}; fi; od; if irem(A1,3) <> 0 then return "wrong input"; fi; if nops(N1) <> 0 then E2:= Es[N1[1]]; A2:= points(Ps[N1[1]],x); N2:= N1 minus {N1[1]}; for i1 in N2 do if type(evala(Es[i1]-E2),integer) or type(evala(Es[i1]+E2),integer) then A2:= A2+points(Ps[i1],x); N2:= N2 minus {i1}; fi; od; if irem(A2,3) <> 0 then return "wrong input" fi; fi; if nops(N2) <> 0 then E3:= Es[N2[1]]; A3:= points(Ps[N2[1]],x); N3:= N2 minus {N2[1]}; for i1 in N3 do if type(evala(Es[i1]-E3),integer) or type(evala(Es[i1]+E3),integer) then A3:= A3+points(Ps[i1],x); N3:= N3 minus {i1}; fi; od; if irem(A3,3) <> 0 then return "wrong input"; fi; fi; # Compute f now: list1:= {}; list2:= {}; cand:= {}; for i in N do e1:= Es[i]; B1:= {i}; C1:= N minus B1; a1:= add(points(Ps[k],x),k=B1); if a1 = 3 then list1:= list1 union {[B1,C1]}; else for i1 in N minus {i} do if type(evala(Es[i1]-e1),integer) or type(evala(Es[i1]+e1),integer) then B1:= {i,i1}; C1:= N minus B1; a1:= add(points(Ps[k],x),k=B1); if a1 = 3 then list1:= list1 union {[B1,C1]}; else for i2 in N minus {i,i1} do if type(evala(Es[i2]-e1),integer) or type(evala(Es[i2]+e1),integer) then B1:= {i,i1,i2}; C1:= N minus B1; a1:= add(points(Ps[k],x),k=B1); fi; if a1 = 3 then list1:= list1 union {[B1,C1]}; fi; od; fi; fi; od; fi; for j in list1 do As:= j[1]; N1:= j[2]; for i in N1 do e2:= Es[i]; B2:= {i}; C2:= N1 minus B2; a2:= add(points(Ps[k],x),k=B2); if a2 = 3 then list2:= list2 union {[As,B2,C2]}; else for i1 in N1 minus {i} do if type(evala(Es[i1]-e2),integer) or type(evala(Es[i1]+e2),integer) then B2:= {i,i1}; C2:= N1 minus B2; a2:= add(points(Ps[k],x),k=B2); if a2 = 3 then list2:= list2 union {[As,B2,C2]}; else for i2 in N1 minus {i,i1} do if type(evala(Es[i2]-e2),integer) or type(evala(Es[i2]+e2),integer) then B2:= {i,i1,i2}; C2:= N1 minus B2; a2:= add(points(Ps[k],x),k=B2); fi; if a2 = 3 then list2:= list2 union {[As,B2,C2]}; fi; od; fi; fi; od; fi; od; od; od; for k in list2 do f:= c*mul(Ps[k],k=k[1])/mul(Ps[k],k= k[2]); P:= mul(Ps[k1],k1=k[3]); E0:= Es[k[1][1]]; E1:= Es[k[3][1]]; E_i:= Es[k[2][1]]; c_val:= {solve({coeffs(rem(numer(1-f),P,x),x)})}; if c_val <> {} and c_val <> {{}} then for k2 in c_val do F:= eval(f,c=rhs(op(k2))); Fld_f:= indets(F, {RootOf, radical}) union `if`(has(F,I),{I},{}); if nops(Fld_f minus Fld) <> 0 then next; fi; if max(degree(numer(F),x),degree(denom(F),x)) = 3 and not has(factor(numer(1-F)/P),x) then cand:= cand union {[factor(F),[E0,E1,E_i]]};fi;od; fi; od; cand; end: points:= proc(P,x) # P is an irreducible poly in x. if P = 1 then 1; else degree(P,x); fi; end: printsing:=proc(L, B::set) # Here, L is a second order differential operator and B is the base field or some specified field. #global Dx, x; local S, sing, i,j,Field_L, B1, true_sing,v; if nargs = 1 then Field_L:= indets([L], {RootOf,radical}) union `if`(has(L,I),{I},{}); return procname(args,Field_L); fi; B1:= B; S := lcoeff(primpart(L,Dx),Dx); S := gcd(S, lcoeff(primpart(LCLM(L, Dx) ,Dx),Dx) ); sing := factors(S, B1)[2]; sing:=[seq(i[1], i=sing), infinity]; true_sing:=NULL; for i in sing do j := `if`(i=infinity, i, RootOf(i,x)); v := gen_exp(L,T,x = j ); if nops(v)=2 or v[1][1]=v[1][2] or (not type(v[1][1]-v[1][2], integer)) or formal_sol(L,`has logarithm?`,x=j) then true_sing := true_sing, [i, `if`(nops(v)=1, v[1][2]-v[1][1], v[2][1]-v[1][1]) ] fi; od; {true_sing} end: transfo:=proc(L,a) #option trace; local i,f; #global x,Dx; f:=add(mult( subs(x=a,coeff(L,Dx,i)),(1/diff(a,x) * Dx)$i),i=0..degree(L,Dx)); sort(collect(f/lcoeff(f,Dx),Dx,factor),Dx) end: # Example to show the syntax: # # _Envdiffopdomain := [Dx,x]: # (see help page of DEtools[mult] for this) # # L1 := x^2*Dx^2-4*x^6+4*x^4-3/4; # L2 := Dx^2 + 2-10*x+4*x^2-4*x^4; # equiv(L1,L2); # --> Gives the map from the solution space of L1 to the solution space # of L2, showing effectively that solving L1 is equivalent to solving L2. # To get the inverse map, call equiv(L2,L1). # Checks if M2 can be solved in terms of M1, and if so, finds the map. equiv:=proc(M1,M2,d) local DF,x,T1,L1,T2,L2,C0,D0,S,C1,D1,dd,v,v1; if nargs>2 then if type(d,list(name)) and nops(d)=2 then _Envdiffopdomain:=d elif type(d,function) then _Envdiffopdomain:=[DF,x]; return `DEtools/diffop2de`(procname(seq( `DEtools/de2diffop`(args[i],d),i=1..2)),d) else error "wrong number or type of arguments" fi elif not assigned(_Envdiffopdomain) then error "domain is not assigned" fi; DF,x := op(_Envdiffopdomain); if not type([M1,M2],list(polynom(ratpoly(anything,x),DF))) then error "wrong arguments or dependent variable not specified" elif degree(M1,DF)<>2 or degree(M2,DF)<>2 then error "case not handled yet" fi; if indets([args],{RootOf,radical,nonreal}) = {} then Normalizer := normal else Normalizer := evala fi; T1:=Normalizer(coeff(M1,DF,1)/coeff(M1,DF,2)/2); L1:=`DEtools/symmetric_product`(M1,DF-T1); T2:=Normalizer(coeff(M2,DF,1)/coeff(M2,DF,2)/2); L2:=`DEtools/symmetric_product`(M2,DF-T2); C0:=Normalizer(coeff(L1,DF,0)/coeff(L1,DF,2)); D0:=Normalizer(coeff(L2,DF,0)/coeff(L2,DF,2)-C0); if D0=0 then S:=1 else C1:=Normalizer(diff(C0,x)); D1:=Normalizer(diff(D0,x)); dd:=Normalizer(D1/D0); v:=map(Normalizer,[2*diff(C1,x)+diff(D1,x)-2*dd*C1-D1*dd+D0^2, 6*C1+D1-4*dd*C0, 2*(D0+2*C0), -dd, 1]); v:=`DEtools/Expsols`(v,0,x,`use Int`,`no algext`,radical,denom,2); if nops(v)=0 then return 0 elif nops(v)>1 then userinfo(1,'dsolve',"input is reducible"); return 0 else v:=v[1]; v1:=Normalizer(diff(v,x)); S:=collect(v*DF + (diff(v1,x,x)+(4*C0+5*D0)*v1+v*(2*C1+D1))/2/D0-2*v1 ,[exp,DF],Normalizer) fi fi; S:=combine(collect(exp(Int(-T2,x))*`DEtools/mult`( S,exp(Int(T1,x))),[exp,DF],Normalizer),exp); v:=seq(`if`(op(0,i)=exp,i,NULL),i=indets(S,function)); if nops([v])<>1 then error "exp not collected" fi; S := subs(v=`DEtools/kovacicsols/e_int`(Normalizer(diff(op(v),x)),x),S); if has(S,RootOf) then add(`DEtools/kovacicsols/combi`(normal(coeff(S,DF,i)),x)*DF^i, i=0..degree(S,DF)); else collect(subs(v=`DEtools/kovacicsols/e_int`(Normalizer(diff(op(v),x)),x),S),DF,Normalizer); fi; end: # The following program returns the necessary form (1/denom(ei) or 0) of exponent diff. to check whether the GHE has Liouvillian solution or not: makemin:= proc(a) if denom(a) = 1 then return 0; #logarithmic case else return 1/denom(a); fi; end: