5
$\begingroup$

I have a problem with presenting solutions. Roots of 4th order polynomials are big expressions. Is there a way to present the roots, s2 and s3, in normal form with some substitutions? Maybe a way to force Mathematica to find some similar terms under the radicals and replace them with substitutions (to factorize or simplify that way), so s2 and s3 are presented in a way that looks nice?

a1 = Roots[x^4 + r1 x^3 + r2 x^2 + r3 x + r4 == 0, x][[1]][[2]];
a2 = Roots[x^4 + r1 x^3 + r2 x^2 + r3 x + r4 == 0, x][[2]][[2]];
a3 = (-s2 - Sqrt[s2^2 - 4  s3])/2 ;
a4 = (-s2 + Sqrt[s2^2 - 4  s3])/2 ;

Solve[{a1 - a3 == 0, a2 - a4 == 0}, {s2, s3}]
$\endgroup$

2 Answers 2

6
$\begingroup$

First, set the option of Roots so that it doesn't expand quartics. Optionally, define a Format for Root.

SetOptions[Roots, Quartics -> False];
Unprotect[Root];
Format[Root[func_, v_], StandardForm] := Row[{"eq", "(", v, ")"}];
Protect[Root];
a1 = Roots[x^4 + r1 x^3 + r2 x^2 + r3 x + r4 == 0, x][[1]][[2]];
a2 = Roots[x^4 + r1 x^3 + r2 x^2 + r3 x + r4 == 0, x][[2]][[2]];
a3 = (-s2 - Sqrt[s2^2 - 4 s3])/2;
a4 = (-s2 + Sqrt[s2^2 - 4 s3])/2; 
Solve[{a1 - a3 == 0, a2 - a4 == 0}, {s2, s3}]

enter image description here


Addendum

As I understood the question, you hope to simplify the display of a very complicated expression. A common way to do that is to define a Format for the expression. Common examples built in are InterpolatingFunctions and SparseArrays. For example:

enter image description here

The first output is the formatted expression, simply letting you know that this is an InterpolatingFunction. The second is the actual expression; it's not particularly readable or informative, hence the formatted version. The InputForm represents the actual expression for pattern patching and other purposes. My response was intended to show you how to create this type of formatted ouput for your own expressions.

Reading your question and the other response more closely, I see you wish to "force Mathematica to find some similar terms under the radicals and replace them with substitutions". A built in tool to accomplish this is OptimizeExpression in the Experimental context. It's a bit tricky, but here's an example.

For convenience, we prepend two contexts to our $ContextPath.

$ContextPath = Join[{"Experimental`", "Compile`"},
  $ContextPath];

Here's a semi-complicated expression.

expr = x /. First[Solve[
  x^4 - x - 1 == 0, x
]]

enter image description here

Here's the optimized expression.

optExpr = OptimizeExpression[expr]

enter image description here

Note that the result is an OptimizedExpression containing a Block. The final statement of the Block refers to variables local to the block and those variables are themselves potentially complicated expressions. Here's the final statement for this example.

finalOptExpr = Extract[optExpr, {1, 2, -1}, HoldForm]

enter image description here

And here are the names of the variables used in this expression.

optSymbolQ[s_Symbol] := StringTake[ToString[s], 1] == "$";
finalVarNames = Union[ToString /@ 
  Cases[finalOptExpr, _Symbol?optSymbolQ, Infinity]]

(* Out: {"$11", "$5", "$7", "$9"} *)

Thus, the original complicated expression can be written in terms of these four symbols. Those symbols, in turn are the following.

Extract[optExpr, {1, 2}];
Column[# == ToExpression[#] & /@ finalVarNames]

enter image description here

Of course, these are defined in terms of previously defined variables - for example:

$2

enter image description here

Really, though, the point behind OptimizeExpression is to optimize the expression for numerical computation by collecting repetitive sub-parts so that they don't need to be repeatedly evauated. And I do think that there is a limit to how far this can, particuarly for something as complicated as your fourth degree with arbitrary coefficients.

$\endgroup$
4
  • $\begingroup$ Protect[Root]? $\endgroup$ Commented Jan 29, 2013 at 8:22
  • $\begingroup$ @Mark what is eq(1) and eq(2), how can I see them, to make some substitutions for simplifying $\endgroup$ Commented Jan 29, 2013 at 14:26
  • $\begingroup$ @GeorgeMills After setting Quartics->False, the Roots command returns indexed Root objects - delete the Format command to see what I mean. I defined the Format for Root to condense this a bit. Other than that, there's nothing particularly special about the choice of eq. $\endgroup$ Commented Jan 29, 2013 at 14:34
  • 2
    $\begingroup$ @belisarius I like to live dangerously, but I went ahead and added your (wise) suggestion to protect the innocent. $\endgroup$ Commented Jan 29, 2013 at 14:35
3
$\begingroup$

Here's a semi-manual method of simplifying solutions by creating our own substitutions.

As a more manageable example, let's start with the solution to the cubic:

cube = Solve[a x^3 + b x^2 + c x + d == 0, x]

Here's just the first root (TeXForm[x /. cube[[1]]]):

$\frac{\sqrt[3]{\sqrt{\left(-27 a^2 d+9 a b c-2 b^3\right)^2+4 \left(3 a c-b^2\right)^3}-27 a^2 d+9 a b c-2 b^3}}{3 \sqrt[3]{2} a}-\frac{\sqrt[3]{2} \left(3 a c-b^2\right)}{3 a \sqrt[3]{\sqrt{\left(-27 a^2 d+9 a b c-2 b^3\right)^2+4 \left(3 a c-b^2\right)^3}-27 a^2 d+9 a b c-2 b^3}}-\frac{b}{3 a}$

We can create a list of each subexpression in our expression, i.e. branches in the expression tree:

Clear[branches];
branches[b_?AtomQ] := {};
branches[b_?NumericQ] := {};
branches[h_[b___]] := Flatten@Append[branches /@ List[b], h[b]];

It's quite long, so I won't list them all here:

branches[cube] // Length  (*  174  *)

We're probably interested in branches that are a sum of expressions:

Cases[branches[cube], x_ + y_] // Length  (*  30  *)

Let's tally up how common these are and pick out the ones that occur more than once:

TableForm[Reverse /@ Cases[Tally[Cases[branches[cube], x_ + y_]], {_, t_ /; t > 1}]]
  • 9: $\ \ \ -b^2 + 3 a c$
  • 6: $\ \ \ -2 b^3 + 9 a b c - 27 a^2 d$
  • 6: $\ \ \ \left(-27 a^2 d+9 a b c-2 b^3\right)^2+4 \left(3 a c-b^2\right)^3$
  • 6: $\ \ \ \sqrt{\left(-27 a^2 d+9 a b c-2 b^3\right)^2+4 \left(3 a c-b^2\right)^3}-27 a^2 d+9 a b c-2 b^3$

We can now make some sensible substitutions:

cube //. {-b^2 + 3 a c -> s, -2 b^3 + 9 a b c - 27 a^2 d -> t}

The first root is now:

$-\frac{b}{3 a}+\frac{\sqrt[3]{\sqrt{4 s^3+t^2}+t}}{3 \sqrt[3]{2} a}-\frac{\sqrt[3]{2} s}{3 a \sqrt[3]{\sqrt{4 s^3+t^2}+t}}$

where $s = -b^2 + 3 a c$ and $t = -2 b^3 + 9 a b c - 27 a^2 d$.

EDIT:

Iterating this procedure a few times on the original question gives:

$s_2 = \frac{c^{5/3} \left(3 r_1 \left(2 \sqrt{d}+r_1\right)-8 r_2\right)+4 \sqrt[3]{2} c^{4/3} e+4\ 2^{2/3} c \left(2 r_2^3-9 \left(r_1 r_3+8 r_4\right) r_2+27 \left(r_4 r_1^2+r_3^2\right)\right)-8\ 2^{2/3} e^3}{12 c^{5/3} \sqrt{d}}$

where

$a = r_2^2-3 r_1 r_3+12 r_4$

$b = 27 r_4^2 r_1^4+4 r_3^3 r_1^3-18 r_2 r_3 r_4 r_1^3-r_2^2 r_3^2 r_1^2-144 r_2 r_4^2 r_1^2+4 r_2^3 r_4 r_1^2+6 r_3^2 r_4 r_1^2-18 r_2 r_3^3 r_1+192 r_3 r_4^2 r_1+80 r_2^2 r_3 r_4 r_1+27 r_3^4-256 r_4^3+4 r_2^3 r_3^2+128 r_2^2 r_4^2-16 r_2^4 r_4-144 r_2 r_3^2 r_4$

$c = 3 \sqrt{3} \sqrt{b}+2 r_2^3-9 r_1 r_3 r_2-72 r_4 r_2+27 r_3^2+27 r_1^2 r_4$

$d = \frac{\sqrt[3]{2} a}{3 \sqrt[3]{c}}+\frac{\sqrt[3]{c}}{3 \sqrt[3]{2}}+\frac{r_1^2}{4}-\frac{2 r_2}{3}$

$e = r_2^2-3 r_1 r_3+12 r_4$

$\endgroup$
4
  • $\begingroup$ so with this procedure I can express s2 and s3 in my example or they will be big terms? Thanks for your answer. After checking my example I can raise my hands for answer $\endgroup$ Commented Jan 29, 2013 at 20:57
  • $\begingroup$ @GeorgeMills See the edit for what s2 looks like. $\endgroup$
    – wxffles
    Commented Jan 29, 2013 at 21:25
  • $\begingroup$ how can I force Mthematica to make factorizing of the polynom Factor[e1 f1 - e2 f2 - e1 x^2 - f1 x^2 + x^4] Roots[e1 f1 - e2 f2 - e1 x^2 - f1 x^2 + x^4 == 0, x] this doesn't work? $\endgroup$ Commented Jan 29, 2013 at 21:38
  • $\begingroup$ That polynomial doesn't have nice roots, so I'm not sure what you are expecting. Perhaps Times @@ Roots[...] /. x == r_ -> x - r $\endgroup$
    – wxffles
    Commented Jan 29, 2013 at 23:57

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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