Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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]
share|improve this question
add comment

1 Answer 1

up vote 1 down vote accepted
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

share|improve this answer
    
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. –  Nicole Jan 6 at 16:02
    
@Nicole See edit, please –  belisarius Jan 6 at 19:48
    
Brilliant! Thank you so much for your help. –  Nicole Jan 9 at 3:35
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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