Implementing Picard's Iteration for solving ODEs
The answers by march and John McGee become very slow for larger numbers of iteration, to the extent that I had to abort the calculations when going to 7
or 8
iterations.
The reason is that Integrate
appears to be trying too many unnecessary simplifications at each level, and these steps proliferate because the integrals are iterated.
The following makes the calculations much faster - by many orders of magnitudes for large iterations. I assume that the initial condition is given at x=0
, so the lower integration limit is always 0
.
Clear[picardSeries, iterate];
iterate[initial_, flow_, psi_, n_, t_] :=
initial +
Expand@Apply[Subtract,
Assuming[{Subscript[t, n + 1] > 0},
Integrate[flow[Subscript[t, n + 1], psi], Subscript[t,
n + 1]]] /. {{Subscript[t, n + 1] -> Subscript[t,
n]}, {Subscript[t, n + 1] -> 0}}]
picardSeries[initialVector_, flow_, n_, var_] :=
Module[{time},
Fold[
iterate[
initialVector, flow, #1, #2, time
] &,
initialVector,
Reverse[Range[n] - 1]] /. {Subscript[time, 0] -> var}
]
The iteration step is called iterate
, and it keeps track of the iteration order n
so that it can assign a separate integration variable name at each step. As additional tricks to speed things up, I avoid the automatic simplifications for definite integrals by doing the integral as an indefinite one first, then using Subtract
to apply the integration limits.
Instead of a generic simplification, I add Expand
to the result in order to help the subsequent integration step recognize how to split up the integral over the current result. The last argument in iterate
is the name that I intend to use as the base variable name for the integration, but it will get a subscript n
attached to it.
Then iterate
is called by picardSeries
, using increasing subscripts starting with the outermost integration. This is implemented using Fold
with a Reverse
range of indices. The first input is the initial condition, followed by the function defining the flow (specifically, defined below as flow[t_, f_]
). After the order n
, I also specify the name of the independent variable var
as the last argument.
Here is the example from the original question:
flow[t_, f_] := f^2
picardSeries[1, flow, 5, x]
(*
==> 1 + x + x^2 + x^3 + x^4 + x^5 + (43 x^6)/45 + (
13 x^7)/15 + (943 x^8)/1260 + (3497 x^9)/5670 + (
27523 x^10)/56700 + (1477 x^11)/4050 + (17779 x^12)/68040 + (
13141 x^13)/73710 + (1019 x^14)/8820 + (63283 x^15)/893025 + (
43363 x^16)/1058400 + (1080013 x^17)/48580560 + (
2588 x^18)/229635 + (162179 x^19)/30541455 + (16511 x^20)/7144200 + (
207509 x^21)/225042300 + (557 x^22)/1666980 + (
2447 x^23)/22504230 + (16927 x^24)/540101520 + (
5309 x^25)/675126900 + x^26/595350 + (2 x^27)/6751269 + (
13 x^28)/315059220 + x^29/236294415 + x^30/3544416225 + \
x^31/109876902975
*)
This result is obtained almost instantaneously. You can also get results for n = 7, 8
with almost no delay (I just don't want to waste space by listing them). These orders are practically out of reach for the other answers.
If you want intermediate results, too, here is a function that keeps them:
picardList[initialVector_, flow_, n_, var_] :=
Module[{time},
FoldList[
iterate[
initialVector, flow, #1, #2, time
] &,
initialVector,
Reverse[Range[n] - 1]] /. {Subscript[time, _] -> var}
]
picardList[1, flow, 4, x] // TableForm
This solution works equally well for vectorial initial-value problems, i.e., the flow
can be a vector function and the initial condition a vector. This is needed, e.g., if you want to apply this method to a higher-order differential equation for a scalar function by converting it to a first-order equation for a vector function (a standard technique I don't think I have to go into in detail).
Application: a two-state system
As a non-trivial example of a vectorial initial-value problem, here is the solution to a quantum time evolution of a two-state system that is initially in the state {1,0}
and subjected to a periodic driving field:
Clear[e0, v0, ω, t];
$Assumptions = {e0 > 0, v0 > 0, ω > 0, t > 0};
flow1[t_, ψ_] := -I {{0, E^(-I t (e0 - ω)) v0},
{E^(I t (e0 - ω)) v0, 0}}.ψ
FullSimplify[picardSeries[{1, 0}, flow1, 3, t]]
$$\left( \begin{array}{c} 1+\frac{\text{v0}^2 \left(i t (\text{e0}-\omega )+e^{-i t (\text{e0}-\omega )}-1\right)}{(\text{e0}-\omega )^2} \\ \frac{\text{v0} \left(e^{i t (\text{e0}-\omega )} \left(2 \text{v0}^2-(\text{e0}-\omega ) \left(\text{e0}+i t \text{v0}^2-\omega \right)\right)+(\text{e0}-\omega ) \left(\text{e0}-i t \text{v0}^2-\omega \right)-2 \text{v0}^2\right)}{(\text{e0}-\omega )^3} \\ \end{array} \right)$$
This illustrates the important lesson that Simplify
(let alone FullSimplify
) shouldn't be called (or implicitly invoked) in the iteration step. On the other hand, using FullSimplify
on the final result (which here contains many symbolic constants, too), is OK.
Edit: speed considerations
The individually labelled integration variables in each step create a slight overhead (linear in n
, i.e., rather benign).
But I found that nested integrations with identically labelled integration variables run more slowly (although they produce correct results). This is very noticeable for the second example, flow1
, going e.g. to n = 9
. Therefore, the small overhead in creating unique variable names is justified when going to large n
.
Here are some possibilities more in line with Mathematica idioms (i.e. that avoid using procedural loops).
Option 1
Clear[h]
h = Function[{t}, 1 + Integrate[#^2, {x, 0, t}]][x] & ;
NestList[h, 1, 3]
(* {1, 1 + x, 1 + x + x^2 + x^3/3} *)
Option 2
To set the y
s in the process:
Clear[y, h]
h = Function[{t}, 1 + Integrate[#^2, {x, 0, t}]][x] & ;
NestList[{1 + First@#, y[1 + First@#][x_] = h@Last@#} &, {0, 1}, 2]
y[2][x]
y[1][x]
results in
(* {{0, 1}, {1, 1 + x}, {2, 1 + x + x^2 + x^3/3}} *)
(* 1 + x + x^2 + x^3/3 *)
(* 1 + x *)
Option 3
Or we could memo-ize while using a recursive definition of y
:
Clear[y, h]
h = Function[{t}, 1 + Integrate[#^2, {x, 0, t}]][x] & ;
y[0][x_] = 1
y[n_][x_] := y[n][x] = h[y[n - 1][x]]
Then,
y[2][x]
outputs
(* 1 + x + x^2 + x^3/3 *)
and in the process, y[1][x]
also gets defined.
Option 4
Using FoldList
:
h = (y[#2][x_] = Function[{t}, 1 + Integrate[#1^2, {x, 0, t}]][x]) &;
FoldList[h, 1, Range[2]]
(* {1, 1 + x, 1 + x + x^2 + x^3/3} *)
and in the process, y[1]
and y[2]
get defined (but not y[0]
).
I believe that the following code does what you want
For[{n = 1, y[0][x_] = 1}, n < 4, n++, y[n][x_] = 1 + Integrate[y[n - 1][t]^2, {t, 0, x}];Print[{n, y[n][t]}]]