# Mathematica Improved Euler's Method

Population growth in Mathematica with NDSolve:

f[r_, a_, T_] := NDSolve[{x' t] == r*x[t]*(1 - x[t]), x == 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 = 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])

• 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. Feb 14, 2017 at 23:02
• note that your second Plot expression is missing a plotting variable and range specification. Feb 14, 2017 at 23:13
• 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. Feb 14, 2017 at 23:19
• ...edit is wrong Feb 14, 2017 at 23:20
• Not good idea to N for argument name as it is used by Mathematica Feb 14, 2017 at 23:59

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 = y0; t = 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}, 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]]] • You can also remove the typo Imporoved in the image too.
– zhk
Mar 9, 2017 at 5:13