2
$\begingroup$

I just want to solve the below polynomial for real roots only, where I have mentioned the conditions on all variables, a,d,m,L.

FFF4[x_, a_, d_, m_, L_] =  Refine[a x^4 +   4 a (1 - d) x^3 + (1 + a m^2 L^2 + 10 a + 5 a d +  a d^2) x^2 + (6 a - d - 3 a d + a d m^2 L^2) x -  m^2  L^2, {Element[L, Reals], Element[m, Reals], Element[a, Reals],Element[d, Integers], L > 0, a > 0, m > o, d > 0}]

Next I tried to solve this, and got the four roots

Sol = Solve[FFF4[x, a, d, m, L] == 0, x];

However, now I need to find the smallest root. We have choice to fix d=4 and a=0.1. How can I find the smallest root here?

And if I modify my code like

Sol = Solve[FFF4[x, a, d, m, L] == 0, x, Reals];

Mathematica takes so much time and does not give any input.

$\endgroup$

2 Answers 2

7
$\begingroup$

If there's a real root, then Root[polyfunc, 1] represents the smallest one and takes only a few milliseconds to compute:

Root[fff4[#, a, d, m, L] &, 1]
(*
  Root[-L^2 m^2 + (6 a - d - 3 a d + a d L^2 m^2) #1 + (1 + 10 a + 
        5 a d + a d^2 + a L^2 m^2) #1^2 + (4 a - 4 a d) #1^3 + 
     a #1^4 &, 1]
*)

To get a numeric value:

Root[fff4[#, a, d, m, L] &, 1] /.
 {d -> 4, a -> 1/10, L -> 1, m -> 2} // N
(*  -0.579658  *)

If you want algebraic formulas representing the least root, then expect a complicated dependence on the parameters that may take a long time to compute. The Root[] object can be manipulated symbolically and numerically and is more efficient. If you have a question about how to use it in a specific way, post another question to the site.

Example:

r1 = Root[fff4[#, a, d, m, L] &, 1] /. {d -> 4, a -> 0.1};
Plot3D[r1, {m, 0, 4}, {L, 0, 4}]
$\endgroup$
3
  • $\begingroup$ Thanyou Very much #Michael E2. But if i want to save this data in a table form, because later i want to guess what are the lowest possible values of m and L. For the smallest real root? $\endgroup$
    – Immy Salam
    Nov 8, 2021 at 10:32
  • 1
    $\begingroup$ @ImmySalam Replace Plot3D by Table in the example. Look up Table for to adjust it. To find the smallest root, look up FindMinimum, but it looks like that wouldn’t exist (would approach the Limit as m and `L approach infinity). $\endgroup$
    – Michael E2
    Nov 8, 2021 at 12:08
  • 1
    $\begingroup$ This seems to give the correct minimum: r1 = Root[fff4[#, a, d, m, L] &, 1] /. {d -> 4, a -> 1/10}; MinValue[{r1, m > 0 && L > 0}, {m, L}] $\endgroup$
    – Michael E2
    Nov 8, 2021 at 12:51
4
$\begingroup$
Clear["Global`*"]

$Version

(* "12.3.1 for Mac OS X x86 (64-bit) (June 19, 2021)" *)

FFF4[x_, a_, d_, m_, L_] = 
  a x^4 + 
   4 a (1 - d) x^3 + (1 + a m^2 L^2 + 10 a + 5 a d + a d^2) x^2 + (6 a - d - 
      3 a d + a d m^2 L^2) x - m^2 L^2;

Put the constraints in the Solve

sol = Solve[{FFF4[x, a, d, m, L] == 0, 
  L > 0, a > 0, m > 0, d > 0}, x, Reals];

Length@sol

(* 4 *)

(sol2 = Select[sol /. {d -> 4, a -> 1/10}, FreeQ[#, Undefined] &]) // Grid

enter image description here

To get numeric values you must also specify L and m

(sol3 = Select[sol /. {d -> 4, a -> 1/10, L -> 1, m -> 2}, 
   FreeQ[#, Undefined] &])

enter image description here

The smallest root is the first one

sol3[[1]] // N

(* {x -> -0.579658} *)

Show[
 Plot3D[Evaluate[x /. sol2],
  {m, 0, 5}, {L, 0, 5},
  PlotStyle -> Opacity[0.8],
  AxesLabel -> (Style[#, 12, Bold] & /@
     {m, L, x}),
  PlotLegends -> Automatic],
 Graphics3D[
  {Red, AbsolutePointSize[6],
   Point[{m, L, x} /. {L -> 1, m -> 2} /. sol3]}]]

enter image description here

$\endgroup$

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.