find where 3 inequalities are simultaneously greater than zero

Question

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

Artes · Answer 1 · 2013-05-12T20:19:02.060

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]

enter image description here

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

enter image description here

Refine[ %, x >= 0]

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

enter image description here

Refine[%, x < 0]

[Plot[{f11[x], f12[x], f13[x]}, {x, -10, 10}, Axes -> False, Frame -> True, PlotStyle -> {Red, Blue, Green}]](http://i.stack.imgur.com/nsTMX.png) — Dr. belisarius, May 11 '13 at 20:05
@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 http://mathematica.stackexchange.com/questions/17127/what-is-the-difference-between-reduce-and-solve/17129#17129 — Artes, May 11 '13 at 22:55

score 1 · Answer 2 · answered May 11 '13 at 20:53

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

enter image description here

And

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

find where 3 inequalities are simultaneously greater than zero

2 Answers2

Linked