0
$\begingroup$

I would like to solve this problem:

smin=Reduce[1000000 Sqrt[2] Abs[1/(a (-2000 + 1000 a))]<=(702.762 s^2)/(Sqrt[
0.25 (1 + 0.5 (-0.2 + 30.4981 Sqrt[1/s^2]) + 930.132/s^2)^2 - 
930.132/s^2] + 
0.5 (1 + 0.5 (-0.2 + 30.4981 Sqrt[1/s^2]) + 930.132/s^2))&&a>0&&a<1,s]

but I think this problem requires a lot of time for Mathematica. Is there any way to solve it?

I would like to obtain an explicit solution fos s in terms of a, e.g. s>=...., and then I would like to use this solution into another relation as a multiplier.

$\endgroup$
  • $\begingroup$ What's the domain of s you're interested in? Reals or complexes? $\endgroup$ – Sjoerd Smit Feb 8 '18 at 16:32
  • $\begingroup$ I'm interested in s>0 $\endgroup$ – Gae P Feb 8 '18 at 16:54
  • $\begingroup$ Then a>0&&a>1 should be s>0&&a>1 ? $\endgroup$ – JimB Feb 8 '18 at 16:59
  • $\begingroup$ Sorry the exact condition is 0<a<1 $\endgroup$ – Gae P Feb 8 '18 at 17:03
1
$\begingroup$
eqn =
 1000000 Sqrt[2] Abs[
       1/(a (-2000 + 1000 a))] <= (702.762 s^2)/(Sqrt[
         0.25 (1 + 0.5 (-0.2 + 30.4981 Sqrt[1/s^2]) + 
              930.132/s^2)^2 - 930.132/s^2] + 
        0.5 (1 + 0.5 (-0.2 + 30.4981 Sqrt[1/s^2]) + 930.132/s^2)) // 
    Rationalize // Simplify[#, 0 < a < 1] & // Simplify[#, s > 0] &

(* -((1000*Sqrt[2])/((-2 + a)*a)) <= (28110480*s^4)/(18602640 + 
        304981*s + 18000*s^2 + Sqrt[346058214969600 + 
            11346903499680*s - 725502749639*s^2 + 
            10979316000*s^3 + 324000000*s^4]) *)

Simplify is used twice rather than combining them in order to accelerate the simplification.

smin = Reduce[eqn && 0 < a < 1 && s > 0, s] // N

(* (Inequality[0., Less, a, LessEqual, 0.00010315517885076623] && 
      s >= Root[155022000000000 + (-108943570764000*Sqrt[2]*
                     a + 54471785382000*Sqrt[2]*a^2)*#1^2 + 
              (-1786075479350*Sqrt[2]*a + 893037739675*Sqrt[2]*a^2)*
                #1^3 + (-105414300000*Sqrt[2]*a + 52707150000*
                     Sqrt[2]*a^2)*#1^4 + (164624809548*a^2 - 
                   164624809548*a^3 + 41156202387*a^4)*#1^6 & , 
          4]) || (0.00010315517885076623 < a < 
        0.008304821610873913 && s >= Root[155022000000000 + 
              (-108943570764000*Sqrt[2]*a + 54471785382000*
                     Sqrt[2]*a^2)*#1^2 + (-1786075479350*Sqrt[2]*a + 
                   893037739675*Sqrt[2]*a^2)*#1^3 + (-105414300000*
                     Sqrt[2]*a + 52707150000*Sqrt[2]*a^2)*#1^4 + 
              (164624809548*a^2 - 164624809548*a^3 + 
                   41156202387*a^4)*#1^6 & , 2]) || (Inequality[
        0.008304821610873913, LessEqual, a, Less, 1.] && 
      s >= Root[155022000000000 + (-108943570764000*Sqrt[2]*
                     a + 54471785382000*Sqrt[2]*a^2)*#1^2 + 
              (-1786075479350*Sqrt[2]*a + 893037739675*Sqrt[2]*a^2)*
                #1^3 + (-105414300000*Sqrt[2]*a + 52707150000*
                     Sqrt[2]*a^2)*#1^4 + (164624809548*a^2 - 
                   164624809548*a^3 + 41156202387*a^4)*#1^6 & , 4]) *)

EDIT:

Clear[f, f2]

f[a_?NumericQ] := Evaluate@Piecewise[{#[[2]], #[[1]]} & /@ (List @@ smin)];

tab = {#, f[#]} & /@ Append[Range[1/40., 39/40., 1/40.], 0.999];

Multicolumn[
 StringForm["a = `1`, `2`",
    NumberForm[#[[1]], {4, 3}],
    NumberForm[#[[2]], {7, 5}]] & /@ tab,
 2, Frame -> All]

enter image description here

pts = {#[[1]], #[[2, -1]]} & /@ tab;

You can use Fit, FindFit, or NonlinearModelFit to convert pts to a polynomial in a.

n = 10; (* order of polynomial *)

coef = Array[c, n + 1];

model = coef.a^Range[0, n];

f2[a_] = NonlinearModelFit[pts, model, coef, a][a]

(* 18.9537 - 218.369 a + 2436.68 a^2 - 16624.1 a^3 + 71222.6 a^4 - 197425. a^5 + 
 358850. a^6 - 424275. a^7 + 313931. a^8 - 131934. a^9 + 24023.7 a^10 *)

Plot[{f[a][[-1]], f2[a]}, {a, 0, 1},
 Filling -> {1 -> Top},
 FillingStyle -> Opacity[0.3, LightBlue],
 AxesLabel -> (Style[#, 14, Bold] & /@ {a, s}),
 Epilog -> {Red, AbsolutePointSize[2], Point[pts]},
 PlotLegends -> Placed["Expressions", {0.75, 0.6}]]

enter image description here

$\endgroup$
  • $\begingroup$ I really do appreciate your help. How can I extract from this output the analytical expression? e.g. s>=a^3+3a+2 ---------- I would obtain a^3+3a+2 $\endgroup$ – Gae P Feb 9 '18 at 14:34
1
$\begingroup$

If you just want to see how it looks, you could try

r = 10;
R = ImplicitRegion[
   1000000 Sqrt[2] Abs[
       1/(a (-2000 + 1000 a))] <= (702.762 s^2)/(Sqrt[
         0.25 (1 + 0.5 (-0.2 + 30.4981 Sqrt[1/s^2]) + 
              930.132/s^2)^2 - 930.132/s^2] + 
        0.5 (1 + 0.5 (-0.2 + 30.4981 Sqrt[1/s^2]) + 930.132/s^2)) && 
    a > 0 && a > 1,
   {{a, -r, r}, {s, -r, r}}];
DiscretizeRegion[R, MaxCellMeasure -> 0.1]

enter image description here

$\endgroup$
1
$\begingroup$

Similar to the approach by @HenrikSchumacher is using a ContourPlot:

ContourPlot[{1000000 Sqrt[2] Abs[1/(a (-2000 + 1000 a))] -
   (702.762 s^2)/(Sqrt[
       0.25 (1 + 0.5 (-0.2 + 30.4981 Sqrt[1/s^2]) + 930.132/s^2)^2 - 
        930.132/s^2] +
      0.5 (1 + 0.5 (-0.2 + 30.4981 Sqrt[1/s^2]) + 930.132/s^2))},
 {s, -10, 10}, {a, 1, 5}, Contours -> {0}, PlotRange -> All, 
 PlotPoints -> 100,
 Frame -> True, FrameLabel -> (Style[#, Bold, 18] &) /@ {"s", "a"}]

Contour plot of inequality

The "blue" area is where the inequality is satisfied.

It is likely that you'll need to set values for a and solve for s (or vice versa) numerically. And there's a problem of dividing by zero when a = 2.

Update: The OP has updated the question to restrict the values of s and a.

ContourPlot[{1000000 Sqrt[2] Abs[1/(a (-2000 + 1000 a))] -
   (702.762 s^2)/(Sqrt[
       0.25 (1 + 0.5 (-0.2 + 30.4981 Sqrt[1/s^2]) + 930.132/s^2)^2 - 
        930.132/s^2] +
      0.5 (1 + 0.5 (-0.2 + 30.4981 Sqrt[1/s^2]) + 930.132/s^2))},
 {s, 0, 20}, {a, 0, 1}, Contours -> {0}, PlotRange -> All, 
 PlotPoints -> 100,
 Frame -> True, FrameLabel -> (Style[#, Bold, 18] &) /@ {"s", "a"}]

Contour plot of updated inequality

$\endgroup$
  • $\begingroup$ Thanks, I would like to obtain the relation between s and a $\endgroup$ – Gae P Feb 8 '18 at 17:21
  • $\begingroup$ You can certainly solve for a in terms of s but not the other way around. $\endgroup$ – JimB Feb 8 '18 at 17:24
  • $\begingroup$ Is it possible to solve for s in terms of a? $\endgroup$ – Gae P Feb 8 '18 at 18:05
  • $\begingroup$ You can certainly solve for s for specific values of a (numerically) but I don't think there's a general explicit solution. If you described (in your original question - rather than in comments) your expected use of such a solution, then maybe an approximation might satisfy that need. This seems likely because of the restricted range of a. $\endgroup$ – JimB Feb 8 '18 at 18:13
0
$\begingroup$

If the equation (ContourPlot answer JimB) is squared one can solve for a

eq = Simplify[(1000000 Sqrt[2] Abs[
    1/(a (-2000 + 1000 a))])^2 == ((702.762 s^2)/(Sqrt[
      0.25 (1 + 0.5 (-0.2 + 30.4981 Sqrt[1/s^2]) + 
           930.132/s^2)^2 - 930.132/s^2] + 
     0.5 (1 + 0.5 (-0.2 + 30.4981 Sqrt[1/s^2]) + 
        930.132/s^2)))^2 /. Abs[z_]^2 -> z^2]
erga = Simplify[Solve[%, a]];
Plot[a /. erga, {s, 0, 20}, AxesLabel -> {s, a}, PlotRange -> {0, 5}]

enter image description here

Obviously only s=Function[a]is well defined(s>0).

$\endgroup$
-1
$\begingroup$

FindInstance is your friend

eq = Rationalize[
   1000000 Sqrt[2] Abs[1/(a (-2000 + 1000 a))] <= (702.762 s^2)/(Sqrt[
        0.25 (1 + 0.5 (-0.2 + 30.4981 Sqrt[1/s^2]) + 930.132/s^2)^2 - 
         930.132/s^2] + 0.5 (1 + 0.5 (-0.2 + 30.4981 Sqrt[1/s^2]) + 930.132/s^2)), 0];
FindInstance[eq && 0 < a < 1 && s > 0, {s, a}]
{{s -> 256, a -> 3/65536}}

eq /. %
{True}
$\endgroup$
  • $\begingroup$ That gives only one value, it does actually solve the equation (whose solution set is a curve). $\endgroup$ – anderstood Feb 8 '18 at 20:27

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.