0
$\begingroup$

I have effectively 1 differential equation that had to be broken up into 2 (max number of steps reached). I have gotten the solutions for both using NDSolve and have plotted each together. Now, I am trying to animate this solution using Manipulate for each differential equation and then use Show to plot the two together. Ideally, Manipulate would then go through the independent variable (starts at beginning of domain from first interpolating function and goes to end of domain of the second interpolating function) that commands both solutions producing a continuous plot. Unfortunately, Show will not combine these two - I am getting two graphs next to one another. How can I achieve the result I desire? Thanks in advance for any help. I have spent days trying to figure out how to do this - even attempting quite unsuccessfully to extract results and put into a data table.

g1 = NDSolve[{r'[ϕ] == Sin[ArcCot[2/r[ϕ]]]*Sqrt[6 - r[ϕ]^2 - 1/r[ϕ]^2],  r[0] == 1}, r, {ϕ, 0, 4}]
g2 = NDSolve[{r'[ϕ] == -Sin[ArcCot[2/r[ϕ]]]* Sqrt[6 - r[ϕ]^2 - 1/r[ϕ]^2], 
             r[ 1.7775896893621104`] == 2.41421}, 
             r, {ϕ, 1.7775896893621104`, 5}]
v1 = RevolutionPlot3D[x^2, {x, 0, 3}, PlotStyle -> Opacity[0.4], Mesh -> None]
w1 = Manipulate[
  ParametricPlot3D[
   Evaluate[{1/r[ϕ] Cos[ϕ], 1/r[ϕ] Sin[ϕ], 1/r[ϕ]^2} /. g1], {ϕ, 0.000001, a}, 
   PlotRange -> {{-3, 3}, {-3, 3}, {0, 3}}, PlotStyle -> Thick, 
   Evaluated -> True], {a, 0.0, 1.7775640272780204}]
w2 = Manipulate[
  ParametricPlot3D[
   Evaluate[{1/r[ϕ] Cos[ϕ], 1/r[ϕ] Sin[ϕ], 1/r[ϕ]^2} /. g2], {ϕ, 1.77758968936211, a}, 
   PlotRange -> {{-3, 3}, {-3, 3}, {0, 3}}, PlotStyle -> Thick, 
   Evaluated -> True], {a, 1.7775896893621104, 4.925661999190314}]
Show[v1, w1, w2]
$\endgroup$
0

1 Answer 1

1
$\begingroup$
g1 = NDSolve[{r'[ϕ] == Sin[ArcCot[2/r[ϕ]]]*Sqrt[6 - r[ϕ]^2 - 1/r[ϕ]^2], r[0] == 1}, 
             r, {ϕ, 0, 4}, 
             Method -> "StiffnessSwitching", 
             MaxSteps -> 10^5];

But please be aware of:

Plot[{Re@r[t], 100 Im@r[t]} /. g1, {t, 0, 4}, Evaluated -> True, 
      PlotRange -> Full]

Mathematica graphics

Edit

I don't like the following, but it seems what you're after:

g1 = Quiet@NDSolve[{r'[ϕ] == Sin[ArcCot[2/r[ϕ]]]*Sqrt[6 - r[ϕ]^2 - 1/r[ϕ]^2], r[0] == 1}, 
                  r, {ϕ, 0, 4}]
g2 = Quiet@NDSolve[{r'[ϕ] == -Sin[ArcCot[2/r[ϕ]]]*Sqrt[6 - r[ϕ]^2 - 1/r[ϕ]^2], 
                   r[1.7775896893621104`] == 2.41421}, r, {ϕ, 1.7775896893621104`, 5}]
lim = 1.77758968936211;
eps = $MachineEpsilon;
Manipulate[
 If[a < lim, a1 = a; a2 = lim + eps, a1 = lim; a2 = a];
 Show[
  ParametricPlot3D[{1/r[ϕ] Cos[ϕ], 1/r[ϕ] Sin[ϕ], 1/r[ϕ]^2} /. g1, {ϕ, eps, a1}, 
                   PlotRange -> {{-3, 3}, {-3, 3}, {0, 3}}, PlotStyle -> Thick, Evaluated -> True],
  ParametricPlot3D[{1/r[ϕ] Cos[ϕ], 1/r[ϕ] Sin[ϕ], 1/r[ϕ]^2} /. g2, {ϕ, lim, a2}, 
                   PlotRange -> {{-3, 3}, {-3, 3}, {0, 3}}, PlotStyle -> Thick, Evaluated -> True],
  RevolutionPlot3D[x^2, {x, 0, 3}, PlotStyle -> Opacity[0.4], Mesh -> None]],
 {a, 0.0 , 4.925661999190314}]

Mathematica graphics

$\endgroup$
3
  • $\begingroup$ Thank you for your prompt response. I apologize - I think the description of my issue was a little confusing. My issue isn't related to any problems in solving a differential equation (stiffness, max steps, etc.) I really just need to combine these two differential equation solutions into one graph that can be animated (perhaps using Manipulate) to continuously increase the angle of rotation phi - the final result would look sort of like an orbit. $\endgroup$
    – Nicole
    Jan 6, 2014 at 16:02
  • $\begingroup$ @Nicole See edit, please $\endgroup$ Jan 6, 2014 at 19:48
  • $\begingroup$ Brilliant! Thank you so much for your help. $\endgroup$
    – Nicole
    Jan 9, 2014 at 3:35

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.