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$
3

3 Answers 3

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$
1
  • $\begingroup$ Ah thanks a lot for this great analysis!! $\endgroup$ Oct 9, 2019 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 and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.