How to use NestList for coupled equations?

Question

I have a code that works for a single equation. How to I use NestList for two equation that are coupled? Below is the code for single equation,

 Remove[x, f];
 \[Lambda][r_] := Module[{f, l}, f[x_] := r x (1 - x);
 l[x_] = Log[Abs[D[f[x], x]]];
 Mean[l[NestList[f, 0.1, 1*^2]]]];
 Plot[\[Lambda][r], {r, 0, 4}, PlotStyle -> Thickness[.01], 
 AxesLabel -> {"r", "\[Lambda](r)"}]

The output is

My attempt for two coupled equation (note: that I used equations uncoupled for testing purpose, but it should work for coupled as well):

 Remove[x, y, f];
 \[Lambda][r_] := 
 Module[{f, l}, f[{x_, y_}] := {r x (1 - x), r y (1 - y)};
 l[{x_, y_}] = {Log[Abs[D[First[f[x, y]], x]]], 
 Log[Abs[D[Last[f[x, y]], y]]]};
 Mean[l[NestList[f, {0.1, 0.1},  1*^2]]]];
 ListPlot[Table[\[Lambda][r], {r, 0, 1}], 
 PlotStyle -> {Dashed, Thickness[.01]}, 
 AxesLabel -> {"r", "\[Lambda](r)"}]

I believe that my source of problem starts with the NestList and Mean.

addendum: My second attempt at the problem,

I almost answered my own question by modifying the code and avoiding Mean Function. However, numerical results are a bit weird.

 Remove[x, y, f, lya, \[Lambda], l, xinit, n, iterations, skip, ans1, \
 ans2, ff, ffp, dfp, lya2, xlist2, l2, ndrop2, xinit2, n2]

 iterations = 200;
 skip = 2;

 f[x_] := 4 \[Lambda] x (1 - x);

 lya[l_, xinit_, n_, ndrop_] := (\[Lambda] = l; 
 xlist = Drop[NestList[f, xinit, n],
 ndrop + 1]; Apply[Plus, Log[Abs[f'[xlist]]]]/Length[xlist])

 ans1 = lya[0.91, 0.7, iterations, skip]

 Plot[lya[\[Lambda], 0.7, iterations, skip], {\[Lambda], 0.5, 1.0}, 
  AxesOrigin -> {0.5, 0}, 
  AxesLabel -> {"\[Lambda]", 
  "\!\(\*SubscriptBox[\(\[Lambda]\), \(L\)]\)"}]
 

and the answer is,

 0.22816

Since I want to solve coupled logistic equations say

$x'= a y ( 1 - x)$

$y'= a x ( 1 - y)$

But to make it easier and to verify the correctness of the code I modify equation (uncouple them) to make it simpler,

$x'= a x ( 1 - x)$

$y'= a y ( 1 - y)$

And the above code is modified to handle two equations (list of equations) as follows,

 Remove[x, y, \[Lambda], ff, ffp, dfp, lya2, xlist2, l2, ndrop2, 
 xinit2, n2];

 ff[{x_, y_}] = 
 Evaluate[{4 \[Lambda] x (1 - x), 4 \[Lambda] y (1 - y)}];
 ffp[x_, y_] := 
 Evaluate[{4 \[Lambda] x (1 - x), 4 \[Lambda] y (1 - y)}];
 dfp[x_, y_] = Abs[Evaluate[Grad[ffp[x, y], {x, y}] . {1, 1}]];

 lya2[l2_, xinit2_, n2_, ndrop2_] := (\[Lambda] = l2; 
 xlist2 = Drop[NestList[ff, xinit2, n2],
 ndrop2 + 1];
 Apply[Plus, 
 Log[Transpose[
  Function[{x, y}, dfp[x, y]][Sequence @@ Transpose[xlist2]]]]]/
 Length[xlist2])

 ans2 = lya2[0.91, {0.7, 0.7}, iterations, skip]

 Plot[lya2[\[Lambda], {0.7, 0.7}, iterations, skip][[1]], {\[Lambda], 
 0.5, 1.0}, AxesOrigin -> {0.5, 0}, 
 AxesLabel -> {"\[Lambda]", 
 "\!\(\*SubscriptBox[\(\[Lambda]\), \(L\)]\)"}]

 Plot[lya2[\[Lambda], {0.7, 0.7}, iterations, skip][[2]], {\[Lambda], 
 0.5, 1.0}, AxesOrigin -> {0.5, 0}, 
 AxesLabel -> {"\[Lambda]", 
 "\!\(\*SubscriptBox[\(\[Lambda]\), \(L\)]\)"}]

 (*   compare answers  *)
 ans1 == ans1
 ans1 == ans2[[1]]  
 ans1 == ans2[[2]]

and the answer for the above code is

 {0.243622, 0.243622}

 True
 False
 False

For iterations=30 I get all True. False starts after 40 iterations. It is puzzling to me as to why it happens. Equations are identical. Perhaps, additional functions used in second code add error to it. Or perhaps my approach is not correct even though I am getting the same plots. But if you try iterations=5000 and skip=2000, the code for listed equations shows completely wrong plots.

Update 1:

Following suggestions by @Varnavides, it worked for this particular equation except for some other equation, see below:

 Clear[ff, dfp, lya, ff2, dfp2, lya2]

Remove[ff, dfp, lya, ff2, dfp2, lya2]

ff3[\[Lambda]_][{x_, y_}] = {4 \[Lambda] x, 4 \[Lambda] y (1 -  y)};

ff2[\[Lambda]_][{x_, y_}] = {4 \[Lambda] x (1 - x), 
4 \[Lambda] y (1 - y)};
dfp2[\[Lambda]_][{x_, y_}] = 
Abs[Grad[ff2[\[Lambda]][{x, y}], {x, y}] . {1, 1}];

lya2[\[Lambda]2_, xinit2_, n2_, ndrop2_] := 
Block[{xlist2}, 
xlist2 = Drop[NestList[ff2[\[Lambda]2], xinit2, n2], ndrop2 + 1];
Log[Transpose[dfp2[\[Lambda]2][Transpose[xlist2]]]] // Mean]

lya2[0.91, {0.7, 0.7}, 4, 1]

{-0.152808, -0.152808}

xlist2 = Drop[NestList[ff2[0.91], {0.7, 0.7}, 4], 2]

{{0.655537, 0.655537}, {0.821942, 0.821942}, {0.532727, 0.532727}}

xlist3 = Transpose[xlist2]

{{0.655537, 0.821942, 0.532727}, {0.655537, 0.821942, 0.532727}}

dfp2[0.91][Transpose[xlist2]]

{{1.13231, 2.34374, 0.238251}, {1.13231, 2.34374, 0.238251}}

Equation ff2 is is fine, but equation ff3 is not. It fails to Transpose. Using ff3, there is a missing curly brackets in output. Why curly brackets are vanishing?

Answer 1

Edit 01:

I suspect your issue arises from using global variables in your function definitions. Here's a simple re-write of your code, passing λ as a parameter and using Block to localize the xlist variable. The results seem to agree to large iteration numbers:

Clear[ff, dfp, lya, ff2, dfp2, lya2]
ff[λ_][x_] = 4 λ x (1 - x);
dfp[λ_][x_] = Abs[D[ff[λ][x], x]];

lya[λ_, xinit_, n_, ndrop_] := Block[{xlist},
  xlist = Drop[NestList[ff[λ], xinit, n], ndrop + 1];
  Log[dfp[λ][xlist]] // Mean]

ff2[λ_][{x_, y_}] = {4 λ x (1 - x), 
   4 λ y (1 - y)};
dfp2[λ_][{x_, y_}] = 
  Abs[Grad[ff2[λ][{x, y}], {x, y}] . {1, 1}];

lya2[λ2_, xinit2_, n2_, ndrop2_] := Block[{xlist2},
  xlist2 = Drop[NestList[ff2[λ2], xinit2, n2], ndrop2 + 1];
  Log[Transpose[dfp2[λ2][Transpose[xlist2]]]] // Mean]

lya[0.91, 0.7, 200, 2]
lya2[0.91, {0.7, 0.7}, 200, 2]

0.243622
{0.243622, 0.243622}

Original Post:

I'll use a canonical example of a coupled iterative equation to illustrate the concept, namely the De-jong attractor:

dejong[{x_, y_}] = With[{a = 1.6, b = 1.9, c = 0.3, d = 1.5}, 
{Sin[a y] - Cos[b x],Sin[c x] - Cos[d y]}]
NestList[dejong, {1., 1.}, 10^4] // Point // Graphics

The two things to note are:

1. Make sure your function accepts the same form of arguments as it outputs, i.e. you would change your function from f[x_, y_]={..,..} to f[{x_, y_}]={..,..}
2. The third argument of NestList is the number of iterations, so it expects a single integer value.

With these two changes your example above gets close to working, although if I understand correctly you'd want to express l[{x_,y_}]={..,..} symbolically and simply Nest over that. Note that currently your example above passes the entire list output to l. This works for your single equation case as Log and Abs are Listable and thread over their arguments.