# Rationalizing expression with Roots v2

I want to generalize the answer from my previous question: Rationalizing expressions with Roots, so I want to rationalize a very ugly expression that I can't paste here since it's way too long so I got it on pastebin: http://pastebin.com/uZLmJ6SF

Again, I want to get rid of the Roots and get the solution as (finite) series of powers of y with coefficients dependent on x for zero locus of some polynomial. So: $y - \mbox{my code}=0$ and I want to get expression $a_1 y^1 + ... + a_n y^n=0$ where $a_n$ are coefficients dependent on $x$ that are radical numbers. I know that I will introduce extra solutions this way. How does one generalize solution from the previous question to work with this problem? The problem is when I try to use the function

eq1 = ((s // First) /. Root[__] -> z)[y] == 0


where s is the expression on pastebin, then I get trivial output x^7 y==0 or z[y]==0. Is there a way to fix this? As suggested on that last thread, this is expression of different type than it is there, so I'm asking a new question.

The answer to this question is obtained by a procedure similar to the answer to 135183. The first step is to extract the two (nested) Root functions and convert them to polynomials.

r1 = Union@Cases[s, _Root, {7, 13}] // First;
p1 = (First@r1)[z1]
(* -x^10 + (2 x^8 + 19 x^9 + 26 x^10) z1 + (x^6 + 20 x^7 + 35 x^8 -
40 x^9 - 64 x^10) z1^2 + (-2 x^4 + 3 x^5 + 12 x^6 - 85 x^7 -
129 x^8 + 32 x^9 + 32 x^10) z1^3 + (-x^2 + 10 x^4 - 43 x^5 -
80 x^6 + 123 x^7 + 146 x^8) z1^4 + (-x + 6 x^2 + x^3 - 22 x^4 +
113 x^5 + 169 x^6 - 75 x^7 - 52 x^8) z1^5 + (1 - 12 x^2 + 6 x^3 +
21 x^4 - 115 x^5 - 146 x^6 + 8 x^7) z1^6 + (-1 + x + 7 x^2 -
7 x^3 - 8 x^4 + 45 x^5 + 45 x^6) z1^7 *)

s1 = s /. r1 -> z1;
r2 = Union@Cases[s1, _Root, {1, 6}] // First;
p2 = (First@r2)[z2]
(* x^9 + x^7 z1 - 3 x^7 z1^2 - 2 x^5 z1^3 + 3 x^5 z1^4 + x^3 z1^5 -
x^3 z1^6 + (-6 x^8 z1 + x^5 z1^2 - 3 x^6 z1^2 + x^3 z1^3 +
2 x^4 z1^3 + 12 x^6 z1^3 - x^3 z1^4 - 3 x^2 z1^5 - 6 x^4 z1^5 +
3 x^2 z1^6) z2 + (15 x^7 z1^2 - 3 x^4 z1^3 + 2 x^5 z1^3 -
2 x^2 z1^4 - 3 x^3 z1^4 - 18 x^5 z1^4 + 3 x z1^5 + 2 x^2 z1^5 +
6 x^3 z1^5 - 3 x z1^6 + 3 x^3 z1^6) z2^2 + (-20 x^6 z1^3 +
3 x^3 z1^4 + 2 x^4 z1^4 - z1^5 + x z1^5 + 12 x^4 z1^5 + z1^6 -
x z1^6 - 4 x^2 z1^6) z2^3 + (15 x^5 z1^4 - x^2 z1^5 - 3 x^3 z1^5 +
x z1^6 - 3 x^3 z1^6) z2^4 + (-6 x^4 z1^5 + x^2 z1^6) z2^5 + x^3 z1^6 z2^6 *)


So far, this procedure mirrors that in the earlier answer. However, r2 enters in s in a more complicated way than before.

s2 = s1 /. r2 -> z2
(* (x^7 z1 z2 (-x + z1 z2))/(x^2 - z1 (-1 + z1 + x z2)) *)


whereas in the earlier answer, s2 reduced to z2 which could be identified as y. Here, y is equivalent to the function in {z2, z1} immediately above. Convert it to a polynomial by setting s2 to y and clearing the denominator.

p3 = Collect[y Denominator[s2] - Numerator[s2], z2, Simplify]
(* y (x^2 + z1 - z1^2) + x (x^7 - y) z1 z2 - x^7 z1^2 z2^2 *)


So, we have three polynomials instead of two, and they must be combined into a single polynomial to satisfy the question. First, eliminate p1 and z1.

res2 = Resultant[p1, p2, z1];
FactorList[res2];


There are three factors, the first being x^47, the third being a 35th-order polynomial, and the second being

pres2 = FactorList[res2][[3, 1]]
(* x^5 + 2 x^3 z2 + x z2^2 - x^2 z2^2 - 2 x^3 z2^2 + 7 x^4 z2^2 +
12 x^5 z2^2 - z2^3 - x z2^3 + 6 x^2 z2^3 + 5 x^3 z2^3 -
14 x^4 z2^3 - 4 x z2^4 - 17 x^2 z2^4 - 3 x^3 z2^4 + 32 x^4 z2^4 +
32 x^5 z2^4 + 7 x z2^5 + 7 x^2 z2^5 - 44 x^3 z2^5 - 64 x^4 z2^5 +
14 x^2 z2^6 + 26 x^3 z2^6 - x^2 z2^7 *)


Likewise,

res3 = Resultant[p1, p3, z1];
FactorList[res3];


but it has only two factors, x^11 and a 14th-order polynomial, too long to be reproduced here.

pres3 = FactorList[res3][[3, 1]]


Finally, eliminate z2 (which is slow).

res = Resultant[pres2, pres3, z2];
p = FactorList[res][[4, 1]]

(* x^50 - 2 x^40 y + x^41 y - x^42 y + 7 x^43 y + x^30 y^2 - x^31 y^2 -
3 x^33 y^2 + 5 x^34 y^2 - 6 x^35 y^2 + 21 x^36 y^2 - 3 x^24 y^3 -
3 x^25 y^3 + 8 x^26 y^3 + 10 x^27 y^3 - 15 x^28 y^3 + 35 x^29 y^3 -
2 x^15 y^4 + 2 x^16 y^4 - 9 x^18 y^4 + 22 x^19 y^4 + 10 x^20 y^4 -
20 x^21 y^4 + 35 x^22 y^4 + 3 x^9 y^5 + 5 x^10 y^5 - 9 x^11 y^5 +
18 x^12 y^5 + 5 x^13 y^5 - 15 x^14 y^5 + 21 x^15 y^5 + y^6 - x y^6 +
3 x^3 y^6 - 3 x^4 y^6 + 5 x^5 y^6 + x^6 y^6 - 6 x^7 y^6 + 7 x^8 y^6 - y^7 + x y^7 *)


which is the desired polynomial. To verify the accuracy of all this algebra, plot s

Plot[s, {x, 1, 2}, PlotRange -> {-800, 0}]


and compare it to the real solutions of

fs = Solve[p == 0, y];
Plot[Evaluate[y /. fs], {x, 1, 2}, PlotRange ->  {-800, 0}]


As expected, p has more than one real root, but one of the curves matches the curve from s, again as desired.

• Thank you very much. I wouldn't be able to do it without your help. I can't thank you enough. – Caims Jan 13 '17 at 22:00
• @Caims I learned a lot while solving this. By the way, when we exchanged comments last night in connection with your earlier question, I had no idea how to proceed on this one. Best wishes. – bbgodfrey Jan 13 '17 at 22:02
• There's a small mistake in p = FactorList[res3][[4, 1]] it should be p = FactorList[res][[4, 1]]. But I don't understand why you used {7, 13} and {1, 6} in the first lines. Can you explain that? – Caims Jan 14 '17 at 0:01
• @Caims I used these particular indices so that I could work with each Root function separately. However, there are other ways to isolate each of the Root functions. Thanks for catching the typo. – bbgodfrey Jan 14 '17 at 1:03