24
$\begingroup$

Is there a way to nicely visualize recursive functions? (diagrams/plots)

More specifically I'm looking for a way to make contrast (visually) between e.g. the cosine function which if continuously applied on itself converges to the Dottie number, whereas e.g. a usual linear function $2x$ if taken recursively keeps diverging.

If it helps, this is asked for pedagogical reasons, in the context of attractors.

$\endgroup$
  • $\begingroup$ RSolve and then Scope. $\endgroup$ – Sektor Oct 4 '14 at 15:14
34
$\begingroup$

Let you have a function and an initial point

f[x_] := Cos[x]
x0 = 0.2;

Then you can calculate a sequence

seq = NestList[f, x0, 10]
(* {0.2, 0.980067, 0.556967, 0.848862, 0.660838, 0.789478, \
0.704216, 0.76212, 0.723374, 0.749577, 0.731977} *)

and vizualize it with a so-called Cobweb plot

p = Join @@ ({{#, #}, {##}} & @@@ Partition[seq, 2, 1]);

Plot[{f[x], x}, {x, 0, π/2}, AspectRatio -> Automatic, 
 Epilog -> {Thick, Opacity[0.6], Line[p]}]

enter image description here

The same for f[x_] := 2x

enter image description here


The logistic map:

logistic[α_, x0_] := Module[{f},
   f[x_] := α x (1 - x);
   seq = NestList[f, x0, 100];
   p = Join @@ ({{#, #}, {##}} & @@@ Partition[seq, 2, 1]);
   Plot[{f[x], x}, {x, 0, 1}, PlotRange -> {0, 1}, 
    Epilog -> {Thick, Opacity[0.6], Line[p]}, ImageSize -> 500]];

t = Table[logistic[α, 0.2], {α, 1, 4, 0.01}];
SetDirectory@NotebookDirectory[];    
Export["logistic.gif", t];

enter image description here

$\endgroup$
  • $\begingroup$ Thanks a lot ybeltukov, honestly couldn't ask for a better answer. This helps a lot. $\endgroup$ – Phonon Oct 4 '14 at 15:29
  • $\begingroup$ +1, but where could I find the Dottie-number in your fast-moving solution ??? $\endgroup$ – eldo Oct 4 '14 at 19:57
  • $\begingroup$ @eldo I consider the question as a question about the visualization of the recursion procedure only. Of course, you can find the final point as you did or with FixedPoint. $\endgroup$ – ybeltukov Oct 4 '14 at 20:24
  • 1
    $\begingroup$ @ybeltukov beautiful visualization as OP asked, esp logistic map with parameter tuning...+1 :) $\endgroup$ – ubpdqn Oct 5 '14 at 4:32
8
$\begingroup$
dottie = FindRoot[Cos[x] == x, {x, 1}] // Values // First

0.739085

Plot[{Cos[x], x}, {x, -5, 5}, 
 Epilog -> {Red, PointSize[0.02], Point[{dottie, dottie}]}]

enter image description here

Convergence can be seen with EvaluationMonitor

{res, {evx}} = 
 Reap[FindRoot[Cos[x] == x, {x, 0}, EvaluationMonitor :> Sow[x]]]

{{x -> 0.739085}, {{0., 1., 0.750364, 0.739113, 0.739085, 0.739085}}}

points = Point @ Transpose[{evx, evx}]

Plot[{Cos[x], x}, {x, -5, 5}, 
 Epilog -> {Red, PointSize[0.02], points}]

enter image description here

Finding Dottie with Newton

fun = Cos[x] - x;

newton[fun_, n_] :=
 With[{f = fun / D[fun, x]}, NestList[# - f /. x -> # &, 0., n]]

points = newton[fun, 5]

{0., 1., 0.750364, 0.739113, 0.739085, 0.739085}

dottie = Last @ points;

ListLinePlot[points,
 Axes -> False,
 Frame -> True,
 FrameTicks -> {{{0, dottie, 1}, None}, {Automatic, None}},
 GridLines -> {Automatic, {0, dottie, 1}},
 Mesh -> All,
 MeshStyle -> Directive[PointSize[Medium], Red],
 ImageSize -> 500,
 PlotRange -> {{0.9, 6.1}, {-0.1, 1.1}}]

enter image description here

FixedPointList

f = # / D[#, x] & [fun]

enter image description here

fpl1 = FixedPointList[# - f /. x -> # &,  0.0];
fpl2 = FixedPointList[# - f /. x -> # &, -0.5];

ListLinePlot[
 {fpl1, fpl2},
 Axes -> False,
 Frame -> True,
 FrameTicks -> {{{-0.5, 0, dottie, 2}, None}, {Automatic, None}},
 GridLines -> {Automatic, {-0.5, 0, dottie, 2}},
 Filling -> {1 -> {2}},
 Mesh -> All,
 MeshStyle -> Directive[PointSize[Medium], Red],
 ImageSize -> 500,
 PlotLegends -> {"Start at   0.0", "Start at -0.5"},
 PlotRange -> {{0.9, 8.1}, {-0.6, 2.2}}]

enter image description here

Interpolation

fun = Cos[x] - x;
f = #/D[#, x] & [fun];
fpl = FixedPointList[# - f /. x -> # &, #] & /@ {0., -0.5, 3.0};
dottie = fpl[[1, -1]];

ListLinePlot[
 fpl,
 InterpolationOrder -> 2,
 Axes -> False,
 Frame -> True,
 FrameTicks -> {{{-0.5, 0, dottie, 2, 3}, None}, {Automatic, None}},
 GridLines -> {Automatic, {-0.5, 0, dottie, 2, 3}},
 Filling -> {{1 -> {2}}, {2 -> {3}}},
 FillingStyle -> Directive[Opacity[0.5], Gray],
 Mesh -> False,
 ImageSize -> 500,
 PlotLegends -> {"Start at   0.0", "Start at -0.5", "Start at   3.0"},
 PlotStyle -> Thickness[0.01],
 PlotRange -> {{0.9, 7.1}, {-0.6, 3.1}}]

enter image description here

$\endgroup$
1
$\begingroup$

Two slight improvements to the code:

[1] Using Function is faster:

f[α_] = Function[x, α x (1 - x)];

[2] One should localise seq, and Riffle is clearer than Join @@ ({{#, #}, {##}} & @@@

logistic[α_, x0_] := Module[{seq},
    seq = NestList[f[α], x0, 100];
    p = Riffle[Transpose[{seq, seq}], Partition[seq, 2, 1]];
    Plot[{f[α]][x], x}, {x, 0, 1},
        AspectRatio -> Automatic,
        PlotRange -> {0, 1},
        Epilog -> {Thick, Opacity[0.6], Line[p]},
        ImageSize -> 500]]

Then I'd use Manipulate to visualize...

$\endgroup$
  • $\begingroup$ I think there is an error in your code. You have f[α]][x], but I think it should be f[α][x]. $\endgroup$ – David May 18 '17 at 2:50
  • $\begingroup$ Yes, you are correct. Manipulate acting on logistic is fast, efficient, and useful. $\endgroup$ – TheDoctor Jun 8 '17 at 13:27

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.