2
$\begingroup$

This is an extension to a previous question that I never fully answered, but have been better able to define with some new reading (see other question here: Implementing delay in NestList?)

I would like to implement Buchner's Logistic map with delayed feedback:

x(n+1)=(1-K)r*x(n)[1-x(n) + K x(n-k)

where K is the feedback gain and k is the feedback delay. Very helpfully, the above system can be rewritten as a set of k+1 coupled iterated functions with no delay, i.e. (below as equations, not mathematica code):

x1(n+1)=(1-K)r*x1(n)[1-x1(n) + K x2(n)
x2(n+1)=x3(n)
x3(n+1)=x4(n)
...
xk(n+1)=x1(n)

So with a fixed value of k, I can rewrite the system such as:

Module[{K = .2, r = 3.6, x1 = 1, x2 = 1, x3 = 1, x4 = 1, x5 = 1},
 dataNest = NestList[
   {(1 - K) r #[[1]] (1 - #[[1]]) + K #[[2]], 
     #[[3]],
     #[[4]],
     #[[5]],
     #[[1]]} &,
   {x1, x2, x3, x4, x5},
   100];
 ListLinePlot[dataNest[[All, 1]]]
 ]

(The above case should show an oscillatory solution. These kinds of systems are used to examine chaos and nonlinear dynamics.)

I would like to rewrite the above block such that I can specify k and construct the NestList of the appropriate length. I suspect this is not too tricky, but pure functions and slot syntax are still a bit confusing to me.

I think the only tricky bit is the list that goes into NestList, because of the pure function. Creating the initial conditions vector seems easier. So I need a list where the first entry is (1 - K) r #[[1]] (1 - #[[1]]) + K #[[2]], the 2nd through k entries are [[3]] through [[k+1]] and the k+1 entry is [[1]]. Would some syntactically gifted residents offer some guidance?

$\endgroup$
0

2 Answers 2

5
$\begingroup$

This seems like a good place for a recursive definition. Just set the desired delay to j. The If is used to set the initial conditions (to all 1, as in the OPs example), otherwise it defines the recursion.

Clear[x]; k = 0.2; r = 3.6; j = 5;
x[n_] := x[n] = If[n < j, 1, (1 - k) r*x[n - 1] (1 - x[n - 1]) + k x[n - j]];
ListLinePlot[x[#] & /@ Range[100]]

enter image description here

You could equally well define the initial conditions by formula or from a list by embedding this in the If.

$\endgroup$
4
$\begingroup$

Here's a straight-forward way, in which you don't even have to specify k explicitly. Instead, it's automatically "detected" via the length of the initial condition list.

buchnerLogisticMap[K_, r_, init_] := NestList[
   Join[{(1 - K) r #[[1]] (1 - #[[1]]) + K #[[2]]}, #[[3 ;;]], {#[[1]]}] &,
   init,
   100][[All, 1]]

Then,

ListLinePlot@buchnerLogisticMap[0.2, 3.6, Table[1, {5}]]

enter image description here

$\endgroup$

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