Monday, November 08, 2021

[cbtbofpg] another quintic in Mathematica

we try but fail to fully solve the following solvable quintic equation using Mathematica:

p[x_] := x^5 - 5x + 12

this equation is from https://en.wikipedia.org/w/index.php?title=Quintic_function&oldid=1020016831#Roots_of_a_solvable_quintic, which gives the solution method which we try below.

(previously, a quintic with a simpler solution, with explanations of some of the tricks used below.)

this fails to solve, returning functions of Root:

Solve[p[x]==0, Cubics->True, Quartics->True]

the magic Lagrange resolvent polynomial, copied from Wikipedia:

q[y_] := y^4 + 4*y^3 + (4/5)*y^2 - (8/5^3)*y - 1/5^5

its solution:

m4=Solve[q[y]==0, y, Cubics->True, Quartics->True]

{{y -> -1 + 2/Sqrt[5] - (3*Sqrt[5 - 11/Sqrt[5]])/5}, {y -> -1 + 2/Sqrt[5] + (3*Sqrt[5 - 11/Sqrt[5]])/5}, {y -> (-2 - 4/Sqrt[5] - Sqrt[36/5 + 396/(25*Sqrt[5])])/2}, {y -> (-2 - 4/Sqrt[5] + Sqrt[36/5 + 396/(25*Sqrt[5])])/2}}

all the roots of the resolvent polynomial are real, though some are negative.

Table[N[y/.m4[[i]]],{i,4}]

{-3.78413, -0.275967, -0.00472726, 0.0648213}

next, we compute x1, the real root of the original quintic.  Surd is the magic function which calculates the real nth root (when the input is negative), not the principal (complex) root.

x1=Sum[Surd[y/.m4[[i]],5],{i,1,4}]

-(1 - 2/Sqrt[5] + (3*Sqrt[5 - 11/Sqrt[5]])/5)^(1/5) + (-1 + 2/Sqrt[5] + (3*Sqrt[5 - 11/Sqrt[5]])/5)^(1/5) - (2/(2 + 4/Sqrt[5] - Sqrt[36/5 + 396/(25*Sqrt[5])]))^(-1/5) - (2/(2 + 4/Sqrt[5] + Sqrt[36/5 + 396/(25*Sqrt[5])]))^(-1/5)

x1 //N

-1.84209

we confirm that x1 is a root:

Timing[FullSimplify[p[x1]]]

(523 seconds) (11013.6 seconds on Raspberry Pi, Mathematica 12.2.0)

0

we also confirm that the polynomial numerically evaluates to approximately zero at this root:

p[x1]//N

-3.552713678800501*^-15

next, we try to find the remaining 4 (complex) roots.

x4=Solve[Apart[p[x]/(x-x1)]==0, Cubics->True, Quartics->True]

Apart::ztest: 
   Unable to decide whether numeric quantities 
            3/5
    {-40 + 5    <<1>> + <<106>> + 
      (5 Sqrt[5]) / 
                                                       4/5
       ((25 + 10 Sqrt[5] - 3 Sqrt[5 (25 + 11 Sqrt[5])])    
                                                        1/5
         (25 + 10 Sqrt[5] + 3 Sqrt[5 (25 + 11 Sqrt[5])])   ), <<1>>}
     are equal to zero. Assuming they are.

the above does not complete in a reasonable amount of time on Mathematica 11.3.0 (64-bit Linux x86).  we then repeated all of the above with Cubics->False, Quartics->False everywhere, but it still did not complete in a reasonable amount of time.  we then tried Cubics->False, Quartics->False on Mathematica 12.1.1 (32-bit Linux ARM) on a Raspberry Pi, and it completed in 3 seconds.  the answer is in terms of Root functions, not closed form, so doesn't count as solving the quintic:

{{x -> Root[{-1 - 200*#1 + 2500*#1^2 + 12500*#1^3 + 3125*#1^4 & , #1 + #2^5 & , -1 - 200*#3 + 2500*#3^2 + 12500*#3^3 + 3125*#3^4 & , #3 + #4^5 & , -1 - 200*#5 + 2500*#5^2 + 12500*#5^3 + 3125*#5^4 & , #5 + #6^5 & , -1 - 200*#7 + 2500*#7^2 + 12500*#7^3 + 3125*#7^4 & , -#7 + #8^5 & , -(#1*#3) + #9^5 & , -(#1*#5) + #10^5 & , -(#3*#5) + #11^5 & , #1*#7 + #12^5 & , #3*#7 + #13^5 & , #5*#7 + #14^5 & , #1*#3*#5 + #15^5 & , -(#1*#3*#7) + #16^5 & , -(#1*#5*#7) + #17^5 & , -(#3*#5*#7) + #18^5 & , #1*#3*#5*#7 + #19^5 & , -5 + #2^4 + 4*#2^3*#4 + 4*#2*#4^3 + #4^4 + 4*#2^3*#6 + 4*#4^3*#6 + 4*#2*#6^3 + 4*#4*#6^3 + #6^4 - 4*#2^3*#8 - 4*#4^3*#8 - 4*#6^3*#8 - 4*#2*#8^3 - 4*#4*#8^3 - 4*#6*#8^3 + #8^4 + 12*#6^2*#9 + 12*#8^2*#9 + 6*#9^2 + 12*#4^2*#10 + 12*#8^2*#10 + 6*#10^2 + 12*#2^2*#11 + 12*#8^2*#11 + 6*#11^2 - 12*#4^2*#12 - 12*#6^2*#12 + 6*#12^2 - 12*#2^2*#13 - 12*#6^2*#13 + 6*#13^2 - 12*#2^2*#14 - 12*#4^2*#14 + 6*#14^2 - 24*#19 - #2^3*#20 - 3*#2^2*#4*#20 - 3*#2*#4^2*#20 - #4^3*#20 - 3*#2^2*#6*#20 - 3*#4^2*#6*#20 - 3*#2*#6^2*#20 - 3*#4*#6^2*#20 - #6^3*#20 + 3*#2^2*#8*#20 + 3*#4^2*#8*#20 + 3*#6^2*#8*#20 - 3*#2*#8^2*#20 - 3*#4*#8^2*#20 - 3*#6*#8^2*#20 + #8^3*#20 - 6*#15*#20 + 6*#16*#20 + 6*#17*#20 + 6*#18*#20 + #2^2*#20^2 + #4^2*#20^2 + #6^2*#20^2 + #8^2*#20^2 + 2*#9*#20^2 + 2*#10*#20^2 + 2*#11*#20^2 - 2*#12*#20^2 - 2*#13*#20^2 - 2*#14*#20^2 - #2*#20^3 - #4*#20^3 - #6*#20^3 + #8*#20^3 + #20^4 & }, {1, 1, 2, 1, 3, 1, 4, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1}]}, {x -> Root[{-1 - 200*#1 + 2500*#1^2 + 12500*#1^3 + 3125*#1^4 & , #1 + #2^5 & , -1 - 200*#3 + 2500*#3^2 + 12500*#3^3 + 3125*#3^4 & , #3 + #4^5 & , -1 - 200*#5 + 2500*#5^2 + 12500*#5^3 + 3125*#5^4 & , #5 + #6^5 & , -1 - 200*#7 + 2500*#7^2 + 12500*#7^3 + 3125*#7^4 & , -#7 + #8^5 & , -(#1*#3) + #9^5 & , -(#1*#5) + #10^5 & , -(#3*#5) + #11^5 & , #1*#7 + #12^5 & , #3*#7 + #13^5 & , #5*#7 + #14^5 & , #1*#3*#5 + #15^5 & , -(#1*#3*#7) + #16^5 & , -(#1*#5*#7) + #17^5 & , -(#3*#5*#7) + #18^5 & , #1*#3*#5*#7 + #19^5 & , -5 + #2^4 + 4*#2^3*#4 + 4*#2*#4^3 + #4^4 + 4*#2^3*#6 + 4*#4^3*#6 + 4*#2*#6^3 + 4*#4*#6^3 + #6^4 - 4*#2^3*#8 - 4*#4^3*#8 - 4*#6^3*#8 - 4*#2*#8^3 - 4*#4*#8^3 - 4*#6*#8^3 + #8^4 + 12*#6^2*#9 + 12*#8^2*#9 + 6*#9^2 + 12*#4^2*#10 + 12*#8^2*#10 + 6*#10^2 + 12*#2^2*#11 + 12*#8^2*#11 + 6*#11^2 - 12*#4^2*#12 - 12*#6^2*#12 + 6*#12^2 - 12*#2^2*#13 - 12*#6^2*#13 + 6*#13^2 - 12*#2^2*#14 - 12*#4^2*#14 + 6*#14^2 - 24*#19 - #2^3*#20 - 3*#2^2*#4*#20 - 3*#2*#4^2*#20 - #4^3*#20 - 3*#2^2*#6*#20 - 3*#4^2*#6*#20 - 3*#2*#6^2*#20 - 3*#4*#6^2*#20 - #6^3*#20 + 3*#2^2*#8*#20 + 3*#4^2*#8*#20 + 3*#6^2*#8*#20 - 3*#2*#8^2*#20 - 3*#4*#8^2*#20 - 3*#6*#8^2*#20 + #8^3*#20 - 6*#15*#20 + 6*#16*#20 + 6*#17*#20 + 6*#18*#20 + #2^2*#20^2 + #4^2*#20^2 + #6^2*#20^2 + #8^2*#20^2 + 2*#9*#20^2 + 2*#10*#20^2 + 2*#11*#20^2 - 2*#12*#20^2 - 2*#13*#20^2 - 2*#14*#20^2 - #2*#20^3 - #4*#20^3 - #6*#20^3 + #8*#20^3 + #20^4 & }, {1, 1, 2, 1, 3, 1, 4, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2}]}, {x -> Root[{-1 - 200*#1 + 2500*#1^2 + 12500*#1^3 + 3125*#1^4 & , #1 + #2^5 & , -1 - 200*#3 + 2500*#3^2 + 12500*#3^3 + 3125*#3^4 & , #3 + #4^5 & , -1 - 200*#5 + 2500*#5^2 + 12500*#5^3 + 3125*#5^4 & , #5 + #6^5 & , -1 - 200*#7 + 2500*#7^2 + 12500*#7^3 + 3125*#7^4 & , -#7 + #8^5 & , -(#1*#3) + #9^5 & , -(#1*#5) + #10^5 & , -(#3*#5) + #11^5 & , #1*#7 + #12^5 & , #3*#7 + #13^5 & , #5*#7 + #14^5 & , #1*#3*#5 + #15^5 & , -(#1*#3*#7) + #16^5 & , -(#1*#5*#7) + #17^5 & , -(#3*#5*#7) + #18^5 & , #1*#3*#5*#7 + #19^5 & , -5 + #2^4 + 4*#2^3*#4 + 4*#2*#4^3 + #4^4 + 4*#2^3*#6 + 4*#4^3*#6 + 4*#2*#6^3 + 4*#4*#6^3 + #6^4 - 4*#2^3*#8 - 4*#4^3*#8 - 4*#6^3*#8 - 4*#2*#8^3 - 4*#4*#8^3 - 4*#6*#8^3 + #8^4 + 12*#6^2*#9 + 12*#8^2*#9 + 6*#9^2 + 12*#4^2*#10 + 12*#8^2*#10 + 6*#10^2 + 12*#2^2*#11 + 12*#8^2*#11 + 6*#11^2 - 12*#4^2*#12 - 12*#6^2*#12 + 6*#12^2 - 12*#2^2*#13 - 12*#6^2*#13 + 6*#13^2 - 12*#2^2*#14 - 12*#4^2*#14 + 6*#14^2 - 24*#19 - #2^3*#20 - 3*#2^2*#4*#20 - 3*#2*#4^2*#20 - #4^3*#20 - 3*#2^2*#6*#20 - 3*#4^2*#6*#20 - 3*#2*#6^2*#20 - 3*#4*#6^2*#20 - #6^3*#20 + 3*#2^2*#8*#20 + 3*#4^2*#8*#20 + 3*#6^2*#8*#20 - 3*#2*#8^2*#20 - 3*#4*#8^2*#20 - 3*#6*#8^2*#20 + #8^3*#20 - 6*#15*#20 + 6*#16*#20 + 6*#17*#20 + 6*#18*#20 + #2^2*#20^2 + #4^2*#20^2 + #6^2*#20^2 + #8^2*#20^2 + 2*#9*#20^2 + 2*#10*#20^2 + 2*#11*#20^2 - 2*#12*#20^2 - 2*#13*#20^2 - 2*#14*#20^2 - #2*#20^3 - #4*#20^3 - #6*#20^3 + #8*#20^3 + #20^4 & }, {1, 1, 2, 1, 3, 1, 4, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 3}]}, {x -> Root[{-1 - 200*#1 + 2500*#1^2 + 12500*#1^3 + 3125*#1^4 & , #1 + #2^5 & , -1 - 200*#3 + 2500*#3^2 + 12500*#3^3 + 3125*#3^4 & , #3 + #4^5 & , -1 - 200*#5 + 2500*#5^2 + 12500*#5^3 + 3125*#5^4 & , #5 + #6^5 & , -1 - 200*#7 + 2500*#7^2 + 12500*#7^3 + 3125*#7^4 & , -#7 + #8^5 & , -(#1*#3) + #9^5 & , -(#1*#5) + #10^5 & , -(#3*#5) + #11^5 & , #1*#7 + #12^5 & , #3*#7 + #13^5 & , #5*#7 + #14^5 & , #1*#3*#5 + #15^5 & , -(#1*#3*#7) + #16^5 & , -(#1*#5*#7) + #17^5 & , -(#3*#5*#7) + #18^5 & , #1*#3*#5*#7 + #19^5 & , -5 + #2^4 + 4*#2^3*#4 + 4*#2*#4^3 + #4^4 + 4*#2^3*#6 + 4*#4^3*#6 + 4*#2*#6^3 + 4*#4*#6^3 + #6^4 - 4*#2^3*#8 - 4*#4^3*#8 - 4*#6^3*#8 - 4*#2*#8^3 - 4*#4*#8^3 - 4*#6*#8^3 + #8^4 + 12*#6^2*#9 + 12*#8^2*#9 + 6*#9^2 + 12*#4^2*#10 + 12*#8^2*#10 + 6*#10^2 + 12*#2^2*#11 + 12*#8^2*#11 + 6*#11^2 - 12*#4^2*#12 - 12*#6^2*#12 + 6*#12^2 - 12*#2^2*#13 - 12*#6^2*#13 + 6*#13^2 - 12*#2^2*#14 - 12*#4^2*#14 + 6*#14^2 - 24*#19 - #2^3*#20 - 3*#2^2*#4*#20 - 3*#2*#4^2*#20 - #4^3*#20 - 3*#2^2*#6*#20 - 3*#4^2*#6*#20 - 3*#2*#6^2*#20 - 3*#4*#6^2*#20 - #6^3*#20 + 3*#2^2*#8*#20 + 3*#4^2*#8*#20 + 3*#6^2*#8*#20 - 3*#2*#8^2*#20 - 3*#4*#8^2*#20 - 3*#6*#8^2*#20 + #8^3*#20 - 6*#15*#20 + 6*#16*#20 + 6*#17*#20 + 6*#18*#20 + #2^2*#20^2 + #4^2*#20^2 + #6^2*#20^2 + #8^2*#20^2 + 2*#9*#20^2 + 2*#10*#20^2 + 2*#11*#20^2 - 2*#12*#20^2 - 2*#13*#20^2 - 2*#14*#20^2 - #2*#20^3 - #4*#20^3 - #6*#20^3 + #8*#20^3 + #20^4 & }, {1, 1, 2, 1, 3, 1, 4, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 4}]}}

here are the 4 roots, numerically:

N[Table[x/.x4[[i]],{i,4}]]

{-0.35185424082737227 + 1.7095610433703294*I, -0.35185424082737204 - 1.709561043370329*I, 1.272897223922499 - 0.7197986814838621*I, 1.2728972239224998 + 0.7197986814838616*I}

the polynomial numerically evaluates to approximately zero at these roots:

N[Table[p[x/.x4[[i]]],{i,4}]]

{-2.6645352591003757*^-14 + 8.881784197001252*^-15*I, -1.7763568394002505*^-15 + 0.*I, -1.0658141036401503*^-14 + 1.4654943925052066*^-14*I, -1.4210854715202004*^-14 + 8.881784197001252*^-15*I}

we try to algebraically confirm the roots, but unsurprisingly, this does not complete in a reasonable amount of time:

FullSimplify[Table[p[x/.x4[[i]]], {i,4}]]

No comments :