0
$\begingroup$

To an earlier problem, @Rhermans provided the following solution:

With[{Pt = 0.5, σ = 0.1, S = 1}, 
   FindRoot[1/(6 σ^2 (-1 + w) w) S ((Log[Sqrt[3] σ + Pt] -
      Log[Pt + Sqrt[3] σ (1 - 2 w)]) Pt (Sqrt[3] σ + Pt) - (6 σ^2 + 
       Sqrt[3] σ (Log[-Sqrt[3] σ + Pt] + Log[Sqrt[3] σ + Pt] - 2 Log[Pt + Sqrt[3] σ (1 - 2 w)]) Pt + (-Log[-Sqrt[
          3] σ + Pt] + Log[Sqrt[3] σ + Pt]) Pt^2) w + 6 σ^2 w^2) == 0, {w, 0.5}]]

How can I proceed and create a Plot of many such solutions by letting Pt, say, vary while holding other variables constant?

$\endgroup$
3
  • 1
    $\begingroup$ With[{σ = 0.1, S = 1}, ListPlot@Table[{Pt, w /. FindRoot[..]}, {Pt, 0., 1., 0.1}]]? We might need more details to give better help. $\endgroup$ – Michael E2 Aug 10 '18 at 17:23
  • $\begingroup$ @Michael E2 This is almost what I had imagined. I had imagined (somehow) connecting solutions with a line such that (with enough precision, I guess) the observer could not tell if the solution was derived exactly from Solve or from FindRoot. $\endgroup$ – user120911 Aug 10 '18 at 18:01
  • $\begingroup$ ListLinePlot instead of ListPlot or ListPlot[Table[...], Joined ->True]. $\endgroup$ – Michael E2 Aug 10 '18 at 19:00
2
$\begingroup$

You can use NDSolveValue to create an interpolating function of w[Pt]. First, we construct the ODE:

eqn = Block[{σ=.1, S=1},
    1/(6 σ^2 (-1+w) w) S ((Log[Sqrt[3] σ+Pt]-Log[Pt+Sqrt[3] σ (1-2 w)]) Pt (Sqrt[3] σ+Pt)-(6 σ^2+Sqrt[3] σ (Log[-Sqrt[3] σ+Pt]+Log[Sqrt[3] σ+Pt]-2 Log[Pt+Sqrt[3] σ (1-2 w)]) Pt+(-Log[-Sqrt[3] σ+Pt]+Log[Sqrt[3] σ+Pt]) Pt^2) w+6 σ^2 w^2)==0
] /. w->w[Pt];

To use NDSolveValue, we need an initial condition:

w5 = w[.5] /. FindRoot[eqn /. Pt->.5, {w[.5], .5}]

0.409537

Using NDSolveValue:

sol = NDSolveValue[{D[eqn, Pt], w[.5]==w5}, w, {Pt, 0, 1}];

Visualization:

Plot[sol[t], {t, 0, 1}, PlotRange->All]

enter image description here

$\endgroup$
1
  • $\begingroup$ Hmm, sol = NDSolveValue[{eqn, v'[Pt] == 1, v[0.5] == 0.5}, w, {Pt, 0, 1}] also works, but if v is changed to x, it does not. Actually if the dummy variable name starts with x, y or z, it fails; otherwise, it succeeds (well, for as many as I checked). I've used the NDSolveValue/NDSolve method with both ODEs and DAEs in answers several times on this site and so have you. Every time it comes up again, I feel like there should be a suitable duplicate, but I have trouble finding one. (+1) $\endgroup$ – Michael E2 Aug 10 '18 at 19:38
2
$\begingroup$

I changed the code to automatically achieve the desired accuracy. Added a couple of pictures to illustrate the behavior of the function

f[Pt_, \[Sigma]_, S_] := 
 w /. Block[{$MinPrecision = 200, $MaxPrecision = 200}, 
   FindRoot[
    1/(6 \[Sigma]^2 (-1 + w) w) S ((Log[Sqrt[3] \[Sigma] + Pt] - 
           Log[Pt + Sqrt[3] \[Sigma] (1 - 2 w)]) Pt (Sqrt[
             3] \[Sigma] + Pt) - (6 \[Sigma]^2 + 
           Sqrt[3] \[Sigma] (Log[-Sqrt[3] \[Sigma] + Pt] + 
              Log[Sqrt[3] \[Sigma] + Pt] - 
              2 Log[Pt + 
                 Sqrt[3] \[Sigma] (1 - 2 w)]) Pt + (-Log[-Sqrt[
                    3] \[Sigma] + Pt] + 
              Log[Sqrt[3] \[Sigma] + Pt]) Pt^2) w + 
        6 \[Sigma]^2 w^2) == 0, {w, 1/2}, PrecisionGoal -> 200, 
    WorkingPrecision -> Automatic]]
Table[{Pt, f[Pt, 0.1`20, 1`20]}, {Pt, .5, 1, .01}]
{Plot[f[Pt, 1/10, 1], {Pt, 0, 1}, PlotRange -> All, 
  AxesLabel -> {"Pt", ""}], 
 Plot[f[1/2, \[Sigma], 1], {\[Sigma], 0, 1}, PlotRange -> All, 
  AxesLabel -> {"\[Sigma]", ""}]}

fig1

$\endgroup$
2
  • $\begingroup$ I had imagined (somehow) connecting solutions with a line. Is that possible, or am I confined to using dots? $\endgroup$ – user120911 Aug 10 '18 at 18:03
  • $\begingroup$ Added a couple of pictures to illustrate the behavior of the function $\endgroup$ – Alex Trounev Aug 11 '18 at 3:42

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.