Implementing delay in NestList?

Question

The traditional iterated map can be implemented with NestList, such as the Logistic Map, x[n+1]=rxn, can be implemented with the single line:

NestList[r#(1-#),x0,10]

I want to implement an iterated map with delay. That is, I want to have a function where x[n] is a function of something earlier than x[n-1], I want to calculate x[n] as a function of x[n-k]. That is, I wish to calculate x[n]=rxn-1. As in a delayed equation, there would need to be a history, let's say that x[(n-k)<0]=0. Let's say that k=20 or so.

I am sorry to give so little starting code, but my trouble here is conceptual. Is this a problem best performed with NestList, or some other function. Would a NestList of a NestList be appropriate, or is there some simpler implementation?

Thanks very much.

EDIT October 3: Revisiting the problem. I found the specific example of Buchner's Logistic map with a 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]]]
 ]

Now all I need to figure out is how to abstract this to any value of k, but this is a much more well-defined question than my first query.

Answer 1

SequenceFoldList is probably what you need:

SequenceFoldList[f, {0, 1}, Range@3]
(* {0, 1, f[0, 1, 1], f[1, f[0, 1, 1], 2], 
 f[f[0, 1, 1], f[1, f[0, 1, 1], 2], 3]} *)

This is how you'd implement Fibonacci: (from the documentation)

SequenceFoldList[Plus, {1, 1}, ConstantArray[0, 10]]
(* {1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144} *)

Answer 2

Versions of Mathematica before SequenceFoldList was introduced can do something like this:

FoldList[
  Append[Rest@#, #[[-1]] + #[[-2]]] &,
  {0, 1},
  ConstantArray[0, 11]
][[All, 2]]

{1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144}

A shorter form is tempting but it makes inefficient use of Append:

Fold[Append[#, #[[-1]] + #[[-2]]] &, {1, 1}, ConstantArray[0, 10]]

The speed of an Append operation is proportional to the length of the list, so within a loop it is better to append only to short lists. For long history lists a faster approach is to use a ring buffer; see:

• Efficient circular buffer?

Answer 3

I'm not sure exactly what recursion you wish to use, but one way to have multiple terms/delays is to make the state into a vector, for example:

NestList[{r #[[1]] (1 - #[[2]]), #[[1]]} &, {x0, x1}, 5]

Note that the initial state (here {x0,x1}) and the calculated value (the first argument of NestList) must both be the same dimension (in this case, 2). There is no real limit to the number of such terms/delays you can have. Here's a simple example with a 3-term Fibonacci-like recursion:

NestList[{#[[1]] + #[[2]] + #[[3]], #[[1]], #[[2]]} &, {1, 1, 1}, 5]

Answer 4

I prefer the syntax of RecurrenceTable, which is similar to the syntax of NDSolve. Does this seem OK?

k = 4;
K = 0.2;
r = 3.6;

RecurrenceTable[Join[
  {x[n + 1] == (1 - K) r x[n] (1 - x[n]) + K x[n - k]},
  Table[x[m] == 1, {m, -k, 0}] (* ICs *)
], x, {n, 10}]

{1., 1., 1., 1., 1., 0.2, 0.6608, 0.845533, 0.576148, 0.9033, 0.291565, 0.727038, 0.740653, 0.668437, 0.818951}