# n = 3 when f ramifies of order 2 above any two of {0,1,infty} with exponent difference odd integer/2, and <> odd integer/2. # This case will be done in another algorithm! Deg2_3:= proc(L::set,x,K) # L is the singularity structure of input differential operator, # i.e. a set of lists [pi,ei] where pi is an irreducible poly in x # and ei its corresponding exponent difference. # K is the base field. local L1,a2,i,i1,j,j1,k,k1,P,Ps,Es,N,C1,C2,e0,e1,ei,Base_Field,f,f1,F,Field_F,cand,c,c_val; if nargs = 2 then Base_Field:= indets([args], {nonreal, RootOf, radical}); return procname(args, Base_Field); else Base_Field:= K; fi; # we are looking for the rational f which produces 3 non # removable singularities from 0,1,infinity. # So, we must have at least 2 irreducible polys and the polys may have at most degree 2. # at least one of them must have degree 1: L1:= L; for i in L1 do if points(i[1],x) <> 1 and points(i[1],x) <> 2 then return "Wrong input"; fi; od; if add(points(i[1],x),i= L1) <> 3 then return "Not in Case Deg2_3"; fi; Ps:=[seq(i[1],i=L1)]; Es:= [seq(i[2],i=L1)]; N:= {seq(i,i=1..nops(L1))}; # Compute f now: let's put the non removable ramified point at the root of f: # and other two non ramified points at the pole, i.e, disappearing ramified # point lies above 1. # f:= k1*(x-a0)^2/(x^2+b1*x+b0); 1-f:= k2*(x-c0)^2/(x^2+b1*x+b0); we do not know c0: # where the poles are distinct. cand:= {}; e1:= 1/2; for i in N do if points(Ps[i],x) <> 1 then next; fi; if type(Es[i],integer) then e0:= normal(Es[i]/2); else e0:= {normal(Es[i]/2), normal((Es[i]+1)/2)}; fi; f:= c*(Ps[i])^2; C1:= N minus {i}; if nops(C1) = 1 then P:= Ps[C1[1]]; ei:= Es[C1[1]]; else if type(evala(Es[C1[1]]- Es[C1[2]]),integer) or type(evala(Es[C1[1]]+Es[C1[2]]),integer) then P:= mul(Ps[j], j= C1); ei:= min(seq(abs(Es[j]), j= C1)); else next; fi; fi; f1:= f/P; c_val:= {solve({discrim(numer(1-f1),x)})}; if c_val <> {} and c_val <> {{}} then for k1 in c_val do F:= eval(f1,c=rhs(op(k1))); if max(degree(numer(F),x),degree(denom(F),x)) = 2 then Field_F:= indets(F, {RootOf, radical}) union `if`(has(F,I),{I},{}); if nops(Field_F minus Base_Field) <> 0 then next; fi; cand:= cand union {seq([factor(F),[k2,e1,ei]], k2 = e0)}; fi; od; fi; od; cand; end: points:= proc(f,x) if f = 1 then 1 else degree(f,x); fi; end: