(* Content-type: application/mathematica *)

(*** Wolfram Notebook File ***)
(* http://www.wolfram.com/nb *)

(* CreatedBy='Mathematica 7.0' *)

(*CacheID: 234*)
(* Internal cache information:
NotebookFileLineBreakTest
NotebookFileLineBreakTest
NotebookDataPosition[       145,          7]
NotebookDataLength[     27891,        730]
NotebookOptionsPosition[     25825,        670]
NotebookOutlinePosition[     26208,        686]
CellTagsIndexPosition[     26165,        683]
WindowFrame->Normal*)

(* Beginning of Notebook Content *)
Notebook[{
Cell["Define the the tent map:  (Keeping plenty of accuracy)", "Text",
 CellChangeTimes->{{3.4685169813459997`*^9, 3.4685169914969997`*^9}, {
  3.4685170412060003`*^9, 3.468517058093*^9}, {3.468518921547*^9, 
  3.4685189320030003`*^9}, {3.468521376512*^9, 3.468521377215*^9}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"F", "[", "x_", "]"}], ":=", 
  RowBox[{"If", "[", 
   RowBox[{
    RowBox[{"x", "\[LessSlantEqual]", "0.5"}], ",", " ", 
    RowBox[{"a", " ", "x"}], ",", " ", 
    RowBox[{"a", 
     RowBox[{"(", 
      RowBox[{"1", "-", "x"}], ")"}]}]}], "]"}]}]], "Input",
 CellChangeTimes->{{3.4685170919700003`*^9, 3.468517134475*^9}, 
   3.468517790198*^9, {3.468518259139*^9, 3.468518264498*^9}, {
   3.4685182990889997`*^9, 3.468518300432*^9}, {3.468518332439*^9, 
   3.468518335038*^9}, {3.4685186319890003`*^9, 3.468518632781*^9}, {
   3.468521386705*^9, 3.46852145494*^9}, {3.468521535936*^9, 
   3.4685215364*^9}, {3.468522452116*^9, 3.4685224575629997`*^9}, {
   3.468522497977*^9, 3.468522498281*^9}, {3.46852263513*^9, 
   3.468522640416*^9}, {3.468525022057*^9, 3.4685250396*^9}, {
   3.468525109108*^9, 3.468525114851*^9}, {3.468525373013*^9, 
   3.468525378508*^9}, {3.4685892140013723`*^9, 3.4685892237043233`*^9}}],

Cell[BoxData[
 RowBox[{"F", "[", ".14159", "]"}]], "Input",
 CellChangeTimes->{{3.4685171540290003`*^9, 3.468517166416*^9}, {
  3.4685214624119997`*^9, 3.468521483874*^9}, {3.468521539856*^9, 
  3.468521541199*^9}}],

Cell["Try", "Text",
 CellChangeTimes->{{3.500758411376972*^9, 3.5007584188814015`*^9}}],

Cell[BoxData[
 RowBox[{"a", "=", " ", 
  RowBox[{"3", "/", "10"}]}]], "Input",
 CellChangeTimes->{{3.468521570984*^9, 3.468521575165*^9}, {3.468522656679*^9,
   3.468522659183*^9}}],

Cell["\<\
Make a table of points for repeated applications - NestList works well for \
this\
\>", "Text",
 CellChangeTimes->{{3.4685176142060003`*^9, 3.468517630153*^9}, {
   3.468517719192*^9, 3.468517734895*^9}, {3.4685179038129997`*^9, 
   3.468517904494*^9}, 3.468521551973*^9}],

Cell[BoxData[
 RowBox[{
  RowBox[{"data1", "=", 
   RowBox[{"NestList", "[", 
    RowBox[{"F", ",", ".9", ",", "100"}], "]"}]}], ";"}]], "Input",
 CellChangeTimes->{{3.468517632913*^9, 3.4685176428450003`*^9}, {
  3.4685177416400003`*^9, 3.468517760703*^9}, {3.4685178257469997`*^9, 
  3.4685178853450003`*^9}, {3.4685179166949997`*^9, 3.468517917342*^9}, {
  3.468518093381*^9, 3.468518094356*^9}, {3.4685181886070004`*^9, 
  3.4685181898859997`*^9}, {3.46851830712*^9, 3.4685183100550003`*^9}, {
  3.468518359461*^9, 3.468518362421*^9}, {3.468518554818*^9, 
  3.468518561993*^9}, {3.468518601703*^9, 3.468518646293*^9}, {
  3.468521515561*^9, 3.468521518832*^9}, {3.46852156235*^9, 
  3.468521612443*^9}}],

Cell[BoxData[
 RowBox[{"plot1", "=", 
  RowBox[{"ListPlot", "[", 
   RowBox[{"data1", ",", 
    RowBox[{"Joined", "\[Rule]", "True"}], ",", 
    RowBox[{"PlotRange", "\[Rule]", 
     RowBox[{"{", 
      RowBox[{"0", ",", "1"}], "}"}]}], ",", 
    RowBox[{"PlotStyle", "\[Rule]", 
     RowBox[{"Thickness", "[", "0.01`", "]"}]}], ",", 
    RowBox[{"AspectRatio", "\[Rule]", 
     RowBox[{"1", " ", 
      FractionBox["1", "1"]}]}], ",", 
    RowBox[{"BaseStyle", "->", 
     RowBox[{"{", 
      RowBox[{
       RowBox[{"FontFamily", "->", "\"\<Times\>\""}], ",", 
       RowBox[{"FontSize", "\[Rule]", "18"}]}], "}"}]}]}], "]"}]}]], "Input",
 CellChangeTimes->{{3.46851794723*^9, 3.468517949334*^9}, {3.468518476712*^9, 
  3.468518493678*^9}, {3.468518745705*^9, 3.468518748145*^9}, {
  3.468521628724*^9, 3.4685216414119997`*^9}}],

Cell["Quickly drops to zero - a stable fixed point.  Now try", "Text",
 CellChangeTimes->{{3.468518942474*^9, 3.468518992983*^9}, {3.468521659599*^9,
   3.468521727667*^9}}],

Cell[BoxData[
 RowBox[{"a", "=", 
  RowBox[{"3", "/", "2"}]}]], "Input",
 CellChangeTimes->{{3.468521729762*^9, 3.468521731796*^9}, {3.468522585395*^9,
   3.468522587771*^9}}],

Cell["\<\
Note to have good accuracy below we use a rational expression and not a \
decimal one.\
\>", "Text",
 CellChangeTimes->{{3.468522605977*^9, 3.468522631487*^9}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"data2", "=", 
   RowBox[{"NestList", "[", 
    RowBox[{"F", ",", 
     RowBox[{"9", "/", "10"}], ",", "100"}], "]"}]}], ";"}]], "Input",
 CellChangeTimes->{{3.468517632913*^9, 3.4685176428450003`*^9}, {
  3.4685177416400003`*^9, 3.468517760703*^9}, {3.4685178257469997`*^9, 
  3.4685178853450003`*^9}, {3.4685179166949997`*^9, 3.468517917342*^9}, {
  3.468518093381*^9, 3.468518094356*^9}, {3.4685181886070004`*^9, 
  3.4685181898859997`*^9}, {3.46851830712*^9, 3.4685183100550003`*^9}, {
  3.468518359461*^9, 3.468518362421*^9}, {3.468518671332*^9, 
  3.468518701369*^9}, {3.468521751716*^9, 3.468521758675*^9}, {
  3.46852428921*^9, 3.4685242925620003`*^9}}],

Cell[BoxData[
 RowBox[{"plot2", "=", 
  RowBox[{"ListPlot", "[", 
   RowBox[{"data2", ",", 
    RowBox[{"Joined", "\[Rule]", "True"}], ",", 
    RowBox[{"PlotRange", "\[Rule]", 
     RowBox[{"{", 
      RowBox[{"0", ",", "1"}], "}"}]}], ",", 
    RowBox[{"PlotStyle", "\[Rule]", 
     RowBox[{"Thickness", "[", "0.01`", "]"}]}], ",", 
    RowBox[{"AspectRatio", "\[Rule]", 
     RowBox[{"1", " ", 
      FractionBox["1", "1"]}]}], ",", 
    RowBox[{"BaseStyle", "->", 
     RowBox[{"{", 
      RowBox[{
       RowBox[{"FontFamily", "->", "\"\<Times\>\""}], ",", 
       RowBox[{"FontSize", "\[Rule]", "18"}]}], "}"}]}]}], "]"}]}]], "Input",
 CellChangeTimes->{{3.46851794723*^9, 3.468517949334*^9}, {3.468518476712*^9, 
   3.468518493678*^9}, {3.4685187604230003`*^9, 3.4685187733190002`*^9}, 
   3.468521794293*^9}],

Cell["\<\
Heads to second equilibrium point but does not stay there - unstable.  If we \
start there, we do stay there.\
\>", "Text",
 CellChangeTimes->{{3.468519004091*^9, 3.4685190397720003`*^9}, {
  3.4685219940360003`*^9, 3.468522024458*^9}, {3.468589066648533*^9, 
  3.4685890897663994`*^9}, {3.5007584551934786`*^9, 3.500758459120703*^9}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"data22", "=", 
   RowBox[{"NestList", "[", 
    RowBox[{"F", ",", 
     RowBox[{"3", "/", "5"}], ",", "100"}], "]"}]}], ";"}]], "Input",
 CellChangeTimes->{{3.468517632913*^9, 3.4685176428450003`*^9}, {
  3.4685177416400003`*^9, 3.468517760703*^9}, {3.4685178257469997`*^9, 
  3.4685178853450003`*^9}, {3.4685179166949997`*^9, 3.468517917342*^9}, {
  3.468518093381*^9, 3.468518094356*^9}, {3.4685181886070004`*^9, 
  3.4685181898859997`*^9}, {3.46851830712*^9, 3.4685183100550003`*^9}, {
  3.468518359461*^9, 3.468518362421*^9}, {3.468518671332*^9, 
  3.468518701369*^9}, {3.468521751716*^9, 3.468521758675*^9}, {
  3.468522367744*^9, 3.468522372823*^9}, {3.468522541262*^9, 
  3.4685225574370003`*^9}}],

Cell[BoxData[
 RowBox[{"plot22", "=", 
  RowBox[{"ListPlot", "[", 
   RowBox[{"data22", ",", 
    RowBox[{"Joined", "\[Rule]", "True"}], ",", 
    RowBox[{"PlotRange", "\[Rule]", 
     RowBox[{"{", 
      RowBox[{"0", ",", "1"}], "}"}]}], ",", 
    RowBox[{"PlotStyle", "\[Rule]", 
     RowBox[{"Thickness", "[", "0.01`", "]"}]}], ",", 
    RowBox[{"AspectRatio", "\[Rule]", 
     RowBox[{"1", " ", 
      FractionBox["1", "1"]}]}], ",", 
    RowBox[{"BaseStyle", "->", 
     RowBox[{"{", 
      RowBox[{
       RowBox[{"FontFamily", "->", "\"\<Times\>\""}], ",", 
       RowBox[{"FontSize", "\[Rule]", "18"}]}], "}"}]}]}], "]"}]}]], "Input",
 CellChangeTimes->{{3.46851794723*^9, 3.468517949334*^9}, {3.468518476712*^9, 
   3.468518493678*^9}, {3.4685187604230003`*^9, 3.4685187733190002`*^9}, 
   3.468521794293*^9, {3.468522376106*^9, 3.4685223786730003`*^9}}],

Cell["\<\
Start at fixed point and stays there, as long as do real arithmetic with \
effectively infinite precision - if we use decimal arithmetic\
\>", "Text",
 CellChangeTimes->{{3.468522401109*^9, 3.468522436034*^9}, {3.468522754785*^9,
   3.468522778007*^9}, {3.468525884205*^9, 3.468525899948*^9}, {
  3.500758469817315*^9, 3.5007584899854684`*^9}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"data222", "=", 
   RowBox[{"NestList", "[", 
    RowBox[{"F", ",", ".6", ",", "100"}], "]"}]}], ";"}]], "Input",
 CellChangeTimes->{{3.468517632913*^9, 3.4685176428450003`*^9}, {
  3.4685177416400003`*^9, 3.468517760703*^9}, {3.4685178257469997`*^9, 
  3.4685178853450003`*^9}, {3.4685179166949997`*^9, 3.468517917342*^9}, {
  3.468518093381*^9, 3.468518094356*^9}, {3.4685181886070004`*^9, 
  3.4685181898859997`*^9}, {3.46851830712*^9, 3.4685183100550003`*^9}, {
  3.468518359461*^9, 3.468518362421*^9}, {3.468518671332*^9, 
  3.468518701369*^9}, {3.468521751716*^9, 3.468521758675*^9}, {
  3.468522367744*^9, 3.468522372823*^9}, {3.468522541262*^9, 
  3.4685225574370003`*^9}, {3.468522797656*^9, 3.468522803671*^9}}],

Cell[BoxData[
 RowBox[{"plot222", "=", 
  RowBox[{"ListPlot", "[", 
   RowBox[{"data222", ",", 
    RowBox[{"Joined", "\[Rule]", "True"}], ",", 
    RowBox[{"PlotRange", "\[Rule]", 
     RowBox[{"{", 
      RowBox[{"0", ",", "1"}], "}"}]}], ",", 
    RowBox[{"PlotStyle", "\[Rule]", 
     RowBox[{"Thickness", "[", "0.01`", "]"}]}], ",", 
    RowBox[{"AspectRatio", "\[Rule]", 
     RowBox[{"1", " ", 
      FractionBox["1", "1"]}]}], ",", 
    RowBox[{"BaseStyle", "->", 
     RowBox[{"{", 
      RowBox[{
       RowBox[{"FontFamily", "->", "\"\<Times\>\""}], ",", 
       RowBox[{"FontSize", "\[Rule]", "18"}]}], "}"}]}]}], "]"}]}]], "Input",
 CellChangeTimes->{{3.46851794723*^9, 3.468517949334*^9}, {3.468518476712*^9, 
   3.468518493678*^9}, {3.4685187604230003`*^9, 3.4685187733190002`*^9}, 
   3.468521794293*^9, {3.468522376106*^9, 3.4685223786730003`*^9}, {
   3.4685228071689997`*^9, 3.468522810993*^9}}],

Cell["\<\
We are telling Mathematica to perform decimal arithmetic by using decimal \
value which eventually runs out of precision.  Machine precision here is 16 \
digits which breaks down after about 5 times 16 or 80 steps.  Also note \
\>", "Text",
 CellChangeTimes->{{3.46852282398*^9, 3.468522867058*^9}, {3.468525088891*^9, 
  3.468525098466*^9}, {3.468525632332*^9, 3.468525682817*^9}, {
  3.500758509081561*^9, 3.5007585518490067`*^9}}],

Cell[BoxData[
 RowBox[{"Precision", "[", 
  RowBox[{"3", "/", "5"}], "]"}]], "Input",
 CellChangeTimes->{{3.46852558265*^9, 3.4685255872*^9}}],

Cell[BoxData[
 RowBox[{"Precision", "[", "0.6", "]"}]], "Input",
 CellChangeTimes->{{3.468525591881*^9, 3.468525597711*^9}}],

Cell[BoxData[
 RowBox[{"N", "[", "%", "]"}]], "Input",
 CellChangeTimes->{{3.4685256023050003`*^9, 3.468525604574*^9}}],

Cell[BoxData[
 RowBox[{"N", "[", 
  RowBox[{
   RowBox[{"Log", "[", "10", "]"}], "/", 
   RowBox[{"Log", "[", 
    RowBox[{"3", "/", "2"}], "]"}]}], "]"}]], "Input",
 CellChangeTimes->{{3.468525190133*^9, 3.468525225244*^9}}],

Cell["So start very nearby with full precision", "Text",
 CellChangeTimes->{{3.468525989455*^9, 3.468526001086*^9}, 
   3.46858914428676*^9}],

Cell[BoxData[
 RowBox[{
  RowBox[{"data2222", "=", 
   RowBox[{"NestList", "[", 
    RowBox[{"F", ",", 
     RowBox[{"30000001", "/", "50000000"}], ",", "100"}], "]"}]}], 
  ";"}]], "Input",
 CellChangeTimes->{{3.468517632913*^9, 3.4685176428450003`*^9}, {
  3.4685177416400003`*^9, 3.468517760703*^9}, {3.4685178257469997`*^9, 
  3.4685178853450003`*^9}, {3.4685179166949997`*^9, 3.468517917342*^9}, {
  3.468518093381*^9, 3.468518094356*^9}, {3.4685181886070004`*^9, 
  3.4685181898859997`*^9}, {3.46851830712*^9, 3.4685183100550003`*^9}, {
  3.468518359461*^9, 3.468518362421*^9}, {3.468518671332*^9, 
  3.468518701369*^9}, {3.468521751716*^9, 3.468521758675*^9}, {
  3.468522367744*^9, 3.468522372823*^9}, {3.468522541262*^9, 
  3.4685225574370003`*^9}, {3.468522874875*^9, 3.468522882362*^9}, {
  3.468523765928*^9, 3.468523813781*^9}}],

Cell[BoxData[
 RowBox[{"plot2222", "=", 
  RowBox[{"ListPlot", "[", 
   RowBox[{"data2222", ",", 
    RowBox[{"Joined", "\[Rule]", "True"}], ",", 
    RowBox[{"PlotRange", "\[Rule]", 
     RowBox[{"{", 
      RowBox[{"0", ",", "1"}], "}"}]}], ",", 
    RowBox[{"PlotStyle", "\[Rule]", 
     RowBox[{"Thickness", "[", "0.01`", "]"}]}], ",", 
    RowBox[{"AspectRatio", "\[Rule]", 
     RowBox[{"1", " ", 
      FractionBox["1", "1"]}]}], ",", 
    RowBox[{"BaseStyle", "->", 
     RowBox[{"{", 
      RowBox[{
       RowBox[{"FontFamily", "->", "\"\<Times\>\""}], ",", 
       RowBox[{"FontSize", "\[Rule]", "18"}]}], "}"}]}]}], "]"}]}]], "Input",
 CellChangeTimes->{{3.46851794723*^9, 3.468517949334*^9}, {3.468518476712*^9, 
   3.468518493678*^9}, {3.4685187604230003`*^9, 3.4685187733190002`*^9}, 
   3.468521794293*^9, {3.468522376106*^9, 3.4685223786730003`*^9}, {
   3.46852288898*^9, 3.46852289538*^9}}],

Cell["\<\
Starts to \"run away\" when small initial difference has blown up (40 steps). \
After that we are just seeing mapping steps of finite size.   Look at \
difference between 2 starting points as function of step number using natural \
logs\
\>", "Text",
 CellChangeTimes->{{3.468522922391*^9, 3.4685229651*^9}, 3.468523831995*^9, {
   3.468524036543*^9, 3.468524040591*^9}, {3.468524094091*^9, 
   3.468524100651*^9}, {3.468525718111*^9, 3.4685257465810003`*^9}, 
   3.468526016142*^9, {3.4685891725220356`*^9, 3.4685892032532477`*^9}, {
   3.500758585984959*^9, 3.500758591889297*^9}}],

Cell[BoxData[
 RowBox[{"pp2222", "=", 
  RowBox[{"ListPlot", "[", 
   RowBox[{"Table", "[", 
    RowBox[{
     RowBox[{"{", 
      RowBox[{"n", ",", 
       RowBox[{"Log", "[", 
        RowBox[{"Abs", "[", 
         RowBox[{
          RowBox[{"data22", "[", 
           RowBox[{"[", "n", "]"}], "]"}], "-", 
          RowBox[{"data2222", "[", 
           RowBox[{"[", "n", "]"}], "]"}]}], "]"}], "]"}]}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"n", ",", "1", ",", "40"}], "}"}]}], "]"}], "]"}]}]], "Input",
 CellChangeTimes->{{3.46852298125*^9, 3.468523053553*^9}, {
  3.4685231053380003`*^9, 3.468523251151*^9}, {3.468523407925*^9, 
  3.468523410869*^9}, {3.468523843196*^9, 3.468523886722*^9}, {
  3.468524104862*^9, 3.468524105582*^9}}],

Cell[TextData[{
 "Clearly the 2 numbers are separating exponentially.  Compare to ",
 Cell[BoxData[
  FormBox[
   SuperscriptBox["a", "n"], TraditionalForm]]],
 "  "
}], "Text",
 CellChangeTimes->{{3.468523309777*^9, 3.46852339823*^9}, {3.46852414742*^9, 
  3.468524148842*^9}}],

Cell[BoxData[
 RowBox[{"pp2223", "=", 
  RowBox[{"Plot", "[", 
   RowBox[{
    RowBox[{"Log", "[", 
     RowBox[{
      RowBox[{"(", 
       RowBox[{
        RowBox[{"30000001", "/", "50000000"}], "-", 
        RowBox[{"3", "/", "5"}]}], ")"}], " ", 
      RowBox[{
       RowBox[{"(", 
        RowBox[{"3", "/", "2"}], ")"}], "^", 
       RowBox[{"(", 
        RowBox[{"n", "-", "1"}], ")"}]}]}], "]"}], ",", 
    RowBox[{"{", 
     RowBox[{"n", ",", "1", ",", "40"}], "}"}], ",", 
    RowBox[{"PlotStyle", "\[Rule]", "Red"}]}], "]"}]}]], "Input",
 CellChangeTimes->{{3.468523451559*^9, 3.4685235228859997`*^9}, {
  3.468523563508*^9, 3.4685235771549997`*^9}, {3.46852389845*^9, 
  3.4685239344960003`*^9}, {3.468523967157*^9, 3.468523979892*^9}, {
  3.4685241109969997`*^9, 3.468524111789*^9}, {3.46852419176*^9, 
  3.468524214487*^9}}],

Cell[BoxData[
 RowBox[{"Show", "[", 
  RowBox[{"pp2222", ",", "pp2223"}], "]"}]], "Input",
 CellChangeTimes->{{3.468523526575*^9, 3.468523540388*^9}}],

Cell["\<\
Clearly exponential growth out for 40 steps with exponent \[Lambda] = ln a \
and then the arithmetic starts to break down since differences are of order 1 \
and can no longer grow exponentially.\
\>", "Text",
 CellChangeTimes->{{3.468523716201*^9, 3.468523749023*^9}, {3.468524011041*^9,
    3.4685240122799997`*^9}, {3.468524057958*^9, 3.468524064877*^9}, 
   3.468524122138*^9, {3.4685241571359997`*^9, 3.468524160608*^9}, {
   3.468526035021*^9, 3.468526059259*^9}, {3.468526147783*^9, 
   3.468526158998*^9}}],

Cell["Make it a 2-D plot using these values", "Text",
 CellChangeTimes->{{3.468520591916*^9, 3.468520596083*^9}, {3.468524262658*^9,
   3.468524268009*^9}}],

Cell[BoxData[
 RowBox[{"plot22B", "=", 
  RowBox[{"ListPlot", "[", 
   RowBox[{
    RowBox[{"Join", "[", 
     RowBox[{
      RowBox[{"{", 
       RowBox[{"{", 
        RowBox[{
         RowBox[{"data22", "[", 
          RowBox[{"[", "1", "]"}], "]"}], ",", "0"}], "}"}], "}"}], ",", 
      RowBox[{"Table", "[", 
       RowBox[{
        RowBox[{"{", 
         RowBox[{
          RowBox[{"data22", "[", 
           RowBox[{"[", "n", "]"}], "]"}], ",", 
          RowBox[{"data22", "[", 
           RowBox[{"[", 
            RowBox[{"n", "+", "1"}], "]"}], "]"}]}], "}"}], ",", 
        RowBox[{"{", 
         RowBox[{"n", ",", "1", ",", "40"}], "}"}]}], "]"}]}], "]"}], ",", 
    RowBox[{"Joined", "\[Rule]", "True"}], ",", 
    RowBox[{"PlotRange", "\[Rule]", 
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", 
        RowBox[{"0", ",", "1"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"0", ",", "1"}], "}"}]}], "}"}]}], ",", 
    RowBox[{"PlotStyle", "\[Rule]", 
     RowBox[{"{", 
      RowBox[{
       RowBox[{"Thickness", "[", "0.01`", "]"}], ",", "Blue"}], "}"}]}], ",", 
    RowBox[{"AspectRatio", "\[Rule]", 
     RowBox[{"1", " ", 
      FractionBox["1", "1"]}]}], ",", 
    RowBox[{"BaseStyle", "->", 
     RowBox[{"{", 
      RowBox[{
       RowBox[{"FontFamily", "->", "\"\<Times\>\""}], ",", 
       RowBox[{"FontSize", "\[Rule]", "18"}]}], "}"}]}]}], "]"}]}]], "Input",
 CellChangeTimes->{{3.46851794723*^9, 3.468517949334*^9}, {3.468518476712*^9, 
  3.468518493678*^9}, {3.4685187604230003`*^9, 3.4685187733190002`*^9}, {
  3.468518809501*^9, 3.468518813508*^9}, {3.468518846363*^9, 
  3.468518906984*^9}, {3.468519068775*^9, 3.46851906927*^9}, {
  3.468519321625*^9, 3.468519395212*^9}, {3.468519981332*^9, 
  3.4685199873459997`*^9}, {3.4685203203459997`*^9, 3.4685203975810003`*^9}, {
  3.468520432035*^9, 3.468520524841*^9}, {3.468522142377*^9, 
  3.4685221744230003`*^9}, {3.468524327068*^9, 3.46852435642*^9}}],

Cell[BoxData[
 RowBox[{"plot2222B", "=", 
  RowBox[{"ListPlot", "[", 
   RowBox[{
    RowBox[{"Join", "[", 
     RowBox[{
      RowBox[{"{", 
       RowBox[{"{", 
        RowBox[{
         RowBox[{"data2222", "[", 
          RowBox[{"[", "1", "]"}], "]"}], ",", "0"}], "}"}], "}"}], ",", 
      RowBox[{"Table", "[", 
       RowBox[{
        RowBox[{"{", 
         RowBox[{
          RowBox[{"data2222", "[", 
           RowBox[{"[", "n", "]"}], "]"}], ",", 
          RowBox[{"data2222", "[", 
           RowBox[{"[", 
            RowBox[{"n", "+", "1"}], "]"}], "]"}]}], "}"}], ",", 
        RowBox[{"{", 
         RowBox[{"n", ",", "1", ",", "40"}], "}"}]}], "]"}]}], "]"}], ",", 
    RowBox[{"Joined", "\[Rule]", "True"}], ",", 
    RowBox[{"PlotRange", "\[Rule]", 
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", 
        RowBox[{"0", ",", "1"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"0", ",", "1"}], "}"}]}], "}"}]}], ",", 
    RowBox[{"PlotStyle", "\[Rule]", 
     RowBox[{"{", 
      RowBox[{
       RowBox[{"Thickness", "[", "0.01`", "]"}], ",", "Blue"}], "}"}]}], ",", 
    RowBox[{"AspectRatio", "\[Rule]", 
     RowBox[{"1", " ", 
      FractionBox["1", "1"]}]}], ",", 
    RowBox[{"BaseStyle", "->", 
     RowBox[{"{", 
      RowBox[{
       RowBox[{"FontFamily", "->", "\"\<Times\>\""}], ",", 
       RowBox[{"FontSize", "\[Rule]", "18"}]}], "}"}]}]}], "]"}]}]], "Input",
 CellChangeTimes->{{3.46851794723*^9, 3.468517949334*^9}, {3.468518476712*^9, 
  3.468518493678*^9}, {3.4685187604230003`*^9, 3.4685187733190002`*^9}, {
  3.468518809501*^9, 3.468518813508*^9}, {3.468518846363*^9, 
  3.468518906984*^9}, {3.468519068775*^9, 3.46851906927*^9}, {
  3.468519321625*^9, 3.468519395212*^9}, {3.468519981332*^9, 
  3.4685199873459997`*^9}, {3.4685203203459997`*^9, 3.4685203975810003`*^9}, {
  3.468520432035*^9, 3.468520524841*^9}, {3.468522142377*^9, 
  3.4685221744230003`*^9}, {3.468524327068*^9, 3.46852435642*^9}, {
  3.468524438782*^9, 3.468524487475*^9}, {3.468524562367*^9, 
  3.468524568887*^9}}],

Cell[BoxData[
 RowBox[{"Table", "[", 
  RowBox[{
   RowBox[{"ListPlot", "[", 
    RowBox[{
     RowBox[{"Join", "[", 
      RowBox[{
       RowBox[{"{", 
        RowBox[{"{", 
         RowBox[{
          RowBox[{"data2222", "[", 
           RowBox[{"[", "1", "]"}], "]"}], ",", "0"}], "}"}], "}"}], ",", 
       RowBox[{"Table", "[", 
        RowBox[{
         RowBox[{"{", 
          RowBox[{
           RowBox[{"data2222", "[", 
            RowBox[{"[", "n", "]"}], "]"}], ",", 
           RowBox[{"data2222", "[", 
            RowBox[{"[", 
             RowBox[{"n", "+", "1"}], "]"}], "]"}]}], "}"}], ",", 
         RowBox[{"{", 
          RowBox[{"n", ",", "10", ",", "M"}], "}"}]}], "]"}]}], "]"}], ",", 
     RowBox[{"Joined", "\[Rule]", "True"}], ",", 
     RowBox[{"PlotRange", "\[Rule]", 
      RowBox[{"{", 
       RowBox[{
        RowBox[{"{", 
         RowBox[{"0", ",", "1"}], "}"}], ",", 
        RowBox[{"{", 
         RowBox[{"0", ",", "1"}], "}"}]}], "}"}]}], ",", 
     RowBox[{"PlotStyle", "\[Rule]", 
      RowBox[{"{", 
       RowBox[{
        RowBox[{"Thickness", "[", "0.01`", "]"}], ",", "Blue"}], "}"}]}], ",", 
     RowBox[{"AspectRatio", "\[Rule]", 
      RowBox[{"1", " ", 
       FractionBox["1", "1"]}]}], ",", 
     RowBox[{"BaseStyle", "->", 
      RowBox[{"{", 
       RowBox[{
        RowBox[{"FontFamily", "->", "\"\<Times\>\""}], ",", 
        RowBox[{"FontSize", "\[Rule]", "16"}]}], "}"}]}], ",", 
     RowBox[{"PlotLabel", "\[Rule]", "M"}]}], "]"}], ",", 
   RowBox[{"{", 
    RowBox[{"M", ",", "20", ",", "40"}], "}"}]}], "]"}]], "Input",
 CellChangeTimes->{{3.468520620256*^9, 3.468520717723*^9}, {3.468522203166*^9,
   3.468522252675*^9}, {3.46852451117*^9, 3.4685245321210003`*^9}}],

Cell["\<\
With the 0.9 starting point (above) we eventually move up to the unstable \
fixed point and see aperiodic motion about it.\
\>", "Text",
 CellChangeTimes->{{3.468525782203*^9, 3.468525819841*^9}, {
  3.500758641122113*^9, 3.500758643401243*^9}}],

Cell[BoxData[
 RowBox[{"plot2B", "=", 
  RowBox[{"ListPlot", "[", 
   RowBox[{
    RowBox[{"Join", "[", 
     RowBox[{
      RowBox[{"{", 
       RowBox[{"{", 
        RowBox[{
         RowBox[{"data2", "[", 
          RowBox[{"[", "1", "]"}], "]"}], ",", "0"}], "}"}], "}"}], ",", 
      RowBox[{"Table", "[", 
       RowBox[{
        RowBox[{"{", 
         RowBox[{
          RowBox[{"data2", "[", 
           RowBox[{"[", "n", "]"}], "]"}], ",", 
          RowBox[{"data2", "[", 
           RowBox[{"[", 
            RowBox[{"n", "+", "1"}], "]"}], "]"}]}], "}"}], ",", 
        RowBox[{"{", 
         RowBox[{"n", ",", "1", ",", "40"}], "}"}]}], "]"}]}], "]"}], ",", 
    RowBox[{"Joined", "\[Rule]", "True"}], ",", 
    RowBox[{"PlotRange", "\[Rule]", 
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", 
        RowBox[{"0", ",", "1"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"0", ",", "1"}], "}"}]}], "}"}]}], ",", 
    RowBox[{"PlotStyle", "\[Rule]", 
     RowBox[{"{", 
      RowBox[{
       RowBox[{"Thickness", "[", "0.01`", "]"}], ",", "Blue"}], "}"}]}], ",", 
    RowBox[{"AspectRatio", "\[Rule]", 
     RowBox[{"1", " ", 
      FractionBox["1", "1"]}]}], ",", 
    RowBox[{"BaseStyle", "->", 
     RowBox[{"{", 
      RowBox[{
       RowBox[{"FontFamily", "->", "\"\<Times\>\""}], ",", 
       RowBox[{"FontSize", "\[Rule]", "18"}]}], "}"}]}]}], "]"}]}]], "Input",
 CellChangeTimes->{{3.46851794723*^9, 3.468517949334*^9}, {3.468518476712*^9, 
  3.468518493678*^9}, {3.4685187604230003`*^9, 3.4685187733190002`*^9}, {
  3.468518809501*^9, 3.468518813508*^9}, {3.468518846363*^9, 
  3.468518906984*^9}, {3.468519068775*^9, 3.46851906927*^9}, {
  3.468519321625*^9, 3.468519395212*^9}, {3.468519981332*^9, 
  3.4685199873459997`*^9}, {3.4685203203459997`*^9, 3.4685203975810003`*^9}, {
  3.468520432035*^9, 3.468520524841*^9}, {3.468522142377*^9, 
  3.4685221744230003`*^9}, {3.468524327068*^9, 3.468524391225*^9}}],

Cell["Expect to see things break down numerically after ", "Text",
 CellChangeTimes->{{3.46852493302*^9, 3.468524951882*^9}}],

Cell[BoxData[
 RowBox[{"N", "[", 
  RowBox[{
   RowBox[{"Log", "[", "10", "]"}], "/", 
   RowBox[{"Log", "[", 
    RowBox[{"3", "/", "2"}], "]"}]}], "]"}]], "Input",
 CellChangeTimes->{{3.468525190133*^9, 3.468525225244*^9}}],

Cell[BoxData[
 RowBox[{"Precision", "[", 
  RowBox[{"F", "[", 
   RowBox[{"30000001", "/", "50000000"}], "]"}], "]"}]], "Input",
 CellChangeTimes->{{3.4685253107679996`*^9, 3.468525314615*^9}, {
  3.468525344903*^9, 3.4685253511809998`*^9}}],

Cell[BoxData[
 RowBox[{"Precision", "[", 
  RowBox[{"F", "[", 
   RowBox[{"F", "[", 
    RowBox[{"30000001", "/", "50000000"}], "]"}], "]"}], "]"}]], "Input",
 CellChangeTimes->{{3.4685253107679996`*^9, 3.468525314615*^9}, {
  3.468525344903*^9, 3.4685253511809998`*^9}, {3.468525414083*^9, 
  3.468525421113*^9}}],

Cell[BoxData[
 RowBox[{"Precision", "[", 
  RowBox[{"data2222", "[", 
   RowBox[{"[", "99", "]"}], "]"}], "]"}]], "Input",
 CellChangeTimes->{{3.468525526549*^9, 3.4685255371140003`*^9}}],

Cell[BoxData[
 RowBox[{"Precision", "[", 
  RowBox[{"3", "/", "5"}], "]"}]], "Input",
 CellChangeTimes->{{3.46852558265*^9, 3.4685255872*^9}}],

Cell[BoxData[
 RowBox[{"Precision", "[", "0.6", "]"}]], "Input",
 CellChangeTimes->{{3.468525591881*^9, 3.468525597711*^9}}],

Cell[BoxData[
 RowBox[{"N", "[", "%", "]"}]], "Input",
 CellChangeTimes->{{3.4685256023050003`*^9, 3.468525604574*^9}}]
},
WindowSize->{951, 750},
WindowMargins->{{334, Automatic}, {-34, Automatic}},
Magnification->1.0999996662139893`,
FrontEndVersion->"7.0 for Microsoft Windows (64-bit) (February 18, 2009)",
StyleDefinitions->"Default.nb"
]
(* End of Notebook Content *)

(* Internal cache information *)
(*CellTagsOutline
CellTagsIndex->{}
*)
(*CellTagsIndex
CellTagsIndex->{}
*)
(*NotebookFileOutline
Notebook[{
Cell[545, 20, 276, 3, 30, "Text"],
Cell[824, 25, 952, 19, 32, "Input"],
Cell[1779, 46, 215, 4, 32, "Input"],
Cell[1997, 52, 87, 1, 30, "Text"],
Cell[2087, 55, 181, 4, 32, "Input"],
Cell[2271, 61, 282, 6, 30, "Text"],
Cell[2556, 69, 707, 13, 32, "Input"],
Cell[3266, 84, 830, 20, 76, "Input"],
Cell[4099, 106, 173, 2, 30, "Text"],
Cell[4275, 110, 175, 4, 32, "Input"],
Cell[4453, 116, 170, 4, 30, "Text"],
Cell[4626, 122, 695, 13, 32, "Input"],
Cell[5324, 137, 816, 20, 76, "Input"],
Cell[6143, 159, 345, 6, 30, "Text"],
Cell[6491, 167, 739, 14, 32, "Input"],
Cell[7233, 183, 863, 20, 76, "Input"],
Cell[8099, 205, 354, 6, 30, "Text"],
Cell[8456, 213, 755, 13, 32, "Input"],
Cell[9214, 228, 914, 21, 76, "Input"],
Cell[10131, 251, 443, 7, 49, "Text"],
Cell[10577, 260, 142, 3, 32, "Input"],
Cell[10722, 265, 124, 2, 32, "Input"],
Cell[10849, 269, 119, 2, 32, "Input"],
Cell[10971, 273, 225, 6, 32, "Input"],
Cell[11199, 281, 141, 2, 30, "Text"],
Cell[11343, 285, 841, 16, 32, "Input"],
Cell[12187, 303, 909, 21, 76, "Input"],
Cell[13099, 326, 593, 10, 49, "Text"],
Cell[13695, 338, 746, 19, 32, "Input"],
Cell[14444, 359, 278, 8, 30, "Text"],
Cell[14725, 369, 838, 22, 32, "Input"],
Cell[15566, 393, 150, 3, 32, "Input"],
Cell[15719, 398, 523, 9, 49, "Text"],
Cell[16245, 409, 156, 2, 30, "Text"],
Cell[16404, 413, 1944, 49, 96, "Input"],
Cell[18351, 464, 2038, 51, 96, "Input"],
Cell[20392, 517, 1726, 47, 124, "Input"],
Cell[22121, 566, 255, 5, 30, "Text"],
Cell[22379, 573, 1941, 49, 96, "Input"],
Cell[24323, 624, 125, 1, 30, "Text"],
Cell[24451, 627, 225, 6, 32, "Input"],
Cell[24679, 635, 241, 5, 32, "Input"],
Cell[24923, 642, 314, 7, 32, "Input"],
Cell[25240, 651, 187, 4, 32, "Input"],
Cell[25430, 657, 142, 3, 32, "Input"],
Cell[25575, 662, 124, 2, 32, "Input"],
Cell[25702, 666, 119, 2, 32, "Input"]
}
]
*)

(* End of internal cache information *)