4
$\begingroup$

For the Henon Map: $$ x_{n+1}=y_n+1-αx_n^2, \quad y_{n+1}=β x_n$$ I would like to discover period doubling bifurcations by varying the parameter $α$ and plotting $x_n,y_n$ versus the iterations $n$ of the map and then print below the values of the points in order to distinguish period cycles.

For one dimensional systems of the form $x_{n+1}=f(x_n)$ the period-$2$ cycles happen when the system: $$ x_1=f(x_2) \\ x_2=f(x_1) $$ has a unique solution. In other words, the trajetory "jumps" between $x_1$ and $x_2$ so while iterating the map they keep appearing (until a certain value of the parameter of the system). I have managed to do something similar for the map

$$ x_{n+1}=μ-x_n^4$$ as shown below:

Manipulate[Module[{list = NestList[μ - #^4 &, x0, 100]}, list2 = list;
Column[{ListLinePlot[list, PlotRange -> {-1, 1.5}, 
ImageSize -> {450, 375}], 
TableForm[Transpose@{Range[86, 101], list[[-16 ;;]]}, 
TableHeadings -> {None, {"point", "x"}}]}]], {{μ, 0.2, 
"parameter μ"}, 0, 4, 
Appearance -> "Labeled"}, {{x0, 0.4, 
"Initial \!\(\*SubscriptBox[\(x\), \(0\)]\)"}, 0, 1, 
Appearance -> "Labeled"}]

and one can see the period two cycle (red and green are the points that repeat themselves) for a certain value of $μ$. enter image description here

For a 2D system, in our case the Henon map, period-$2$ cycle means that the system: $$ 1)x_1=y_2+1-αx_2^2,\quad y_1=β x_2 \\ 2)x_2=y_1+1-αx_1^2, \quad y_2=β x_1 $$ has a unique solution and that this solution consists of two pairs of points $(x_1,y_1)$ and $(x_2,y_2)$. In this case the trajectory jumps between these two points on the plane (while at the 1D case it would be on a line).

I am actually curious how one would do it. I mean now, it has to return a pair of points each time right?

Finally, I would like to plot the Henon map after lets say $n=100$ iterations for $β=0.3$ fixed and $α$ varying until $. How can I do that?

Thank you all in advance!

EDIT Since the Henon Map is defined as above $$ x_{n+1}=y_n+1-αx_n^2, \quad y_{n+1}=β x_n$$ all I actually need is to do the same but just for the $x_{n+1}$ of the system because (and I just realized this) $y_{n+1}$ is just $β$ times the $x_n$ part! Therefore, I just want to plot $x_{n+1}$ vs $n$ and then I can deduce the value of $y_n$ but definition of the map!

I guess that is correct, right?

Improve this question
$\endgroup$
5
  • $\begingroup$ I removed my answer for the time being. It will have to be up to someone else to find period doubling bifurcations. $\endgroup$
    – C. E.
    Jun 30, 2016 at 11:53
  • $\begingroup$ @C.E. I can still the plot command you helped me with while giving time for someone to help with the period doubling. Could you please post again? $\endgroup$
    – Bazinga
    Jun 30, 2016 at 12:02
  • $\begingroup$ ok, I've undeleted my answer. $\endgroup$
    – C. E.
    Jun 30, 2016 at 12:15
  • 1
    $\begingroup$ You have lumped together a simple mathemaitca question with one that is arguably out of scope of this site. At the very least you should show how you compute the "period" of the sequence. $\endgroup$
    – george2079
    Jun 30, 2016 at 14:51
  • $\begingroup$ @george2079 Ok, I mistakenly took for granted that the period doubling was something widely known. I will edit the question. $\endgroup$
    – Bazinga
    Jun 30, 2016 at 14:53

2 Answers 2

Reset to default
2
$\begingroup$

Here is the equivalent of your 1-d approach, using @ ce's henon

henon[alpha_, beta_][{x_, y_}] := {y + 1 - alpha x^2, beta x}

Manipulate[
  list = NestWhileList[henon[a, b], {1, 1}, Max[Abs[#]] < 200 &, 1, 2000];
  ListPlot[list[[-Min[20, Length@list] ;;]], 
      PlotRange -> All], {{a, -.3}, -1, 1}, {{b, -.4}, -1, 1}]

the trick here is to use NestWhile set up to abort when the sequence diverges.

I didn't have any luck finding solutions, but it should get you started.

Edit: another approach:

(this take a few minutes)

err[a_?NumericQ, b_] :=
 StandardDeviation[#[[-Min[20, Length@#] ;;, 1]] &@
   NestWhileList[henon[a, b], {1, 1}, Max[Abs[#]] < 200 &, 1, 2000]]
s = NMinimize[ err[a, b] , {a, b}]

{0., {a -> -0.329763, b -> -0.485251}}

 NestWhileList[henon[a, b] /. s[[2]], {1, 1}, 
    Max[Abs[#]] < 200 &, 1, 20]

{{1, 1}, {2.32976, -0.485251}, {2.30463, -1.13052}, {1.62096, -1.11832}, {0.748128, -0.786571}, {0.397995, -0.36303}, {0.689205, -0.193128}, {0.963511, -0.334437}, {0.971699, -0.467544}, {0.843817, -0.471518}, {0.763282, -0.409463}, {0.782657, -0.370383}, {0.831613, -0.379785}, {0.848273, -0.403541}, {0.833745, -0.411625}, {0.817603, -0.404575}, {0.815862, -0.396743}, {0.822758, -0.395898}, {0.827328, -0.399244}, {0.826469, -0.401462}, {0.823783, -0.401045}}

Improve this answer
$\endgroup$
2
  • $\begingroup$ Thank you for taking time to help me with this one. On the first piece of code that you provided I tried to run it but it returns "aborted" error. I really dont know why this happens :/ The second part of your answer runs perfectly, but to be honest, I do not understand what exactly is it doing. Is it predefining in some way the parameters $α,β$? Because I would like to vary them. I will also edit the question a bit, have a look. Thanks again $\endgroup$
    – Bazinga
    Jun 30, 2016 at 18:45
  • $\begingroup$ It is ok now, I managed to make it work. I used from your code just to print the $x$ values and tried to see it as 1D. I find the correct results. Again, many many thanks! $\endgroup$
    – Bazinga
    Jun 30, 2016 at 20:53
3
$\begingroup$

First define the map:

henon[alpha_, beta_][{x_, y_}] := {y + 1 - alpha x^2, beta x}

And then you can do something like

list = NestList[henon[1.4, 0.3], {1, 1}, 10000];
ListPlot[list]

Mathematica graphics

It is straightforward to wrap this in Manipulate.

Improve this answer
$\endgroup$
4
  • $\begingroup$ Thank you for your answer. Does {1,1} inside your code stand for initial conditions? Also, what about the main part of the question? Do you know any possible way that this can be done? Again, thanks! $\endgroup$
    – Bazinga
    Jun 30, 2016 at 11:33
  • $\begingroup$ Yes, {1,1} is the initial values. I don't know how to find the period doublings at this moment. $\endgroup$
    – C. E.
    Jun 30, 2016 at 12:16
  • $\begingroup$ Is it possible that you also put it in Manipulate? I know it sounds a bit silly, but I am doing something wrong with it. $\endgroup$
    – Bazinga
    Jun 30, 2016 at 12:39
  • 1
    $\begingroup$ @Mitscaype Like this: Manipulate[ ListPlot[NestList[henon[alpha, 0.3], {1, 1}, 1000]], {alpha, 1.3, 1.4}, ContinuousAction -> False] but watch out, it seems like it will overflow if alpha is larger than 1.4, if you do enough iterations. $\endgroup$
    – C. E.
    Jun 30, 2016 at 12:48

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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