7

I am attempting to plot the bifurcation diagram of the tent map $$ f(x):=2\alpha \begin{cases} x, & 0<x<1/2\\ 1-x, &1/2<x<1, \end{cases} $$ i.e., the plot $\alpha$ vs. the limit points of the sequence $x_{n}:=f(x_{n-1})$. I found the following code online to plot the bifurcation diagram of the related logistic map:

ListPlot[ParallelTable[Thread[{r, Nest[r # (1 - #) &, 
Range[0, 1, 0.01], 1000]}], {r, 0, 4, 0.01}], PlotStyle -> PointSize[0]]

So naturally, I figured that I could make a simple change to get the bifurcation diagram of the tent map:

ListPlot[ParallelTable[Thread[{r, Nest[2*r*If[0<#<0.5,#, (1 - #)] &, 
Range[0, 1, 0.01], 1000]}], {r, 0, 1, 0.01}], PlotStyle -> PointSize[0]]

But it doesn't work! Is there a simple change I can make to get this guy to work?

user14717
  • 817
  • 1
  • 7
  • 11

1 Answers1

12
f[x_] := Piecewise[{{x, x < .5}, {1 - x, x > .5}}]

SetAttributes[f, Listable]

data = ParallelTable[Thread[{r, Nest[r*f[#]&, Range[0, 1, 0.005], 200]}],{r, 0, 2, .005}];

ListPlot[Flatten[data, 1], 
 PlotStyle -> Directive[PointSize[0], Opacity[.2], Black], 
 PlotRange -> {{1, 2}, {0, 1}}, AspectRatio -> 1, Frame -> True]

enter image description here

Below is a bit better method:

k = 1000; r = Range[1., 2., 1/(k - 1)];

f[x_] := Piecewise[{{x, x < .5}, {1 - x, x > .5}}]

SetAttributes[f, Listable]

rhs[x_?VectorQ] := r f[x];

iterates = RecurrenceTable[{x[n + 1] == rhs[x[n]], 
    x[0] == ConstantArray[1./\[Pi], k]}, x, {n, 10^4, 2 10^4}];

data = Transpose[Ceiling[iterates k]];

count[data_, i_] := Module[{c, j}, {j, c} = Transpose[Tally[data]];
   Transpose[{j, ConstantArray[i, Length[j]]}] -> Log[N[c]]];

S = SparseArray[DeleteCases[Table[count[data[[i]], i], {i, k}],{{_ , _}} -> {_}], k];

ArrayPlot[Reverse[S], ColorFunction -> "SunsetColors", Frame -> False]

enter image description here

Vitaliy Kaurov
  • 73,078
  • 9
  • 204
  • 355