3

For a larger project on chaos, I am trying to write a short program that graphs the logistic model with different constant values, in this case the constant being "r". A) Is there a way to use Table to graph more than just integer values of R from 1 to 4? B) Is there a way to use Manipulate to visually drag between different values of r to to display chaos?

logistic = Function[n0,

iList = {};
xList = {};

x[0] = 0.01;

For[i = 1, i <= n0, i = i + 1,

x[i] = r*x[i - 1]*(1 - x[i - 1]);

AppendTo[iList, i];
AppendTo[xList, x[i]];

];
]


grapher = Function[
data[];

For[r = 1, r <= 4, r = r + 0.1,

logistic[50];

data[r] = Transpose@{iList, xList};

Clear[iList];
Clear[xList];
];
]

grapher[]

The two lines below are what I was using to try and attempt to plot the data lists with no luck.

Table[ListPlot[data[r]], {r, 1, 4}]

Manipulate[ListPlot[data[r]], {r, 1, 4}]
firegreencurry
  • 31
  • 1
  • Ad A) Table[i,{i,1,2,0.2}] gives {1., 1.2, 1.4, 1.6, 1.8, 2.}. – corey979 Sep 19 '16 at 06:51
  • Thanks! That answers one of my questions. Now if I can just figure out a way to label each of these graphs in the table. Plot Label doesn't seem to work within the table... – firegreencurry Sep 19 '16 at 07:27

1 Answers1

4

Nest and its 'relatives' are useful for these purposes. I suggest searching this site for logistic map and bifurcation diagrams. I post this as illustrative. The bifurcation diagram is a slight change to Vitaliy Kaurov's answer.

lp[u_, pt_] := 
 Graphics[{PointSize[0.002], Red, pt}, 
  GridLines -> {{{u, Blue}}, None}, Frame -> True, ImageSize -> 400]
f[r_, x_, n_] := NestList[r # (1 - #) &, x, n];
cw[lst_] := Catenate[{{#1, #2}, {#2, #2}} & @@@ Partition[lst, 2, 1]]
Manipulate[Column[{
   ListPlot[f[p, x0, 100], PlotRange -> {{0, 100}, {0, 1}}, 
    Joined -> True, Frame -> True, ImageSize -> 400],
   Plot[{f[p, x, num][[-1]], x}, {x, 0, 1}, Frame -> True, 
    PlotRange -> {{0, 1}, {0, 1}}, ImageSize -> 400, 
    MeshFunctions -> (f[p, #, num][[-1]] - # &), Mesh -> {{0.}}, 
    MeshStyle -> {Red, PointSize[0.02]}, 
    Epilog -> {Purple, PointSize[0.02], Point[f[p, x0, 1]], 
      Line[cw[f[p, x0, 10]]]}]
   , lp[p, pts]}], {x0, 0.01, 0.99}, {p, 2, 4, 
  Appearance -> "Labeled"}, {num, {1, 5, 10}}, 
 Initialization :> (pts = 
     Point /@ 
      ParallelTable[
       Thread[{r, 
         Nest[r # (1 - #) &, Range[0.01, 0.99, 0.01], 1000]}], {r, 2, 
        4, 0.01}];)]

enter image description here

f generates a list of the iterations of the logistic map including initial x.

Community
  • 1
ubpdqn
  • 60,617
  • 3
  • 59
  • 148