# find where 3 inequalities are simultaneously greater than zero

I have 3 functions: f11[l], f12[l] and f13[l], and I would like to know for which values of l these 3 functions are greater than zero. How do I do it analytically or numerically or graphically in Mathematica?
For some of the functions I want to consider only the real part.

Example:

f11[l] = Root[ 54 + 9 Sqrt[6] l + (-108 - 15 Sqrt[6] l) #1 +
(72 + 7 Sqrt[6] l) #1^2 + (-20 - Sqrt[6] l) #1^3 + 2 #1^4 &, 1];

f12[l] = Root[ 54 + 9 Sqrt[6] l + (-108 - 15 Sqrt[6] l) #1 +
(72 + 7 Sqrt[6] l) #1^2 + (-20 - Sqrt[6] l) #1^3 + 2 #1^4 &, 2];

f13[l] = Root[ 54 + 9 Sqrt[6] l + (-108 - 15 Sqrt[6] l) #1 +
(72 + 7 Sqrt[6] l) #1^2 + (-20 - Sqrt[6] l) #1^3 + 2 #1^4 &, 3];

• Just to complement, an example of my functions is: f11[l]=Root[54 + 9 Sqrt[6] l + (-108 - 15 Sqrt[6] l) #1 + (72 + 7 Sqrt[6] l) #1^2 + (-20 - Sqrt[6] l) #1^3 + 2 #1^4 &, 1]; f12[l]=Root[54 + 9 Sqrt[6] l + (-108 - 15 Sqrt[6] l) #1 + (72 + 7 Sqrt[6] l) #1^2 + (-20 - Sqrt[6] l) #1^3 + 2 #1^4 &, 2]; f13[l]=Root[54 + 9 Sqrt[6] l + (-108 - 15 Sqrt[6] l) #1 + (72 + 7 Sqrt[6] l) #1^2 + (-20 - Sqrt[6] l) #1^3 + 2 #1^4 &, 3]; – Elisa May 11 '13 at 19:51
• I tried Solve, of course and nothing. I tried reduce for each of the equations alone and got a resulta that is wrong. hehehehe I just needed for which values of l all 3 are greater than zero. Even if it is graphically only. – Elisa May 11 '13 at 19:58

Since all the functions are roots of the same polynomial, a recommended approach uses a definition of one function instead of defining them separately. Thus I'd rather proceed along this way:

f[x_, k_Integer] /; 1 <= k <= 4 :=
Root[ 54 + 9 Sqrt[6] x + (-108 - 15 Sqrt[6] x) #1 + (72 + 7 Sqrt[6] x) #1^2
+ (-20 - Sqrt[6] x) #1^3 + 2 #1^4 &, k]


This definition (using patterns, see FullForm[f[x_, k_Integer]]) allows usage of different symbols unlike yours, e.g. f11 must be called only with l, moreover we have:

f11[l] == f[l, 1]

True


We restricted k to the range {1, 2, 3, 4} with Condition (shorthand /;) because there are 4 roots of your polynomial.

Now, the function you need is Reduce, it is very powerful and for these functions there is no need for further search. Solve is not appropriate when one is looking for resolving inequalities since it gives (because of the output in terms of replacement rules) :

Solve[ Table[ f[x, k] > 0, {k, 4}], x]

 Solve::fulldim: The solution set contains a full-dimensional component;
use Reduce for complete solution information. >>

{{}}

Reduce[ Table[ f[x, k] > 0, {k, 4}], x]

 x > -Sqrt[6]


We supplement the symbolic result with a graphics demonstrating how the functions depend on x. The main difficulty here is an appropriate choice of PlotStyle for every curve in order to provide a clear presentation, their graphs are plotted with dashed lines, while the domain where all the functions are non-negative with a thick magenta line:

Plot[ Table[ f[x, k], {k, 4}], {x, -7, 7}, Evaluated -> True, PlotStyle -> Table[
{Thick, Sequence @@ c}, {c, {{Dashed, Red}, {Dashing[0.02], Cyan},
{Dashing[0.03], Blue}, {Dashing[0.02], Green}}}],
Epilog -> {Thickness[0.008], Darker @ Magenta, Line[{{-Sqrt[6], 0}, {6.5, 0}}]},
PlotRange -> {-1.5, 4.5}, AxesStyle -> Arrowheads[0.05],
PlotLegends -> {"f1(x)", "f2(x)", "f3(x)", "f4(x)"}, ImageSize -> 600]


From the plot we can see that we might be interested in the differences f[x, 2] - f[x, 3] as well as f[x, 4] - f[x, 3]:

FullSimplify[f[x, 2] - f[x, 3], x >= -3] // TraditionalForm


Refine[ %, x >= 0]

 0

FullSimplify[ f[x, 4] - f[x, 3], x >= -3] // TraditionalForm


Refine[%, x < 0]

 0

• [Plot[{f11[x], f12[x], f13[x]}, {x, -10, 10}, Axes -> False, Frame -> True, PlotStyle -> {Red, Blue, Green}]](i.stack.imgur.com/nsTMX.png) – Dr. belisarius May 11 '13 at 20:05
• Thank you very much!!!! I worked perfectly! – Elisa May 11 '13 at 22:42
• @Elisa You are welcome, note that you could use Solve if you restrict to a bounded range of integers, e.g. Solve[f11[x] > 0 && f12[x] > 0 && f13[x] > 0 && x < 10, x, Integers]. For more complete discussion you could look here mathematica.stackexchange.com/questions/17127/… – Artes May 11 '13 at 22:55

The following is also useful:

f11[l_] := Root[54 + 9 Sqrt[6] l + (-108 - 15 Sqrt[6] l) #1 + (72 + 7 Sqrt[6] l) #1^2
+ (-20 - Sqrt[6] l) #1^3 + 2 #1^4 &, 1]

f12[l_] := Root[54 + 9 Sqrt[6] l + (-108 - 15 Sqrt[6] l) #1 + (72 + 7 Sqrt[6] l) #1^2
+ (-20 - Sqrt[6] l) #1^3 + 2 #1^4 &, 2]

f13[l_] := Root[54 + 9 Sqrt[6] l + (-108 - 15 Sqrt[6] l) #1 + (72 + 7 Sqrt[6] l) #1^2
+ (-20 - Sqrt[6] l) #1^3 + 2 #1^4 &, 3]

Framed@Column[FullSimplify[#@x, Assumptions -> Element[x, Reals]] & /@ {f11, f12, f13}]


And

Plot[{f11[x], f12[x], f13[x]}, {x, -10, 10}, Axes -> False, Frame -> True,
PlotStyle -> {Red, Blue, Green}]