Cell[CellGroupData[{Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"cobweb", "[", RowBox[{ "\[Lambda]_", ",", " ", "z_", ",", " ", "x0_", ",", " ", "iter_"}], "]"}], " ", ":=", " ", RowBox[{"Quiet", "[", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{"data1", ",", " ", "data2"}], "}"}], ",", " ", " ", RowBox[{"With", "[", RowBox[{ RowBox[{"{", RowBox[{"p", " ", "=", " ", RowBox[{"NestList", "[", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"\[Lambda]", " ", RowBox[{ RowBox[{"(", RowBox[{"1", " ", "-", " ", SuperscriptBox[ RowBox[{"Abs", "[", "#", "]"}], "z"]}], ")"}], "/", "2"}]}], " ", "-", " ", "1"}], ")"}], "&"}], ",", " ", "x0", ",", " ", "iter"}], "]"}]}], "}"}], ",", " ", " ", RowBox[{ RowBox[{"data1", " ", "=", " ", RowBox[{"Union", "[", RowBox[{ RowBox[{"{", RowBox[{"{", RowBox[{"0", ",", " ", RowBox[{"p", "[", RowBox[{"[", "1", "]"}], "]"}], ",", " ", "0"}], "}"}], "}"}], ",", " ", RowBox[{"Table", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{"2", "i"}], " ", "-", " ", "1"}], ",", " ", RowBox[{"p", "[", RowBox[{"[", "i", "]"}], "]"}], ",", " ", RowBox[{"p", "[", RowBox[{"[", RowBox[{"i", " ", "+", " ", "1"}], "]"}], "]"}]}], "}"}], ",", " ", RowBox[{"{", RowBox[{"i", ",", " ", "1", ",", " ", RowBox[{ RowBox[{"Length", "[", "p", "]"}], " ", "-", " ", "1"}], ",", " ", "1"}], "}"}]}], "]"}], ",", " ", RowBox[{"Table", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"2", "i"}], ",", " ", RowBox[{"p", "[", RowBox[{"[", RowBox[{"i", " ", "+", " ", "1"}], "]"}], "]"}], ",", " ", RowBox[{"p", "[", RowBox[{"[", RowBox[{"i", " ", "+", " ", "1"}], "]"}], "]"}]}], "}"}], ",", " ", RowBox[{"{", RowBox[{"i", ",", " ", "1", ",", " ", RowBox[{ RowBox[{"Length", "[", "p", "]"}], " ", "-", " ", "1"}], ",", " ", "1"}], "}"}]}], "]"}]}], "]"}]}], ";", " ", RowBox[{"data2", " ", "=", " ", RowBox[{"Table", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"data1", "[", RowBox[{"[", RowBox[{"i", ",", " ", "2"}], "]"}], "]"}], ",", " ", RowBox[{"data1", "[", RowBox[{"[", RowBox[{"i", ",", " ", "3"}], "]"}], "]"}]}], "}"}], ",", " ", RowBox[{"{", RowBox[{"i", ",", " ", "1", ",", " ", RowBox[{ RowBox[{"Length", "[", "data1", "]"}], " ", "-", " ", "1"}], ",", " ", "1"}], "}"}]}], "]"}]}]}]}], "]"}]}], "]"}], "]"}]}], ";"}]], "Input", CellGroupingRules->{"GroupTogetherGrouping", 10000.}, InitializationCell->True, CellChangeTimes->{ 3.35696210375764*^9, {3.59517416054237*^9, 3.595174213053427*^9}, { 3.595174472181095*^9, 3.5951744756273947`*^9}, 3.760735787256022*^9}, CellID->298484226], Cell[BoxData[ RowBox[{ "Manipulate", "[", " ", " ", RowBox[{ RowBox[{"Quiet", "[", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{"gr1", ",", " ", "gr2"}], "}"}], ",", " ", " ", RowBox[{ RowBox[{"gr1", " ", "=", " ", RowBox[{"Plot", "[", RowBox[{ RowBox[{"{", RowBox[{"x", ",", " ", RowBox[{ RowBox[{"\[Lambda]", " ", RowBox[{ RowBox[{"(", RowBox[{"1", " ", "-", " ", SuperscriptBox[ RowBox[{"Abs", "[", "x", "]"}], "z"]}], ")"}], "/", "2"}]}], " ", "-", " ", "1"}]}], "}"}], ",", " ", RowBox[{"{", RowBox[{"x", ",", " ", RowBox[{"-", "1"}], ",", " ", "1"}], "}"}], ",", " ", RowBox[{"PlotRange", " ", "->", " ", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", "1"}], ",", " ", "1"}], "}"}], ",", " ", RowBox[{"{", RowBox[{ RowBox[{"-", "1"}], ",", " ", "1"}], "}"}]}], "}"}]}]}], "]"}]}], ";", " ", RowBox[{"gr2", " ", "=", " ", RowBox[{"ListPlot", "[", RowBox[{ RowBox[{"cobweb", "[", RowBox[{ "\[Lambda]", ",", " ", "z", ",", " ", "x0", ",", " ", "iter"}], "]"}], ",", " ", RowBox[{"Joined", " ", "->", " ", "True"}], ",", " ", RowBox[{"PlotStyle", " ", "->", " ", RowBox[{"{", RowBox[{ RowBox[{"GrayLevel", "[", "0.", "]"}], ",", " ", RowBox[{"Opacity", "[", "0.3", "]"}]}], "}"}]}]}], "]"}]}], ";", " ", RowBox[{"Show", "[", RowBox[{"gr1", ",", " ", "gr2", ",", " ", RowBox[{"Frame", " ", "->", " ", "True"}], ",", " ", RowBox[{"ImageSize", " ", "->", " ", RowBox[{"{", RowBox[{"600", ",", "400"}], "}"}]}]}], "]"}]}]}], "]"}], "]"}], ",", " ", " ", " ", RowBox[{"Control", "[", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ "\[Lambda]", ",", " ", "4", ",", " ", "\"\\""}], "}"}], ",", " ", "1", ",", " ", "4", ",", " ", "0.0001", ",", " ", RowBox[{"ImageSize", " ", "->", " ", "Large"}], ",", " ", RowBox[{ "Appearance", " ", "->", " ", "\"\\""}]}], "}"}], "]"}], ",", " ", RowBox[{"Control", "[", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"z", ",", " ", "2", ",", " ", RowBox[{"Row", "[", RowBox[{"{", RowBox[{"\"\\"", ",", " ", RowBox[{"Style", "[", RowBox[{"\"\\"", ",", " ", "Italic"}], "]"}]}], "}"}], "]"}]}], "}"}], ",", " ", RowBox[{"1", "/", "2"}], ",", " ", "6", ",", " ", RowBox[{"1", "/", "10000"}], ",", " ", RowBox[{"ImageSize", " ", "->", " ", "Large"}], ",", " ", RowBox[{ "Appearance", " ", "->", " ", "\"\\""}]}], "}"}], "]"}], ",", " ", RowBox[{"Control", "[", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"x0", ",", " ", "0.9362", ",", " ", RowBox[{"Row", "[", RowBox[{"{", RowBox[{"\"\\"", ",", " ", SubscriptBox[ RowBox[{"Style", "[", RowBox[{"\"\\"", ",", " ", "Italic"}], "]"}], "0"]}], "}"}], "]"}]}], "}"}], ",", " ", RowBox[{"-", "1"}], ",", " ", "1", ",", " ", "0.0001", ",", " ", RowBox[{"ImageSize", " ", "->", " ", "Large"}], ",", " ", RowBox[{ "Appearance", " ", "->", " ", "\"\\""}]}], "}"}], "]"}], ",", " ", RowBox[{"Control", "[", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"iter", ",", " ", "2000", ",", " ", RowBox[{"Row", "[", RowBox[{"{", RowBox[{"\"\\"", ",", " ", RowBox[{"Style", "[", RowBox[{"\"\\"", ",", " ", "Italic"}], "]"}]}], "}"}], "]"}]}], "}"}], ",", " ", "1", ",", " ", "2000", ",", " ", "1", ",", " ", RowBox[{"ImageSize", " ", "->", " ", "Large"}], ",", " ", RowBox[{ "Appearance", " ", "->", " ", "\"\\""}]}], "}"}], "]"}], ",", " ", " ", RowBox[{"FrameMargins", " ", "->", " ", "0"}], ",", " ", " ", RowBox[{"ControlPlacement", " ", "->", " ", "Top"}], ",", " ", " ", RowBox[{"AutorunSequencing", " ", "->", " ", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"1", ",", " ", "4"}], "}"}], ",", " ", RowBox[{"{", RowBox[{"2", ",", " ", "4"}], "}"}], ",", " ", RowBox[{"{", RowBox[{"3", ",", " ", "4"}], "}"}], ",", " ", RowBox[{"{", RowBox[{"4", ",", " ", "4"}], "}"}]}], "}"}]}], ",", " ", " ", RowBox[{"SaveDefinitions", " ", "->", " ", "True"}]}], "]"}]], "Input", CellGroupingRules->{"GroupTogetherGrouping", 10000.}, CellChangeTimes->{ 3.35696210375764*^9, 3.595166291346342*^9, {3.5951672461697817`*^9, 3.5951672486024046`*^9}, {3.595174222412675*^9, 3.5951742418646617`*^9}, {3.5951742896395564`*^9, 3.5951743131722665`*^9}, {3.5951744818625584`*^9, 3.595174509537033*^9}, 3.595174549611787*^9, { 3.5951745840227594`*^9, 3.595174601451395*^9}, { 3.59517556811224*^9, 3.595175610924821*^9}, {3.595358965003065*^9, 3.595359003127756*^9}, 3.7607357872459784`*^9}], Cell[BoxData[ TagBox[ StyleBox[ DynamicModuleBox[{$CellContext`iter$$ = 2000, $CellContext`x0$$ = 0.9362, $CellContext`z$$ = 2, $CellContext`\[Lambda]$$ = 4, Typeset`show$$ = True, Typeset`bookmarkList$$ = {}, Typeset`bookmarkMode$$ = "Menu", Typeset`animator$$, Typeset`animvar$$ = 1, Typeset`name$$ = "\"untitled\"", Typeset`specs$$ = {{{ Hold[$CellContext`\[Lambda]$$], 4, "parameter value, \[Lambda]"}, 1, 4, 0.0001}, {{ Hold[$CellContext`z$$], 2, Row[{"unimodality, ", Style["z", Italic]}]}, Rational[1, 2], 6, Rational[1, 10000]}, {{ Hold[$CellContext`x0$$], 0.9362, Row[{"initial value, ", Subscript[ Style["x", Italic], 0]}]}, -1, 1, 0.0001}, {{ Hold[$CellContext`iter$$], 2000, Row[{"iteration, ", Style["i", Italic]}]}, 1, 2000, 1}}, Typeset`size$$ = { 600., {198., 202.}}, Typeset`update$$ = 0, Typeset`initDone$$, Typeset`skipInitDone$$ = False, $CellContext`\[Lambda]$684120$$ = 0, $CellContext`z$684121$$ = 0, $CellContext`x0$684122$$ = 0, $CellContext`iter$684123$$ = 0}, DynamicBox[Manipulate`ManipulateBoxes[ 1, StandardForm, "Variables" :> {$CellContext`iter$$ = 2000, $CellContext`x0$$ = 0.9362, $CellContext`z$$ = 2, $CellContext`\[Lambda]$$ = 4}, "ControllerVariables" :> { Hold[$CellContext`\[Lambda]$$, \ $CellContext`\[Lambda]$684120$$, 0], Hold[$CellContext`z$$, $CellContext`z$684121$$, 0], Hold[$CellContext`x0$$, $CellContext`x0$684122$$, 0], Hold[$CellContext`iter$$, $CellContext`iter$684123$$, 0]}, "OtherVariables" :> { Typeset`show$$, Typeset`bookmarkList$$, Typeset`bookmarkMode$$, Typeset`animator$$, Typeset`animvar$$, Typeset`name$$, Typeset`specs$$, Typeset`size$$, Typeset`update$$, Typeset`initDone$$, Typeset`skipInitDone$$}, "Body" :> Quiet[ Module[{$CellContext`gr1$, $CellContext`gr2$}, \ $CellContext`gr1$ = Plot[{$CellContext`x, $CellContext`\[Lambda]$$ ((1 - Abs[$CellContext`x]^$CellContext`z$$)/2) - 1}, {$CellContext`x, -1, 1}, PlotRange -> {{-1, 1}, {-1, 1}}]; $CellContext`gr2$ = ListPlot[ $CellContext`cobweb[$CellContext`\[Lambda]$$, \ $CellContext`z$$, $CellContext`x0$$, $CellContext`iter$$], Joined -> True, PlotStyle -> { GrayLevel[0.], Opacity[0.3]}]; Show[$CellContext`gr1$, $CellContext`gr2$, Frame -> True, ImageSize -> {600, 400}]]], "Specifications" :> {{{$CellContext`\[Lambda]$$, 4, "parameter value, \[Lambda]"}, 1, 4, 0.0001, ImageSize -> Large, Appearance -> "Labeled"}, {{$CellContext`z$$, 2, Row[{"unimodality, ", Style["z", Italic]}]}, Rational[1, 2], 6, Rational[1, 10000], ImageSize -> Large, Appearance -> "Labeled"}, {{$CellContext`x0$$, 0.9362, Row[{"initial value, ", Subscript[ Style["x", Italic], 0]}]}, -1, 1, 0.0001, ImageSize -> Large, Appearance -> "Labeled"}, {{$CellContext`iter$$, 2000, Row[{"iteration, ", Style["i", Italic]}]}, 1, 2000, 1, ImageSize -> Large, Appearance -> "Labeled"}}, "Options" :> { FrameMargins -> 0, ControlPlacement -> Top, AutorunSequencing -> {{1, 4}, {2, 4}, {3, 4}, {4, 4}}}, "DefaultOptions" :> {ControllerLinking -> True}], ImageSizeCache->{625., {275., 281.}}, SingleEvaluation->True], Deinitialization:>None, DynamicModuleValues:>{}, Initialization:>({$CellContext`cobweb[ Pattern[$CellContext`\[Lambda], Blank[]], Pattern[$CellContext`z, Blank[]], Pattern[$CellContext`x0, Blank[]], Pattern[$CellContext`iter, Blank[]]] := Quiet[ Module[{$CellContext`data1, $CellContext`data2}, With[{$CellContext`p = NestList[$CellContext`\[Lambda] ((1 - Abs[#]^$CellContext`z)/2) - 1& , $CellContext`x0, $CellContext`iter]}, \ $CellContext`data1 = Union[{{0, Part[$CellContext`p, 1], 0}}, Table[{2 $CellContext`i - 1, Part[$CellContext`p, $CellContext`i], Part[$CellContext`p, $CellContext`i + 1]}, {$CellContext`i, 1, Length[$CellContext`p] - 1, 1}], Table[{2 $CellContext`i, Part[$CellContext`p, $CellContext`i + 1], Part[$CellContext`p, $CellContext`i + 1]}, {$CellContext`i, 1, Length[$CellContext`p] - 1, 1}]]; $CellContext`data2 = Table[{ Part[$CellContext`data1, $CellContext`i, 2], Part[$CellContext`data1, $CellContext`i, 3]}, {$CellContext`i, 1, Length[$CellContext`data1] - 1, 1}]]]], Attributes[Subscript] = {NHoldRest}}; Typeset`initDone$$ = True), SynchronousInitialization->True, UnsavedVariables:>{Typeset`initDone$$}, UntrackedVariables:>{Typeset`size$$}], "Manipulate", Deployed->True, StripOnInput->False], Manipulate`InterpretManipulate[1]]], "Output", CellGroupingRules->{"GroupTogetherGrouping", 10000.}, CellChangeTimes->{3.7607357872462463`*^9}, CellID->761143042] }, {3}]]