Bifurcation of the Logistic Equation

Bifurcation

Setting It All Up

f[p_, x_] := p*x*(1 - x);

NSolve[x == f[0.8, x], x]

fprime[p_, x_] = D[f[p, x], x]

fprime[0.8, 0]

y = Table[0, {20}];

y[[1]] = Random[Real, {0, 1}]

Do[y[[i]] = f[0.8, y[[i - 1]]], {i, 2, 20}]

ListPlot[y];

NSolve[x == f[2.0, x], x]

fprime[2.0, 0]

fprime[2.0, 0.5]

Clear[y];

y = Table[0, {10}];

y[[1]] = Random[Real, {0, 1}]

Do[y[[i]] = f[2.0, y[[i - 1]]], {i, 2, 10}]

ListPlot[y];

NSolve[x == f[3.3, x], x]

fprime[3.3, 0]

fprime[2.0, 0.6969696969696969]

Clear[y];

y = Table[0, {50}];

y[[1]] = Random[Real, {0, 1}]

Do[y[[i]] = f[3.3, y[[i - 1]]], {i, 2, 50}]

ListPlot[y];

NSolve[x == f[3.3, f[3.3, x]], x]

df2[x_] = D[f[3.3, f[3.3, x]], x]

df2[0.479427]

df2[0.823603]

NSolve[x == f[3.8, x], x]

fprime[3.8, 0]

fprime[3.8, 0.736842]

Clear[y];

y = Table[0, {50}];

y[[1]] = Random[Real, {0, 1}]

Do[y[[i]] = f[3.8, y[[i - 1]]], {i, 2, 50}]

ListPlot[y];

Plotting Out the Bifurcation Map

bifdata = Table[{0, 0}, {100000}];

Do[{a = Random[Real, {2, 4}]; 
bifdata[[i, 1]] = 
          a; 
y = 
          Random[Real, {0, 1}]; 
Do[
          y = f[a, y], {300}]; 
bifdata[[i, 2]] = 
          y}, {i, 1, 100000}]

pp = 
        ListPlot[bifdata, PlotStyle -> PointSize[0.001]];

Clear[y]

bifdata = Table[{0, 0}, {100000}];

Do[{a = 
          Random[Real, {3.5, 4}]; 
bifdata[[i, 1]] = 
          a; 
y = 
          Random[Real, {0, 1}]; 
Do[
          y = f[a, y], {300}]; 
bifdata[[i, 2]] = 
          y}, {i, 1, 100000}]

pp = 
        ListPlot[bifdata, PlotStyle -> PointSize[0.001]];

Clear[y]

bifdata = Table[{0, 0}, {80000}];

Do[{a = 
          Random[Real, {3.65, 3.7}]; 
bifdata[[i, 1]] = 
          a; 
y = 
          Random[Real, {0, 1}]; 
Do[
          y = f[a, y], {300}]; 
bifdata[[i, 2]] = 
          y}, {i, 1, 80000}]

pp = 
        ListPlot[bifdata, PlotStyle -> PointSize[0.001]];