Enige procedures voor het bestuderen van iteraties

iteraties::usage := 
"iteraties[f,x0,k,l] maakt een \
lijst van
 de waarden van de iteraties k tot en met l van de functie g[c]:x->g[c][x] \
met startwaarde x0."

iteraties[f_, x0_, k_, l_] := 
        Take[
NestList[f, x0, l], 
k - 
              l - 1
] /; k ≤ l;

?iteraties

iteraties[f, a, 3, 6]

\(bifurcatie::usage := 
"bifurcatie[g,x0,k,l,cmin,cmax,dc] maakt een
bifurcatieplot voor g met de parameter c lopend van
cmin naar cmax in stapjes dc.
 Wat geplot wordt zijn steeds de waarden van de iteraties k tot en met l van de functie g[c]:x->g[c][x] met startwaarde x0."\)

\(\(bifurcatie[g_, x0_, k_, l_, cmin_, cmax_, dc_] := \ 
        ListPlot[
Flatten[
Table[
Transpose[
{Table[c, {l - k + 1}], 
                  iteraties[g[c], x0, k, 
                    l]}
], 
{c, cmin, 
                cmax, dc}
], 
            1
], 
AxesLabel -> {"parameter", "x(k)...x(l)"}, 
AspectRatio -> 
            1
];\)\)

?bifurcatie

cobweb::usage := "cobweb[f,x0,k,l] geeft een lijst bestaande uit de \
startwaarde x0 gevolgd door k iteratiewaarden en tekent dan het \
`spinneweb'."

\(\(\(cobweb[f_, x0_, k_] := 
        Module[
{it = 
              iteraties[f, x0, 0, 
                k], 
xoud, \ 
xnieuw, 
plotf = 
              Plot[f[x], {x, 0, 1}, PlotStyle -> Hue[1], 
                DisplayFunction -> 
                  Identity], 
plotdiag = 
              Plot[x, {x, 0, 1}, PlotStyle -> Hue[0.65], 
                DisplayFunction -> 
                  Identity], 
plot}, 
Print[
            it]; 
For[
n = 1; 
            plot = Graphics[{Hue[ .3], PointSize[0.025], 
                  Point[{it[\([1]\)], 0}]}], 
n <= 
              k, 
\(n++\), 
xoud = 
              it[\([n]\)]; 
xnieuw = 
              it[\([n + 
                    1]\)]; 
plot = {
plot, 
Graphics[{
Hue[
                      1], Line[{{xoud, xoud}, {xoud, 
                          xnieuw}}], 
Hue[ .65], 
                    Line[{{xoud, xnieuw}, {xnieuw, 
                          xnieuw}}], 
Hue[ .5], 
                    PointSize[0.025], 
                    Point[{xnieuw, 
                        0}]
}]
}
]; 
Show[
{plotf, 
              plotdiag, plot}, 
AspectRatio -> 
              1, 
DisplayFunction -> $DisplayFunction, 
PlotRange -> {{0, 1}, {0, 
                  1}}, 
PlotLabel -> "Iteratiediagram"
]
];\)\(
\)
    \)\)

?cobweb

herten[a_][b_][x_] := 
        Max[a x (1 - x) - b, 0];
logist[a_][x_] := a x (1 - x);
tent[a_][x_] := a Exp[1 - a x] x;
draai10[
        vector_] := {{Cos[10  Degree], 
            Sin[10  Degree]}, {-Sin[10  Degree], Cos[10  Degree]}} . 
        vector

sliert[startpunt_, lengte_, functie_, prims___] := {prims, 
        Map[Point, iteraties[functie, startpunt, 1, lengte]]}

slierten[lijst_List] := Apply[sliert, lijst]

tweediscr[lijst_List, opts___Rule] := 
      Show[Graphics[{Map[slierten, lijst]}], AspectRatio -> Automatic, 
        opts]

tweediscr[args__, opts___Rule] := 
      Show[Graphics[sliert[args]], AspectRatio -> Automatic, 
        opts]

tweediscr::usage := "tweediscr dient om tweedimensionale iteraties te \
visualiseren.
 tweediscr[startpunt,k,functie] laat de eerste k beelden van de iteratie \
zien.
 Met tweediscr[lijst] kun je een lijst van startpunten verwerken."

?tweediscr

bifurcatie[logist, 0.5, 50, 100, 0, 4, 4/400]

bifurcatie[herten[3.14159], 0.5, 50, 100, 0, 0.06, 0.06/40]

cobweb[herten[3.14159][ .04], 0.2, 5]

tweediscr[{Random[], Random[]}/Sqrt[2], 13, draai10, 
      PlotRange -> {{-1, 1}, {-1, 1}}]

tweediscr[{Random[], Random[]}/Sqrt[2], 13, draai10, PointSize[ .02], 
      Axes -> True, 
      PlotRange -> {{-1, 1}, {-1, 1}}]

tweediscr[
      Table[{Sqrt[2] {Random[], Random[]} - 1/Sqrt[2], 13, draai10, 
          PointSize[ .02], Hue[i/6]}, {i, 6}], Axes -> True, 
      PlotRange -> {{-1, 1}, {-1, 1}}]

lijst = 
        Table[{Sqrt[2] {Random[], Random[]} - 1/Sqrt[2], 13, draai10, 
            PointSize[ .02], Hue[i/6]}, {i, 6}];

startlijst = 
        Table[{lijst[[i, 1]], 1, draai10, PointSize[ .03], Hue[i/6]}, {i, 
            6}];

tweediscr[Join[startlijst, lijst], Axes -> True, 
      PlotRange -> {{-1, 1}, {-1, 1}}]