1
$\begingroup$

Population growth in Mathematica with NDSolve:

f[r_, a_, T_] := NDSolve[{x' t] == r*x[t]*(1 - x[t]), x[0] == a}, x, {t, 0, T}]

s1 = f[0.1, 0.5, 30];
s2 = f[0.1, 2, 30];

Plot[{x[t] /. s1, x[t] /. s2, 1}, {t, 0, 30}, PlotRange -> {0, 2}]
Plot[Evaluate[Table[x[t] /. f[0.3, 0.2 n, 10], {n, 1, 10}]], PlotRange -> {0, 2}]

How can we solve it with Improved Euler's method?

P[q_, h_, N_] := (
  u[0] = 1; 
  Do[u[n + 1] = u[n] + h*f[n*h + (h*q/2), u[n] + (h*q/2)*f[n*h, u[n]]], {n, 0, N}]
 )

f[x_, t_] := r*x[t]*(1 - x[t])
$\endgroup$
  • 1
    $\begingroup$ It looks like you've already written down some code that's supposed to implement the "improved Euler's method". What exactly is your question? If it's not working, can you explain how? Please provide more details. $\endgroup$ – march Feb 14 '17 at 23:02
  • $\begingroup$ note that your second Plot expression is missing a plotting variable and range specification. $\endgroup$ – MarcoB Feb 14 '17 at 23:13
  • $\begingroup$ Take a look at this answer for an implementation of Euler's method; the same answer also contains a link to a document that discusses a similar implementation of the Improved Euler Method ("Método Euler Mejorado") in the file. Although the file is in Spanish, the code is pretty self-explanatory. $\endgroup$ – MarcoB Feb 14 '17 at 23:19
  • $\begingroup$ ...edit is wrong $\endgroup$ – Jonathan Feb 14 '17 at 23:20
  • 2
    $\begingroup$ Not good idea to N for argument name as it is used by Mathematica $\endgroup$ – Nasser Feb 14 '17 at 23:59
6
$\begingroup$

generate Improved Euler steps:

makeTableRk2Sub[h_, from_, to_, y0_] := 
 Module[{nSteps = Round[(to - from)/h], data, t, y, k1, k2, predictor,
    tbl},
  Array[y, nSteps, 0];
  Array[t, nSteps, 0];
  y[0] = y0; t[0] = from;

  Do[(*Improved Euler loop*)
   k1 = f[t[n], y[n]];
   predictor = y[n] + h k1;
   t[n + 1] = t[n] + h;
   k2 = f[t[n + 1], predictor];
   y[n + 1] = y[n] + h (1/2*(k1 + k2)),
   {n, 0, nSteps}
   ];
  tbl = Table[{t[n], y[n]}, {n, 0, nSteps}]
  ]

To use (red is NDSolve and blue is improved Euler with large step size)

f[t_, y_] := t^2 + y^2; 
h = 0.3; from = 0; to = 5*h; y0 = 0;
tbl = makeTableRk2Sub[h, from, to, y0];
sol = NDSolve[{y'[t] == t^2 + y[t]^2, y[0] == 0}, y, {t, from, to}];
p1 = ListLinePlot[tbl, Mesh -> All];
p2 = Plot[Evaluate[y[t] /. sol], {t, from, to}, PlotStyle -> Red, 
   Frame -> True, FrameLabel -> {{"y(t)", None}, {"t", 
      "Comparing Improved Euler to NDSolve"}}, GridLines -> Automatic,
    GridLinesStyle -> LightGray, BaseStyle -> 14];

Show[Legended[p2, Style["NDsolve", Red]],Legended[p1, Style["Improved Euler", Blue]]]

Mathematica graphics

$\endgroup$
  • $\begingroup$ You can also remove the typo Imporoved in the image too. $\endgroup$ – zhk Mar 9 '17 at 5:13

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.