# Slow computation of recursive sequences

I want to investigate the asymptotic behavior of the following recursive system:

a[n_] := (a[n-1] - 0.45 a[n-1]) + 0.3 b[n-1]
b[n_] := (b[n-1] - 0.3 b[n-1]) + 0.45 a[n-1]
a[0] = 450;
b[0] = 450;

Grid[Table[{n, a[n], b[n]}, {n, 0, 12}]]


It is working, however it is very slow. It seems that it doesn't memorize the calculated value, so it repeats the computation from the beginning. Is there a way to make this computations faster?

• Hi David. Please get into the habit of posting code directly in copyable form (with the appropriate markup). Towards your question: You probably want to learn about memoization, i.e. the art of defining Functions That Remember Values They Have Found. Oct 8, 2019 at 20:33
• @HenrikSchumacher Hi Henrik, I am sorry I first typed it as a copiable code, but I get the persisting error: "your post appears to contain code that is not properly formatted as code". That's why I inserted it as a picture. Oct 8, 2019 at 20:45
• Oct 8, 2019 at 21:18

These are all equivalent

RecurrenceTable[{a[n] == a[n - 1] - 0.45 a[n - 1] + 0.3 b[n - 1],
b[n] == b[n - 1] - 0.3 b[n - 1] + 0.45 a[n - 1], a[0] == 450,
b[0] == 450}, {a[n], b[n]}, {n, 10}]

Clear[a, b]
{a[n], b[n]} /. RSolve[{a[n] == a[n - 1] - 0.45 a[n - 1] + 0.3 b[n - 1],
b[n] == b[n - 1] - 0.3 b[n - 1] + 0.45 a[n - 1], a[0] == 450,
b[0] == 450}, {a[n], b[n]}, n];
Table[%, {n, 0, 10}]

Clear[a, b]
a[n_] := a[n] = a[n - 1] - 0.45 a[n - 1] + 0.3 b[n - 1]
b[n_] := b[n] = b[n - 1] - 0.3 b[n - 1] + 0.45 a[n - 1]
a[0] = 450;
b[0] = 450;
Table[{a[n], b[n]}, {n, 0, 10}]


(* {{450, 450}, {382.5, 517.5}, {365.625, 534.375}, {361.406, 538.594}, {360.352, 539.648}, {360.088, 539.912}, {360.022, 539.978}, {360.005, 539.995}, {360.001, 539.999}, {360., 540.}, {360., 540.}}*)

The system can be solved in closed-form using RSolve

Clear["Global*"]

eqns = {a[n] == (a[n - 1] - 0.45 a[n - 1]) + 0.3 b[n - 1],
b[n] == (b[n - 1] - 0.3 b[n - 1]) + 0.45 a[n - 1],
a[0] == 450, b[0] == 450} // Rationalize;

sol = RSolve[eqns, {a, b}, n][[1]]

(* {a -> Function[{n}, 45 2^(1 - 2 n) (1 + 2^(2 + 2 n))],
b -> Function[{n}, 45 2^(1 - 2 n) (-1 + 3 2^(1 + 2 n))]} *)


Verifying that the solutions satisfy the equations

And @@ (eqns /. sol // Simplify)

(* True *)


The functions asymptotically approach

Limit[{a[n], b[n]} /. sol, n -> Infinity]

(* {360, 540} *)

N[{a[#], b[#]} /. sol] & /@ Range [0, 10]

(* {{450., 450.}, {382.5, 517.5}, {365.625, 534.375}, {361.406,
538.594}, {360.352, 539.648}, {360.088, 539.912}, {360.022,
539.978}, {360.005, 539.995}, {360.001, 539.999}, {360., 540.}, {360.,
540.}} *)

Plot[Evaluate[{b[n], a[n]} /. sol], {n, 0, 15},
PlotLegends -> Placed[{b[n], a[n]}, {0.5, 0.5}]]


Alternatively, using FixedPointList

FixedPointList[
{(#[[1]] - 0.45 #[[1]]) + 0.3 #[[2]],
(#[[2]] - 0.3 #[[2]]) + 0.45 #[[1]]} &,
{450, 450}]

(* {{450, 450}, {382.5, 517.5}, {365.625, 534.375}, {361.406, 538.594}, {360.352,
539.648}, {360.088, 539.912}, {360.022, 539.978}, {360.005,
539.995}, {360.001, 539.999}, {360., 540.}, {360., 540.}, {360.,
540.}, {360., 540.}, {360., 540.}, {360., 540.}, {360., 540.}, {360.,
540.}, {360., 540.}, {360., 540.}, {360., 540.}, {360., 540.}, {360.,
540.}, {360., 540.}, {360., 540.}, {360., 540.}, {360., 540.}, {360., 540.}} *)

• Ah thanks a lot for this great analysis!! Oct 9, 2019 at 22:33

The basic idea is

a[n_]:=(a[n]=(a[n-1)0...)
`

This will set downvalues for a, for each n to prevent re-computation