2
$\begingroup$

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}]
$\endgroup$
  • $\begingroup$ Ad A) Table[i,{i,1,2,0.2}] gives {1., 1.2, 1.4, 1.6, 1.8, 2.}. $\endgroup$ – corey979 Sep 19 '16 at 6:51
  • $\begingroup$ 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... $\endgroup$ – firegreencurry Sep 19 '16 at 7:27
4
$\begingroup$

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.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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