[math-fun] sextics and septics
Julian changed 5 to 6 in my quintic solver and now it solves (solvable) sextics, without even changing the internal Solve to be the quintic solver! So I changed 6 to 7 and solved (eq.2) from Tito's -------------------------------- x^8-x^7+29x^2+29 = 0 (eq.1) (by Igor Schein) is solvable, but not as easy as merely factoring over a square root extension. Rather, this can be solvable by the 29th root of unity. My solution to (eq.1) is, [tweaked (with permission) by rwg on the basis of numerical evidence: {8 x} = {1-a-b+c+d-e-f-g, 1+a+b+c-d-e-f+g, 1-a+b-c-d+e-f-g, 1+a-b-c+d+e-f+g, 1-a-b-c-d-e+f+g, 1+a+b-c+d-e+f-g, 1+a-b+c-d+e+f-g, 1-a+b+c+d+e+f+g} ] where each {a,b,c,d,e,f,g} = Sqrt[4v_i+1] and the v_i are the 7 roots of the septic, 8903+47647v+39672v^2+7192v^3-522v^4-174v^5+v^7 = 0 (eq.2) The solution of which was given by Peter Montgomery as, v_i = 2(w^11+w^13+w^16+w^18)-2(w+w^12+w^17+w^28)-(w^2+w^5+w^24+w^27)+ (w^3+w^7+w^22+w^26)+(w^4+w^10+w^19+w^25)-(w^8+w^9+w^20+w^21) and one can set w_i = {t, t^7, t^23, t^25, t^16, t^20, t^24}, and t = exp(2Pi*I/29). [...] ------------------------ But instead of Montgomery's elegant solution featuring 29th roots of unity, I got many pages of septic surds of sextic surds of quadratic surds, implying improbable-looking identities. I don't expect these Montgomery-style elegances to apply very often, so mountains of radicals may be the general rule. But when I bumped 7 to 8 and tried (eq.1), I couldn't find a septic resolvent, even using 999 digits of WorkingPrecision. ? Even if this gets fixed, it has no hope of recovering Tito's 16th degree resolvent, due to a small matter of 17! possibilities. Julian also showed me an elegant way (satfun) to condense all n solutions of the nth degree eqn into a single f(k mod n). Here's the sextic solver: satfun[L_List] := Block[{n = 1 + Length[L[[1]]]}, Do[If[GCD @@ (Arg[v1/v2]/\[Pi]) == 2/n, Return[v2*(v1/v2)^#]], {v1, L}, {v2, L}]] (sixto5th = Exp[2*I*\[Pi]* Flatten[Outer[List, Range[0, 5], Range[0, 5], Range[0, 5], Range[0, 5], Range[0, 5]], 4]/6]) // Short Ssext[q_] := Block[{rts = #[[1, 2]] & /@ NSolve[q == 0, WorkingPrecision -> 666], boa, foos, S4 = Permutations[Range[4]]}, foos = InverseFourier[ rts[[#]]/Sqrt[6]]^6 & /@ (Join[{}, #] & /@ (Permutations[ Range[6]])); foos = (Together[#[[1, 2]]]^(1/6) &) /@ Solve[0 == Rationalize[ Expand[Times @@ (# - Rest[foos[[Ordering[ Denominator[Rationalize[Plus @@ #, 9.^-666]] & /@foos, 1][[1]]]]])]]]; boa = Rationalize[Plus @@ rts/6]; Evaluate[boa + foos.satfun[ Select[sixto5th, MemberQ[Chop[#.foos + boa - rts], 0] &]]] &] E.g.; In[78]:= MinimalPolynomial[2^(1/3) + Sqrt[2], x] Out[78]= -4 - 24 x + 12 x^2 - 4 x^3 - 6 x^4 + x^6 In[79]:= Ssext[%] Out[79]= -(-1)^#1 Sqrt[2] + 2^(1/3) E^((2 I \[Pi])/3) (E^(-((2 I \[Pi])/3)))^#1 & In[80]:= % /@ Range[6] Out[80]= {2^(1/3) + Sqrt[2], -Sqrt[2] + 2^(1/3) E^(-((2 I \[Pi])/3)), Sqrt[2] + 2^(1/3) E^((2 I \[Pi])/3), 2^(1/3) - Sqrt[2], Sqrt[2] + 2^(1/3) E^(-((2 I \[Pi])/3)), -Sqrt[2] + 2^(1/3) E^((2 I \[Pi])/3)} In[81]:= MinimalPolynomial[Cos[\[Pi]/21]] Out[81]= 1 + 16 #1 + 32 #1^2 - 48 #1^3 - 96 #1^4 + 32 #1^5 + 64 #1^6 & In[82]:= Ssext[%@x] Out[82]= -(1/12) - 1/4 (-1)^#1 Sqrt[7/3] + ((7/2 (71 + 39 I Sqrt[3]))^(1/6) E^(( 2 I \[Pi])/3) (E^(-((I \[Pi])/3)))^#1)/( 4 Sqrt[3]) + ((7/2 (71 - 39 I Sqrt[3]))^(1/6) E^(-((2 I \[Pi])/3)) (E^((I \[Pi])/3))^#1)/(4 Sqrt[3]) + 1/12 7^(1/3) (-(1/2) I (-13 I + 3 Sqrt[3]))^(1/6) E^((2 I \[Pi])/ 3) (E^(-((2 I \[Pi])/3)))^#1 + 1/12 7^(1/3) (1/2 I (13 I + 3 Sqrt[3]))^(1/6) E^(-((2 I \[Pi])/3)) (E^((2 I \[Pi])/3))^#1 & In[83]:= Rationalize[N[ArcCos[% /@ Range[6]]/\[Pi], 69]] Out[83]= {1/21, 11/21, 5/21, 13/21, 17/21, 19/21} --rwg scaly anteater's transacetylase labor-intensive inventoriables
Bill Gosper <billgosper@gmail.com> wrote:
Julian changed 5 to 6 in my quintic solver and now it solves (solvable) sextics, without even changing the internal Solve to be the quintic solver! So I changed 6 to 7 and solved (eq.2) from Tito's -------------------------------- x^8-x^7+29x^2+29 = 0 (eq.1)
(by Igor Schein) is solvable, but not as easy as merely factoring over a square root extension. Rather, this can be solvable by the 29th root of unity.
My solution to (eq.1) is, [tweaked (with permission) by rwg on the basis of numerical evidence: {8 x} = {1-a-b+c+d-e-f-g, 1+a+b+c-d-e-f+g, 1-a+b-c-d+e-f-g, 1+a-b-c+d+e-f+g, 1-a-b-c-d-e+f+g, 1+a+b-c+d-e+f-g, 1+a-b+c-d+e+f-g, 1-a+b+c+d+e+f+g} ] where each {a,b,c,d,e,f,g} = Sqrt[4v_i+1] and the v_i are the 7 roots of the septic,
8903+47647v+39672v^2+7192v^3-522v^4-174v^5+v^7 = 0 (eq.2)
The solution of which was given by Peter Montgomery as,
v_i = 2(w^11+w^13+w^16+w^18)-2(w+w^12+w^17+w^28)-(w^2+w^5+w^24+w^27)+ (w^3+w^7+w^22+w^26)+(w^4+w^10+w^19+w^25)-(w^8+w^9+w^20+w^21) and one can set w_i = {t, t^7, t^23, t^25, t^16, t^20, t^24}, and t = exp(2Pi*I/29). [...] ------------------------ But instead of Montgomery's elegant solution featuring 29th roots of unity, I got many pages of septic surds of sextic surds of quadratic surds, implying improbable-looking identities.
I don't expect these Montgomery-style elegances to apply very often, so mountains of radicals may be the general rule.
But when I bumped 7 to 8 and tried (eq.1), I couldn't find a septic resolvent, even using 999 digits of WorkingPrecision. ? Even if this gets fixed, it has no hope of recovering Tito's 16th degree resolvent, due to a small matter of 17! possibilities.
Julian also showed me an elegant way (satfun) to condense all n solutions of the nth degree eqn into a single f(k mod n).
Here's the sextic solver: satfun[L_List] := Block[{n = 1 + Length[L[[1]]]}, Do[If[GCD @@ (Arg[v1/v2]/\[Pi]) == 2/n, Return[v2*(v1/v2)^#]], {v1, L}, {v2, L}]]
(sixto5th = Exp[2*I*\[Pi]* Flatten[Outer[List, Range[0, 5], Range[0, 5], Range[0, 5], Range[0, 5], Range[0, 5]], 4]/6]) // Short
Ssext[q_] := Block[{rts = #[[1, 2]] & /@ NSolve[q == 0, WorkingPrecision -> 666], boa, foos, S4 = Permutations[Range[4]]}, foos = InverseFourier[ rts[[#]]/Sqrt[6]]^6 & /@ (Join[{}, #] & /@ (Permutations[ Range[6]])); foos = (Together[#[[1, 2]]]^(1/6) &) /@ Solve[0 == Rationalize[ Expand[Times @@ (# - Rest[foos[[Ordering[ Denominator[Rationalize[Plus @@ #, 9.^-666]] & /@foos, 1][[1]]]]])]]]; boa = Rationalize[Plus @@ rts/6]; Evaluate[boa + foos.satfun[ Select[sixto5th, MemberQ[Chop[#.foos + boa - rts], 0] &]]] &]
E.g.; In[78]:= MinimalPolynomial[2^(1/3) + Sqrt[2], x]
Out[78]= -4 - 24 x + 12 x^2 - 4 x^3 - 6 x^4 + x^6
In[79]:= Ssext[%]
Out[79]= -(-1)^#1 Sqrt[2] + 2^(1/3) E^((2 I \[Pi])/3) (E^(-((2 I \[Pi])/3)))^#1 &
In[80]:= % /@ Range[6]
Out[80]= {2^(1/3) + Sqrt[2], -Sqrt[2] + 2^(1/3) E^(-((2 I \[Pi])/3)), Sqrt[2] + 2^(1/3) E^((2 I \[Pi])/3), 2^(1/3) - Sqrt[2], Sqrt[2] + 2^(1/3) E^(-((2 I \[Pi])/3)), -Sqrt[2] + 2^(1/3) E^((2 I \[Pi])/3)}
In[81]:= MinimalPolynomial[Cos[\[Pi]/21]]
Out[81]= 1 + 16 #1 + 32 #1^2 - 48 #1^3 - 96 #1^4 + 32 #1^5 + 64 #1^6 &
In[82]:= Ssext[%@x]
Out[82]= -(1/12) - 1/4 (-1)^#1 Sqrt[7/3] + ((7/2 (71 + 39 I Sqrt[3]))^(1/6) E^(( 2 I \[Pi])/3) (E^(-((I \[Pi])/3)))^#1)/( 4 Sqrt[3]) + ((7/2 (71 - 39 I Sqrt[3]))^(1/6) E^(-((2 I \[Pi])/3)) (E^((I \[Pi])/3))^#1)/(4 Sqrt[3]) + 1/12 7^(1/3) (-(1/2) I (-13 I + 3 Sqrt[3]))^(1/6) E^((2 I \[Pi])/ 3) (E^(-((2 I \[Pi])/3)))^#1 + 1/12 7^(1/3) (1/2 I (13 I + 3 Sqrt[3]))^(1/6) E^(-((2 I \[Pi])/3)) (E^((2 I \[Pi])/3))^#1 &
In[83]:= Rationalize[N[ArcCos[% /@ Range[6]]/\[Pi], 69]]
Out[83]= {1/21, 11/21, 5/21, 13/21, 17/21, 19/21} --rwg scaly anteater's transacetylase labor-intensive inventoriables a "septic surd" doesn't sound very healthy. John
participants (2)
-
Bill Gosper -
jdb@math.arizona.edu