11
$\begingroup$

I need to find an explicit expression in radicals for the real root of the quintic equation

1152921504606846976 + 99923616732282880 x + 3740744716124160 x^2 - 2794496983040 x^3 + 2257838080 x^4 + x^5 == 0

I tried to use Radicals.nb from here. SolvableQ says the equation is solvable in radicals, but SolveQuintic returns $Failed for some reason. Could you please help me to find an explicit solution, and suggest how to fix this apparent bug in SolveQuintic?

The quintic equation is not completely random, its real root is actually the value of

With[{q = -Exp[-π √47]}, QPochhammer[q, q^2]^24/q]]

and should have an explicit representation in radicals.

$\endgroup$
  • $\begingroup$ Were you at least able to perform a Tschirnhaus transformation on it? $\endgroup$ – J. M. will be back soon Dec 15 '16 at 1:49
  • $\begingroup$ I tried to perform it using function from TschirnhausTransformation.nb, but it looks Mathematica chokes on too large expressions. $\endgroup$ – Vladimir Reshetnikov Dec 15 '16 at 3:36
  • $\begingroup$ Could try code from this Wolfram Communiity post. $\endgroup$ – Daniel Lichtblau Dec 15 '16 at 22:44
  • $\begingroup$ @DanielLichtblau Isn't that post about radical denesting? How do I apply it to solving quintics? $\endgroup$ – Vladimir Reshetnikov Dec 15 '16 at 22:58
  • $\begingroup$ Yes, it is about denesting. I guess I had a hope that it might be able to go from min poly to radical expression. $\endgroup$ – Daniel Lichtblau Dec 16 '16 at 18:35
9
$\begingroup$

I wrote this function based on Daniel Lazard's paper Solving Quintics by Radicals:

QuinticToRadicals[root_Root] := 
  Block[{a, b, c, d, e, f, h, p, q, r, s, t, u, v, w, x, z, g, F, A, 
    B, G, H, L, M, P, Q, R, S},
   If[!TrueQ[Element[root, Algebraics]], Return[root]];
   With[{m = MinimalPolynomial[root, z]},
    If[!PolynomialQ[m, z] || Exponent[m, z] != 5, 
     Return[root]];
    {f, e, d, c, b, a} = CoefficientList[m, z]];
   p = (5 a c - 2 b^2)/(5 a^2);
   q = (25 a^2 d - 15 a b c + 4 b^3)/(25 a^3);
   r = (125 a^3 e - 50 a^2 b d + 15 a b^2 c - 3 b^4)/(125 a^4);
   s = (3125 a^4 f - 625 a^3 b e + 125 a^2 b^2 d - 25 a b^3 c + 4 b^5)/(3125 a^5);
   G = Select[Solve[{(p^2 + 12 r + 4 t) Discriminant[z^5 + p z^3 + q z^2 + r z + s, z] 
     == (2 t^3 + 8 t^2 r + (2 p q^2 - 6 p^2 r + 24 r^2 - 50 q s) t - 2 q^4 + 
         13 p q^2 r - 16 (p^2 - 4 r) r^2 - 5 q (3 p^2 + 40 r) s + 
         125 p s^2)^2, 
     4 r^2 + 2 q (p q + 5 s + 2 u) + 5 x == 
      t^2 + 2 p^2 (3 r + t) + 2 p v, 
     3 p^4 (2 r + t) + 5 p s (50 s + 9 u) + 
       3 q^2 (18 p r + 5 p t + 4 v) + 
       q (-20 s (7 r + 3 t) + 6 r u + p w) + 
       2 (40 r^3 + 16 r^2 t + t^3 + 25 s w + 10 r x) == 
      14 q^4 + 28 p r v + 
       p^2 (52 r^2 + 36 r t + q (3 p q + 41 s + 3 u) - 3 p v + 3 x), 
     q^4 (30 r - 4 t) + t^4 + p^4 (22 r^2 - 6 q s + 4 r t) + 
       q^2 (50 s^2 - 155 s u - 29 r v) + 
       p^3 (-4 q^2 (4 r + t) + 9 s u + 4 r v) + 
       p (q^3 (-132 s + 8 u) - 5 s (110 r s - 5 s t + 28 r u) + 
          16 r^2 v + q (105 s v + 8 r w) - 
          3 q^2 (14 r^2 + 5 r t - 3 x)) + 
       p^2 (4 q^4 - 68 r^3 + 16 r^2 t + 
          q (404 r s + 79 s t - 17 r u) - 4 q^2 v - 15 s w - 
          19 r x) == 
      16 r^4 + 3 q^3 w + 20 r s (4 q t + 5 w) + 
       4 r^2 (5 q s - 17 q u - 15 x) + 25 s (5 s v + 9 q x), 
     625 s^3 (10 s + u) + q^5 (858 s + 20 u) + 
       p^5 (198 s^2 + 5 q^2 (5 r + t) - 15 r v) + 
       q^2 (5 s (2140 r s + 365 s t + 43 r u) - 12 r^2 v) + 
       q^4 (-34 r^2 - 43 r t + 22 x) + 
       8 r^2 (120 r^3 + 64 r^2 t + 25 s w + 30 r x) + 
       p^3 (q^3 (181 s - 5 u) + s (-810 r s + 355 s t - 147 r u) + 
          168 r^2 v - q (212 s v + 11 r w) - 
          q^2 (22 r (13 r + 5 t) + 5 x)) + 
       p^4 (-5 q^4 + q (-491 r s - 200 s t + 15 r u) + 5 q^2 v + 
          18 s w + r (4 r (91 r + 50 t) + 15 x)) + 
       p^2 (5 q^4 (19 r + 3 t) + 
          2 q r (2060 r s + 864 s t - 45 r u) + 325 s^2 v + 
          q^2 (3005 s^2 + 351 s u - 83 r v) + 3 q^3 w + 290 q s x - 
          2 r (544 r^3 + 216 r^2 t + 265 s w + 76 r x)) == 
      15 p^6 r (2 r + t) + 2 (t^5 + 750 r s^2 v) + 
       q^3 (620 s v + 41 r w) + 
       q (2640 r^2 s t + 8 r^3 (780 s - 19 u) + 2375 s^2 w + 
          700 r s x) + 
       p (12 q^6 + 20 r s (-45 r s + 10 s t + 21 r u) + 
          q^3 (4095 r s + 752 s t + 43 r u) - 10 q^4 v + 176 r^3 v + 
          5 q s (635 s (5 s + u) - 312 r v) - 124 q r^2 w + 
          1375 s^2 x - q^2 (612 r^3 + 220 r^2 t + 110 s w - 27 r x)), 
     Element[t, Rationals]}, {t, u, v, w, x}], FreeQ[ConditionalExpression], 1];
   If[G == {}, Return[root], G /. Rule -> Set];
   g = -3 p^2 (-v + q^2) + 20 v r - 50 u s + 125 s^2 + 
     3 q^2 (-7 r + t) + p^3 (4 r + 3 t) + 
     p (16 r^2 - q (u - 40 s) + 12 r t);
   h = 366 v q^3 - 402 q^5 - 748 u q^2 r + 440 w r^2 - 448 q r^3 - 
     12 p^5 s - 275 w q s + 2100 v r s - 1925 q^2 r s - 4875 u s^2 - 
     1875 s^3 + x (-65 p^2 q - 550 q r + 875 p s) + 524 q r^2 t - 
     1040 q^2 s t + p^4 q (158 r + 85 t) + 
     p^3 (85 v q - 85 q^3 + 4 u r - 1462 r s - 418 s t) + 
     p (41 w q^2 - 298 v q r - 56 u r^2 + 5 q s (419 u + 35 s) + 
        10 r s (290 r + 159 t) + q^3 (896 r + 419 t)) - 
     p^2 (58 w r + 520 v s + q (73 u q - 142 r^2 + 159 q s + 440 r t));
   F = Sqrt[
    5 (40 x p - 120 w q + p^2 (-24 v + 40 q^2) + 100 v r + 
       332 q^2 r - 300 u s + 125 s^2 + p^3 (-80 r - 24 t) + 24 q^2 t +
        p (88 u q + 160 r^2 - 480 q s + 100 r t))]; 
   A = Sqrt[5/2 (g + h/F)]; 
   B = 1/(A F)
      5 (42 q^5 + 12 p^5 s + 3 p^4 q (14 r + 5 t) + 
       q^2 (550 r s + 515 s t - 182 r u) - 6 q^3 v + 
       p^3 (-15 q^3 + 492 r s + 213 s t - 4 r u + 15 q v) - 
       50 s (25 s^2 - 60 s u + 22 r v) - 40 r^2 w + 650 q s w + 
       p^2 (-3 q^2 (52 s + 9 u) + 195 s v - 22 r w + 
          q (358 r^2 + 50 r t - 35 x)) - 
       8 q r (29 r^2 + 23 r t + 25 x) + 
       p (q^3 (-246 r + t) + 5 q s (565 s - 54 u) - 
          4 r (350 r s + 235 s t - 24 r u) + 68 q r v + 19 q^2 w - 
          250 s x));
   H = -1750 w q + p^2 (-600 v + 500 q^2) + 2500 v r - 7500 u s + 
     3125 s^2 + q^2 (-700 r - 1150 t) + p^3 (-2000 r - 600 t) + 
     p (1000 x + 1700 u q + 4000 r^2 - 6375 q s + 2500 r t); 
   L = -25 x p - 9 v p^2 - 25 w q - 7 u p q - 7 p^2 q^2 - 60 v r + 
     50 p^3 r + 128 q^2 r - 308 p r^2 + 525 u s - 145 p q s - 
     1000 s^2 - p^3 t + 11 q^2 t - 96 p r t; 
   M = -125 x p + 67 v p^2 + 75 w q - 109 u p q - 79 p^2 q^2 - 
     420 v r + 210 p^3 r + 496 q^2 r - 676 p r^2 + 1175 u s - 
     415 p q s - 750 s^2 + 63 p^3 t + 27 q^2 t - 412 p r t; {A, B, 
     F} = Select[{{A, B, F}, {-A, -B, F}, {B, -A, -F}, {-B, A, -F}}, 
      Apply[25 (2 u - p q - 5 s) + (L #1 + M #2)/g + H/#3 != 0 &], 
      1][[1]];

   P = 1/5 (5/4 (25 (2 u - p q - 5 s) + (L A + M B)/g + H/F))^(1/5); 
   Q = -((4 p^2 q + 2 (36 q r + 7 q t - 5 w) + p (-45 s + 4 u + F))/(
     10 P F)); 
   R = 1/(500 P^2) (-25 q + (
       25 (-40 r^2 - 35 q s + 2 p^2 (10 r + t) - 22 q u + 
          2 p (q^2 + v) - 10 x))/F + 
       1/g 2 (-105 q s A - 140 q s B + 4 r t (3 A + 4 B) + 
          2 p q^2 (7 A + 11 B) + r^2 (76 A + 68 B) - 
          2 p^2 (29 r A + 3 A t + 17 r B + 9 t B) + 23 q A u + 
          14 q B u - 2 p (2 A + 11 B) v + 35 A x + 5 B x)); 
   S = 1/(500 P^3) (1/
        g (-80 r s A + 30 s A t + 60 r s B + 40 s t B + 
          14 q^3 (A + 3 B) - 16 r g + 3 t g + 
          2 p^2 (26 s A + 18 s B + g) + 8 r A u + 44 r B u - 
          2 q (p (26 r A + 3 A t + 33 r B + 14 t B) + (A + 18 B) v) + 
          p (-8 A w + 6 B w)) + (
       5 (8 p^3 q - 2 p q (13 r + t) + p^2 (-20 s + 8 u) + 
          5 (14 q^3 + 10 r s - 5 s t - 10 r u - 2 q v)))/F); 
   Select[{P + Q + R + 
        S, (-1)^(4/5) P - (-1)^(1/5) Q + (-1)^(2/5) R - (-1)^(3/5)
          S, -(-1)^(3/5) P + (-1)^(2/5) Q + (-1)^(4/5) R - (-1)^(1/5)
          S, +(-1)^(2/5) P - (-1)^(3/5) Q - (-1)^(1/5) R + (-1)^(4/5)
          S, -(-1)^(1/5) P + (-1)^(4/5) Q - (-1)^(3/5) R + (-1)^(2/5)
          S} - b/(5 a), !TrueQ[# != root] &, 1][[1]]];

Beware! If found some typos in the paper on p. 222 in the formula for $P_{22}$: the term $\color{red}{8p^3}$ should be replaced with $8p^3q$, and the term $\color{red}{70q^3q}$ should be replaced with $70q^3$.

After some simplifications the root I am interested in can be represented as

Block[{a, b, c, d, f, g, h}, 
  a = Sqrt[25778705 + 5353862 Sqrt[5]]; 
  b = 253 Sqrt[47] Sqrt[223185962057628283872014741096225 + 
     46404398781233715250377772758698 Sqrt[5]]; 
  c = 118179607126755427283 - 33773932059671 Sqrt[5]; 
  d = 1302883789494160617301390 - 930862886277288987 Sqrt[5]; 
  f = 765881115 - 1071962031710725 Sqrt[5]; 
  g = 5155741^(1/5) (6514418947470803086506950 - 4654314431386444935 Sqrt[5] + 
      253 Sqrt[47] Sqrt[223185962057628283872014741096225 + 
        46404398781233715250377772758698 Sqrt[5]])^(1/5); 
  h = 1/(5 d + b)^(1/5); 
   -1024/25778705 (10 5^(1/5) 10311482^(4/5) g + 
      253 10^(2/5) Sqrt[47]
        a h^2 (4993350841 5^(1/5) + 825542539482355 2^(1/5) h) + (
      38747022105 Sqrt[47] (-831611761 5^(1/10) 10311482^(2/5) + 
         18363423328399 2^(3/5) 5^(9/10) g^2 h^3))/(a g^2) + 
      25778705 (440984 + 2 2^(4/5) 5^(1/5) (5 d - b)^(1/5) - 
         2^(2/5) 5^(1/10) h^2 (f - 2^(1/5) 5^(3/10) c h)))]
$\endgroup$
  • 1
    $\begingroup$ Please let me know if you find solvable quintics that this program cannot handle. $\endgroup$ – Vladimir Reshetnikov Jan 1 '17 at 5:31

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.