0
$\begingroup$

I would be very grateful if anyone could help with manipulating the solution to the system of differential equations below. I've tried just about everything I can think of all to no avail. The code doesn't seem to be working (i.e. the parameters I'm trying to adjust have no effect on the dynamics of the graphs which can't be right-I computed other values myself and it gave a different plot). I have had a look at some similar topics like Manipulate a Differential Equation result but its quite specific for single differential equations rather than a system of equations. The variables I'd like to vary are mhigh, s0, p0 and z0.

My code is given below:

Needs["PlotLegends`"];

De = 2.1; 
B = 2.3;
B2 = 0.001; 
mhigh = 0.001, mlow = 0.0004;
fr = 0.77, fs = 1, fp = 1.4; 
s0 = 1000; 
z0 = 1000; 
p0 = 0; 
r0 = 0; 

solutionN2 = 
  NDSolve[{
    Z'[t] == De*(S[t] + P[t] + R[t]) - B*Z[t]*((fs*S[t]) + (fp*P[t]) + (fr*R[t])), 
    S'[t] == fs*B* S[t]*Z[t] - (mlow + mhigh)*S[t] - De *S[t], 
    P'[t] == fp* B* P[t]*Z[t] + mlow *S[t] - B2* P[t] - De* P[t], 
    R'[t] == fr *B* R[t]*Z[t] + mhigh* S[t] + B2 *P[t] - De *R[t], 
    S[0] == s0, P[0] == p0, 
    R[0] == r0, Z[0] == z0}, 
    {S, P, R, Z}, {t, 0, 200}];

 Manipulate[
   Plot[{Z[t] /. solutionN2, S[t] /. solutionN2, P[t] /. solutionN2, R[t] /. solutionN2}, 
     {t, 0, 200}, 
     ImageSize -> {700}, 
     PlotStyle -> {Brown, Red, Blue, Darker[Green]}, 
     PlotLegend -> {"Z", "S", "P", "R"}, LegendPosition -> {0.2, -0.2}, 
     FrameLabel -> {Style["time (in days)", Medium]}], 
  {{s0, 1000, s0:initial sus pop"}, 0, 5000, 
    ImageSize -> {Tiny}, Appearance -> "Labeled"}, 
  {{z0, 0, z0:initial resources"}, 0, 5000, 
    ImageSize -> {Tiny}, Appearance -> "Labeled"}, 
  {{p0, 0, p0:initial p. sus. pop"}, 0, 1000,
    ImageSize -> {Tiny}, Appearance -> "Labeled"}, 
  {{mhigh, (0.001), "mut. rate"}, 0, 0.01, 
    ImageSize -> {Tiny}, Appearance -> "Labeled"}]

Please bear with me as I'm a beginner with Mathematica. As stated, any useful help would be so much appreciated as Ive spent nearly the whole day trying to sort this out.

$\endgroup$
  • $\begingroup$ Im using version 9- I assumed I still needed to include it because it wasn't recognizing some functions associated with it. $\endgroup$ – John_dydx Jul 29 '13 at 21:48
2
$\begingroup$

This fixes all your problems. Now you have to work on your NDSOlve itself more, as it seems not efficient.

First, do not use global variables. Put all local variables inside a Module, and put this Module inside Manipulate. Only put variables that are control variables outside of this Module. Before, you had global variables and the same symbols were used as control variables.

Put all the code inside Manipulate. Put any helper Modules in the Initialization section of Manipulate.

The overall flow should be Manipulate[ expression, controlVariable, InitializationCode]

I made the ContinuousAction -> False since your NDsolve is very slow. This way, you will be able to move the slider, and expression will be evaluate only once, after you release the slider.

Needs["PlotLegends`"];(*not needed in V9, have to update the code below if removed*)
Manipulate[     
 Module[{solutionN2, z, t, p, r, s, De = 2.1, B = 2.3, B2 = 0.001, 
   mlow = 0.0004, fr = 0.77, fs = 1, fp = 1.4},

  solutionN2 = NDSolve[{z'[t] == De*(s[t] + p[t] + r[t]) - 
       B*z[t]*((fs*s[t]) + (fp*p[t]) + (fr*r[t])),
     s'[t] == fs*B*s[t] z[t] - (mlow + mhigh) s[t] - De s[t],
     p'[t] == fp B*p[t]*z[t] + mlow s[t] - B2 p[t] - De*p[t],
     r'[t] == fr B r[t] z[t] + mhigh s[t] + B2*p[t] - De*r[t],
     s[0] == s0, p[0] == p0, r[0] == r0, z[0] == z0},
    {s, p, r, z}, {t, 0, 200}];

  Plot[{z[t] /. solutionN2, s[t] /. solutionN2, p[t] /. solutionN2, 
    r[t] /. solutionN2}, {t, 0, 200},
   ImageSize -> {300, 300}, PlotStyle -> {Brown, Red, Blue, Darker[Green]},
   PlotLegend -> {"Z", "S", "P", "R"}, LegendPosition -> {0.2, -0.2},
   FrameLabel -> {Style["time (in days)", Medium]}
   ]
  ],
 {{s0, 1000, "initial sus pop"}, 0, 5000, ImageSize -> Tiny,Appearance -> "Labeled"},
  {{z0, 0, "initial resources"}, 0, 5000, ImageSize -> Tiny,Appearance -> "Labeled"},
 {{p0, 0, "initial p.sus.pop"}, 0, 1000, ImageSize -> Tiny,Appearance -> "Labeled"}, 
 {{r0, 0, "initial r0"}, 0, 1000, ImageSize -> Tiny, Appearance -> "Labeled"}, 
 {{mhigh, 0.001, "mut.rate"}, 0, 0.01, ImageSize -> Tiny,Appearance -> "Labeled"},

 SynchronousUpdating -> False,
 Alignment -> Center, SynchronousInitialization -> True, ContinuousAction -> False,
 Alignment -> Center, ControlPlacement -> Left     
 ]

Mathematica graphics

$\endgroup$
  • $\begingroup$ Thanks so much Nasser, you've made my day! It works now!Any ideas how I can make NDSolve more efficient? $\endgroup$ – John_dydx Jul 29 '13 at 21:59
  • $\begingroup$ Just by removing PlotLegends and LegendPosition, the code is now faster and the manipulate works well. $\endgroup$ – John_dydx Jul 29 '13 at 22:36
1
$\begingroup$

So, I can't actually run your code. There seem to be some syntax problems. But I've written up a a simple working example of manipulating coefficients in a system of differential equations. The key is to have your NDSolve[]s within the Manipulate[]. Otherwise you're plotting solutions that have already been calculated and can't be changed.

Manipulate[
 {Solns = 
   NDSolve[{z'[t] == a*q[t], z[0] == 1, q'[t] == q''[t], q[0] == 10, 
     q'[0] == 5}, {z, q}, {t, 0, 5}],
  Plot[{z[t] /. Solns, q[t] /. Solns}, {t, 0, 5}]}, {a, 0, 5}]

Also worth noting: PlotLegends can be hella' slow. Enough so that it bogs down Manipulate. At least, it was in the older version of Mathematica. I'm not sure if it's been improved in 9.

$\endgroup$
  • $\begingroup$ Thanks for your explanation Ben, much appreciated! I'll see if I can do without the PlotLegends. $\endgroup$ – John_dydx Jul 29 '13 at 22:03

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.