3
$\begingroup$

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.

$\endgroup$
3
$\begingroup$

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}]

enter image description here

and compare it to the real solutions of

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

enter image description here

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

$\endgroup$
  • $\begingroup$ Thank you very much. I wouldn't be able to do it without your help. I can't thank you enough. $\endgroup$ – Caims Jan 13 '17 at 22:00
  • $\begingroup$ @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. $\endgroup$ – bbgodfrey Jan 13 '17 at 22:02
  • $\begingroup$ 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? $\endgroup$ – Caims Jan 14 '17 at 0:01
  • $\begingroup$ @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. $\endgroup$ – bbgodfrey Jan 14 '17 at 1:03

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.