ProduceTable := proc(d1, d2, d3) local r1,r2,r3,k1,k2,k3, GenericSols, SpecialSols,s,V,n,i,j,v,N; if 1/d1 + 1/d2 + 1/d3 >= 1 then return "Liouvillian" fi; if member("4+1", [args[4..-1]]) then s := 3 else s := 2 fi; GenericSols := NULL; SpecialSols := NULL; V := eval( [[r1,r2,r3],[k1,k2,k3]], solve({ N = k1*d1 + r1, N = k2*d2 + r2, N = k3*d3 + r3, 2*N - s = k1*(d1-1) + k2*(d2-1) + k3*(d3-1) + (r1+r2+r3) - 4}, {r1,r2,r3,k1}) ); for n from 2 to 60 do for i from 0 to iquo(n,d2) do for j from 0 to iquo(n,d3) do v := eval(V, {N=n, k2=i, k3=j}); if {op(map(denom, map(op,v)))}<>{1} or hastype(v[1],negint) or hastype(v[2],negint) or convert(v[1],`+`)<4 then next fi; if member(0, v[2]) then GenericSols := GenericSols, [n, v[1]] else SpecialSols := SpecialSols, [n, v[1]] fi od od od; if member("compact", [args[4..-1]]) then [GenericSols], [SpecialSols] else [seq(SpellOut(d1,d2,d3,op(i)),i=[GenericSols])], [seq(SpellOut(d1,d2,d3,op(i)),i=[SpecialSols])] fi end: SpellOut := proc(d1,d2,d3, N, L) local V,i; V := Partitions(L, 4); V := [seq(`if`(member(0, [op(i[1] mod d1), op(i[2] mod d2), op(i[3] mod d3)]), NULL, i),i=V)]; V := [seq(`if`(Keep(i, d1,d2,d3), i, NULL), i=V)]; seq([N, [1/d1, op(i[1])], [1/d2, op(i[2])], [1/d3, op(i[3])] ], i=V) end: Keep := proc(i, d1,d2,d3) local b; b := evalb( max(op(i[1]))>d1 or max(op(i[2]))>d2 or max(op(i[3]))>d3 ); if _Env_Keep = "degenerate" then # Keep only cases that are degenerations of "4+1" b elif _Env_Keep = "all" then # Keep all cases true else not b # Throw away cases that are degenerations of "4+1" fi end: # L = [r1,r2,r3] # # Produce n numbers such that [r1,r2,r3] can be written as the sum of them. # Result is then [L1, L2, L3] such that nops(L1)+nops(L2)+nops(L3) = n # and the sum of L1 is r1, the sum of L2 is r2, the sum of L3 is r3. Partitions := proc(L::list, n::posint) local i,j; if nops(L)=0 then {} elif L[1]=0 then {seq( [[], op(i)], i=procname(L[2..-1], n))} elif n=1 then if {0, op(L[2..-1])} <> {0} then {} else { [ [L[1]], []$(nops(L)-1) ] } fi else {seq(seq([sort([i, op(j[1])]), op(j[2..-1])], j = procname( [L[1]-i, op(L[2..-1])], n-1)),i=1..L[1])} fi end: _Env_Keep := "all" ; AllNonParametric := map(op,[ seq(ProduceTable(2,3,i)[2],i=7..14), seq(ProduceTable(2,4,i)[2],i=5..9), seq(ProduceTable(2,5,i)[2],i=5..7), ProduceTable(2,6,6)[2], ProduceTable(3,3,4)[2], ProduceTable(3,3,5)[2], ProduceTable(3,4,4)[2] ]): for i while i <= nops(AllNonParametric) do v := AllNonParametric[i]; if member([v[1], v[3], v[2], v[4]], AllNonParametric[1..i-1]) or member([v[1], v[2], v[4], v[3]], AllNonParametric[1..i-1]) then AllNonParametric := subsop(i=NULL, AllNonParametric); lprint("Dropping a branching pattern that only differs from another one by permuting 0,1,infty"); i := i-1 fi od: lprint(nops(AllNonParametric), "branching types"); read "ComputeBelyi.mpl": infolevel[ComputeBelyi] := 10; for v in AllNonParametric do RESULT[v] := ComputeBelyi(v[1], [seq(denom(v[i,1]),i=2..4)], [seq(v[i][2..-1],i=2..4)], x) ; od;