Diskrete logistische Abbildung: Graphische Darstellung

Interaktive Abbildungen

logistic[a_][x_]:=a x(1-x)

data[a_,x_]:=data[a,x]=Table[{i,Nest[logistic[a],x,i]},{i,0,500}]

manipLogist[a_,x_,tend_,range_]:=Manipulate[ListLinePlot[data[a,x][[1;;n]],Joined->True,PlotRange->{{0,tend-1},{0,range}},InterpolationOrder->0,Epilog->{PointSize[Large],Red,Point[data[a,x][[1;;n]]]}
],{n,1,tend,1}]

Manipulate[ListLinePlot[data[a,x][[1;;n]],Joined->True,PlotRange->{{0,tend-1},{0,range}},InterpolationOrder->0,Epilog->{PointSize[Large],Red,Point[data[a,x][[1;;n]]]}
],{n,1,tend,1},{{a,2},1,4},{{x,0.01},0.01,0.9},{{tend,25},25,500},{{range,0.6},0.4,1}]

Important paramters to try : 2.3, 2.9, 3.0, 3.2, 3.45, 3.552, 3.565, 3.7, 3.8, 3.8285, 3.8415, 4.0

1.+(Sqrt[6])

manipLogist[3.45,0.01,50,1]

manipLogist[3.552,0.01,50,1]

Transpose[{data[3.552,0.01][[451;;458]],data[3.552,0.01][[459;;466]]}]//TableForm

manipLogist[3.565,0.01,100,1]

Transpose[{data[3.565,0.01][[451;;466]],data[3.565,0.01][[467;;482]]}]//TableForm

manipLogist[3.7,0.01,500,1]

manipLogist[3.8,0.01,500,1]

1.+(Sqrt[8])

manipLogist[3.8285,0.01,150,1]

manipLogist[3.8415,0.01,200,1]

manipLogist[3.8415,0.64,200,1]

manipLogist[4.0,0.01,500,1]

Plots für pdf

Important paramters to try : 2.3, 2.9, 3.0, 3.2, 3.45, 3.552, 3.565, 3.7, 3.8, 3.8285, 3.8415, 4.0

plot1=ListLinePlot[data[2.3,0.01][[1;;25]],Joined->True,PlotRange->{{0,25},{0,0.8}},InterpolationOrder->0,Epilog->{PointSize[Large],Red,Point[data[2.3,0.01][[1;;25]]]},PlotLabel->Style[Framed[a==2.3],14,Blue,Background->Lighter[Yellow]]]

plot2=ListLinePlot[data[2.9,0.01][[1;;50]],Joined->True,PlotRange->{{0,50},{0,0.8}},InterpolationOrder->0,Epilog->{PointSize[Large],Red,Point[data[2.9,0.01][[1;;50]]]},PlotLabel->Style[Framed[a==2.9],14,Blue,Background->Lighter[Yellow]]]

plot3=ListLinePlot[data[3.0,0.01][[1;;50]],Joined->True,PlotRange->{{0,50},{0,0.8}},InterpolationOrder->0,Epilog->{PointSize[Large],Red,Point[data[3.0,0.01][[1;;50]]]},PlotLabel->Style[Framed[a==3],14,Blue,Background->Lighter[Yellow]]]

plot4=ListLinePlot[data[3.2,0.01][[1;;30]],Joined->True,PlotRange->{{0,30},{0,1}},InterpolationOrder->0,Epilog->{PointSize[Large],Red,Point[data[3.2,0.01][[1;;30]]]},PlotLabel->Style[Framed[a==3.2],14,Blue,Background->Lighter[Yellow]]]

plot5=ListLinePlot[data[3.45,0.01][[1;;30]],Joined->True,PlotRange->{{0,30},{0,1}},InterpolationOrder->0,Epilog->{PointSize[Large],Red,Point[data[3.45,0.01][[1;;30]]]},PlotLabel->Style[Framed[a==3.45],14,Blue,Background->Lighter[Yellow]]]

plot6=ListLinePlot[data[3.552,0.01][[1;;50]],Joined->True,PlotRange->{{0,50},{0,1}},InterpolationOrder->0,Epilog->{PointSize[Large],Red,Point[data[3.552,0.01][[1;;50]]]},PlotLabel->Style[Framed[a==3.552],14,Blue,Background->Lighter[Yellow]]]

plot7=ListLinePlot[data[3.565,0.01][[1;;100]],Joined->True,PlotRange->{{0,100},{0,1}},InterpolationOrder->0,Epilog->{PointSize[Large],Red,Point[data[3.565,0.01][[1;;100]]]},PlotLabel->Style[Framed[a==3.565],14,Blue,Background->Lighter[Yellow]]]

plot8=ListLinePlot[data[3.7,0.01][[1;;200]],Joined->True,PlotRange->{{0,200},{0,1}},InterpolationOrder->0,Epilog->{PointSize[Large],Red,Point[data[3.7,0.01][[1;;200]]]},PlotLabel->Style[Framed[a==3.7],14,Blue,Background->Lighter[Yellow]]]

plot9=ListLinePlot[data[3.8,0.01][[1;;200]],Joined->True,PlotRange->{{0,200},{0,1}},InterpolationOrder->0,Epilog->{PointSize[Large],Red,Point[data[3.8,0.01][[1;;200]]]},PlotLabel->Style[Framed[a==3.8],14,Blue,Background->Lighter[Yellow]]]

plot10=ListLinePlot[data[3.8285,0.01][[1;;200]],Joined->True,PlotRange->{{0,200},{0,1}},InterpolationOrder->0,Epilog->{PointSize[Large],Red,Point[data[3.8285,0.01][[1;;200]]]},PlotLabel->Style[Framed[a==3.8285],14,Blue,Background->Lighter[Yellow]]]

plot11=ListLinePlot[data[3.8415,0.64][[1;;150]],Joined->True,PlotRange->{{0,150},{0,1}},InterpolationOrder->0,Epilog->{PointSize[Large],Red,Point[data[3.8415,0.64][[1;;150]]]},PlotLabel->Style[Framed[a==3.8415],14,Blue,Background->Lighter[Yellow]]
]

plot12=ListLinePlot[data[4.0,0.01][[1;;500]],Joined->True,PlotRange->{{0,500},{0,1}},InterpolationOrder->0,Epilog->{PointSize[Large],Red,Point[data[4.0,0.01][[1;;500]]]},PlotLabel->Style[Framed[a==4],14,Blue,Background->Lighter[Yellow]]
]

Show[GraphicsGrid[{{plot1,plot2},{plot3,plot4},{plot5,plot6}},Alignment->Left]]

Show[GraphicsGrid[{{plot7,plot8},{plot9,plot10},{plot11,plot12}},Alignment->Left]]

Cobwebbing

dataconv[a_,x_]:=dataconv[a,x]=Table[{Nest[logistic[a],x,i],Nest[logistic[a],x,i+1]},{i,0,50}]

plotF[r_]:=Plot[r x(1-x),{x,0,1},PlotStyle->Blue,AxesLabel->{"x","x'"},PlotRange->{{0,1},{0,1}},LabelStyle->Medium,AspectRatio->1,Frame->True]

plotFqu[r_]:=Plot[(r^2)  x (1-x)(1+r (-1+x) x),{x,0,1},PlotStyle->Green,AxesLabel->{"x","x'"},PlotRange->{{0,1},{0,1}},LabelStyle->Medium,AspectRatio->1,Frame->True]

plotdiag=Plot[x,{x,0,1},PlotStyle->Black];

logitPlot[r_,n_]:=ListLinePlot[dataconv[r,0.01][[1;;n]],Joined->True,InterpolationOrder->0,PlotStyle->{Red,Thin}]

Manipulate[Show[plotF[2.5],plotdiag,logitPlot[2.5,n]],{n,1,25,1}]

Manipulate[Show[plotF[3.1],plotdiag,logitPlot[3.1,n]],{n,1,25,1}]

Manipulate[Show[plotF[3.3],plotFqu[3.3],plotdiag,logitPlot[3.3,n]],{n,1,30,1}]

Manipulate[Show[plotF[3.8],plotdiag,logitPlot[3.8,n]],{n,1,25,1}]