2
$\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])
Improve this question
$\endgroup$
7
  • 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, 2017 at 23:02
  • $\begingroup$ note that your second Plot expression is missing a plotting variable and range specification. $\endgroup$
    – MarcoB
    Feb 14, 2017 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, 2017 at 23:19
  • $\begingroup$ ...edit is wrong $\endgroup$
    – Jonathan
    Feb 14, 2017 at 23:20
  • 2
    $\begingroup$ Not good idea to N for argument name as it is used by Mathematica $\endgroup$
    – Nasser
    Feb 14, 2017 at 23:59

1 Answer 1

Reset to default
7
$\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

Improve this answer
$\endgroup$
1
  • $\begingroup$ You can also remove the typo Imporoved in the image too. $\endgroup$
    – zhk
    Mar 9, 2017 at 5:13

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.