27
$\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$
1
  • $\begingroup$ RSolve and then Scope. $\endgroup$
    – Sektor
    Oct 4, 2014 at 15:14

5 Answers 5

45
$\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$
4
  • $\begingroup$ Thanks a lot ybeltukov, honestly couldn't ask for a better answer. This helps a lot. $\endgroup$
    – Ellie
    Oct 4, 2014 at 15:29
  • $\begingroup$ +1, but where could I find the Dottie-number in your fast-moving solution ??? $\endgroup$
    – eldo
    Oct 4, 2014 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, 2014 at 20:24
  • 2
    $\begingroup$ @ybeltukov beautiful visualization as OP asked, esp logistic map with parameter tuning...+1 :) $\endgroup$
    – ubpdqn
    Oct 5, 2014 at 4:32
11
$\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$
0
3
$\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$
2
  • $\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, 2017 at 2:50
  • $\begingroup$ Yes, you are correct. Manipulate acting on logistic is fast, efficient, and useful. $\endgroup$
    – TheDoctor
    Jun 8, 2017 at 13:27
1
$\begingroup$

Another realization of ybeltukov's code.

start=1/2;
f[x_] = x + Sin[x];
Manipulate[
Show[Plot[{x, f[x]}, {x, 0, Pi}],
NestList[{Last@#, f[First@# ]} &, {start, f[start]}, n] // ListLinePlot
], {n, 1, 10, 1}
]

enter image description here

$\endgroup$
0
$\begingroup$

Newton secant method (provided by anonymous users):

NewtonRaphson[func_, x_, start_ : 1.0, iter_ : 10] :=
 
 Module[
  
  {pts, xold = start, xnew, f, df, rangea, rangeb, labelPts, 
   labelLines},
  
  pts = {};
  f = func; Print["f[", x, "]  = ", f];
  df = \!\(
\*SubscriptBox[\(∂\), \(x\)]f\);
  Print["f'[", x, "] = ", df];
  Do[
   
   AppendTo[pts, {xold, 0}];
   AppendTo[pts, {xold, f /. x -> xold}];
   xnew = xold - (f /. x -> xold)/(df /. x -> xold);
   xold = xnew,
   
   {k, 1, iter}
   
   ];
  Print["Root  = ", xnew];
  rangea = Floor[Min[pts] - 1];
  rangeb = Ceiling[Max[pts] + 1];
  labelPts = {{PointSize[.03], Point[{start, 0.}]}, {PointSize[.03], 
     Point[{xnew, 0.}]}};
  labelLines =
   Join[
    labelPts,
    Table[
     {Thickness[.0007 i], Dashing[{.02, .01}], 
      Line[Take[pts, {i, i + 1}]]},
     {i, 1, Length[pts] - 1}
     ]
    ];
  Plot[
   f,
   {x, rangea, rangeb},
   PlotRange -> All,
   PlotStyle -> Thickness[.007], Epilog -> labelLines
   ]
  
  ]

NewtonRaphson[Sin[x], x, 1.15, 5]

enter image description here

$\endgroup$

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.