Ok. Glad to be of help. By the way, I found the 16th deg resolvent, call this R_16, of that "natural" and solvable 17-deg eqn I gave a week or so ago. R_16 factors into 4 quartics over Sqrt[2(17+Sqrt[17])]. It factors further into quadratics using an extension involved in the 17th root of unity, but is quite messy. I believe R_16 can be expressed in terms of the 17th roots of unity, similar to that septic and the 29th roots of unity. Now if we can only find Peter Montgomery.... (I'm checking my email. I think we corresponded before.) Sincerely, - Tito On Sat, Sep 17, 2011 at 12:28 PM, Bill Gosper <billgosper@gmail.com> wrote:
On Sat, Sep 17, 2011 at 9:47 AM, Tito Piezas <tpiezas@gmail.com> wrote:
Dear Bill,
I think this method of "factoring sextics into cubics over a square root extension" works only for certain solvable transitive groups (including the cyclic and dihedral groups).
But what if the sextic factors ONLY as three quadratics over a cube root extension? For example, the solvable sextic below has transitive group 6T8,
x^6+x^4-4x^3+7x^2-2x-5 = 0 (eq.1)
This does not factor over the square root of its discriminant D = 6^6*37^3, but will factor into three quadratics as,
x^2+m x+(m^2-1) = 0
with coefficients determined by the cubic,
m^3-4m-2 = 0
Can you try (eq.1) with your program, pls? (I'm using an older version of Mathematica so cannot test it myself.)
Sincerely,
- Tito
YIKES, you're right! In[1335]:= Factor[x^6 + x^4 - 4 x^3 + 7 x^2 - 2 x - 5]
Out[1335]= -5 - 2 x + 7 x^2 - 4 x^3 + x^4 + x^6
In[1336]:= Ssexy[%]
During evaluation of In[1336]:= Factor::nalg : "\[NoBreak]\[LeftSkeleton]713\[RightSkeleton]\ \[NoBreak] is not an explicit algebraic number. \!\(\*ButtonBox["\ \[RightSkeleton]", Appearance->{Automatic, None}, BaseStyle->"Link", ButtonData:>"paclet:ref/message/General/nalg", ButtonNote->"Factor::nalg"]\)"
In[1337]:= Solve[m^3 - 4 m - 2 == 0]
Out[1337]= {{m -> (9 + I Sqrt[111])^(1/3)/3^(2/3) + 4/(3 (9 + I Sqrt[111]))^( 1/3)}, {m -> -(((1 + I Sqrt[3]) (9 + I Sqrt[111])^(1/3))/( 2 3^(2/3))) - (2 (1 - I Sqrt[3]))/(3 (9 + I Sqrt[111]))^( 1/3)}, {m -> -(((1 - I Sqrt[3]) (9 + I Sqrt[111])^(1/3))/( 2 3^(2/3))) - (2 (1 + I Sqrt[3]))/(3 (9 + I Sqrt[111]))^(1/3)}}
In[1338]:= Factor[%1335, Extension -> m /. %[[1]]]
Out[1338]= -(1/ 27) (15 + (48 3^(1/3))/(9 + I Sqrt[111])^( 2/3) + (3 (9 + I Sqrt[111]))^( 2/3) + ((12 3^(2/3))/(9 + I Sqrt[111])^(1/3) + 3 (3 (9 + I Sqrt[111]))^(1/3)) x + 9 x^2) (-3 + ( 48 3^(1/3))/(9 + I Sqrt[111])^(2/3) - ( 8 3^(2/3))/(9 + I Sqrt[111])^(1/3) - 2 (3 (9 + I Sqrt[111]))^(1/3) + (3 (9 + I Sqrt[111]))^( 2/3) + (6 - (4 3^(2/3))/(9 + I Sqrt[111])^( 1/3) - (3 (9 + I Sqrt[111]))^(1/3)) x - 6 x^2 + ((4 3^(2/3))/(9 + I Sqrt[111])^( 1/3) + (3 (9 + I Sqrt[111]))^(1/3)) x^3 - 3 x^4)
There is apparently not even a rational quintic resolvent. This probably explains the difficulty I'm having extending my method to your octic.
Thanks! (Blush.) --rwg
On Sat, Sep 17, 2011 at 2:31 AM, Bill Gosper <billgosper@gmail.com>wrote:
I believe the following ridiculously short function will solve any solvable sextic:
Ssexy[q_] := Catch[Block[{rts = #[[1, 2]] & /@ NSolve[q == 0, WorkingPrecision -> 666], foos}, foos = InverseFourier[ rts[[#]]/Sqrt[6]]^6 & /@ (Join[{1}, #] & /@ (1 + Permutations[Range[5]])); Factor[Rationalize[ Expand[Times @@ (# - Rest[foos[[ Ordering[Denominator[Rationalize[Plus @@ #, 9.^-666]] & /@ foos, 1][[1]]]]])]]] /. (a_: 1)*# + b_ :> Throw[Solve[0 == Factor[q, Extension -> Sqrt[-b/a]]]]; Solve[0 == q]]]
This is based on the empirical observation that the resolvent quintic, when it exists, will have a linear factor whose root, when square rooted, will split the sextic into cubics. When there is no quintic with rational coeffs, Solve still has a chance of factoring or decomposing. Here's an example of splitting.
In[1325]:= MinimalPolynomial[Cos[\[Pi]/5] - Cos[\[Pi]/7], c]
Out[1325]= -1 - 8 c + 36 c^2 + 40 c^3 - 128 c^4 - 32 c^5 + 64 c^6
In[1326]:= Ssexy[%]
Out[1326]= {{c -> 1/12 (1 - 3 Sqrt[5] + (2 7^(2/3))/(1/2 (1 + 3 I Sqrt[3]))^(1/3) + 2^(2/3) (7 (1 + 3 I Sqrt[3]))^(1/3))}, {c -> 1/12 (1 + 3 Sqrt[5] + (2 7^(2/3))/(1/2 (1 + 3 I Sqrt[3]))^(1/3) + 2^(2/3) (7 (1 + 3 I Sqrt[3]))^(1/3))}, {c -> -((7^(2/3) (1 + I Sqrt[3]))/(6 2^(2/3) (1 + 3 I Sqrt[3])^(1/3))) - 1/12 (1 - I Sqrt[3]) (7/2 (1 + 3 I Sqrt[3]))^(1/3) + 1/12 (1 - 3 Sqrt[5])}, {c -> -((7^(2/3) (1 - I Sqrt[3]))/( 6 2^(2/3) (1 + 3 I Sqrt[3])^(1/3))) - 1/12 (1 + I Sqrt[3]) (7/2 (1 + 3 I Sqrt[3]))^(1/3) +1/12 (1 - 3 Sqrt[5])}, {c -> -((7^(2/3) (1 + I Sqrt[3]))/(6 2^(2/3) (1 + 3 I Sqrt[3])^(1/3))) - 1/12 (1 - I Sqrt[3]) (7/2 (1 + 3 I Sqrt[3]))^(1/3) + 1/12 (1 + 3 Sqrt[5])}, {c -> -((7^(2/3) (1 - I Sqrt[3]))/(6 2^(2/3) (1 + 3 I Sqrt[3])^(1/3))) -
1/12 (1 + I Sqrt[3]) (7/2 (1 + 3 I Sqrt[3]))^(1/3) +1/12 (1 + 3 Sqrt[5])}}
In[1332]:= FindIntegerNullVector[ Append[#[[1, 2]] & /@ %1326, Cos[\[Pi]/5] - Cos[\[Pi]/7]]]
Out[1332]= {0, 0, 0, 0, 1, 0, -1}
So Cos[\[Pi]/5] - Cos[\[Pi]/7] is the penultimate solution. --rwg