4
$\begingroup$

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?

$\endgroup$
5
$\begingroup$

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.}}*)

$\endgroup$
7
$\begingroup$

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}]]

enter image description here

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.}} *)
$\endgroup$
  • $\begingroup$ Ah thanks a lot for this great analysis!! $\endgroup$ – David Lingard Oct 9 at 22:33
2
$\begingroup$

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

$\endgroup$

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.