2
$\begingroup$

I plotted the following Poincare section

where I used the following to compute my system,

abc={x2′[t]==1.252y2[t]+ 0.902x2[t]y2[t],y2′[t]== -1.252x2[t]+0.198x2[t]^2-
0.451y2[t]^2 + 0.225y3[t]^2,x3′[t]==1.182y3[t]+0.450x2[t]y3[t],y3′[t]== 
-1.182x3[t]};

Then I define my poincare section which is at $x_{2}=0$,

pscect[{x02_,y02_,x03_,y03_}]:=Reap[NDSolve[{abc,x2[0]==x02,y2[0]==y02
,x3[0]==x03,y3[0]==y03,WhenEvent[x2[t]==0,Sow[{x3[t],y3[t]}]]}
,{},{t,0,1000},MaxSteps->∞]][[-1,1]]

Then at the end I give my initial data and compute the section

abcdata=Map[pscect,{{0,1.0161161413832343`,0.5,0.1},
{0,1.1220844364075793`,0.1,0.1},{0,1.0965528327517897`,0.2,0.2}, 
{0,0.709790051305953`,0.9,0.1},{0,0.8150442470201473`,0.8,0.1},
{0,0.8977252046873757`,0.7,0.1},{0,0.963660818194847`,0.6,0.1},
{0,0.9438636523615057`,0.5,0.4},{0,1.0526248948837726`,0.3,0.3}}];
ListPlot[abcdata,ImageSize->Large]

My problem is that the plot contains orbits which are not in one direction and intersects itself in the $x$-axis. I figured out that in order to evade this problem I should not draw all points that Mathematica produces but draw only every second point.

Could someone help me to plot only every second point? Because I have no idea how to do this correctly.

Thanks in advance

$\endgroup$

closed as off-topic by yohbs, MarcoB, Feyre, happy fish, Young Nov 17 '16 at 14:44

This question appears to be off-topic. The users who voted to close gave this specific reason:

  • "This question arises due to a simple mistake such as a trivial syntax error, incorrect capitalization, spelling mistake, or other typographical error and is unlikely to help any future visitors, or else it is easily found in the documentation." – yohbs, MarcoB, Feyre, happy fish, Young
If this question can be reworded to fit the rules in the help center, please edit the question.

  • 1
    $\begingroup$ Does ListPlot[abcdata[[1;;-1;;2]]] do what you need? $\endgroup$ – N.J.Evans Nov 14 '16 at 16:09
  • $\begingroup$ The above solution should answer your question, but are you sure that's really what you want to do? Why would the orbits be elliptic? I don't think Mathematica computed wrong points. $\endgroup$ – anderstood Nov 14 '16 at 16:23
  • $\begingroup$ @anderstood I changed my OP a little bit, the word elliptic was not correct. $\endgroup$ – just123 Nov 14 '16 at 17:58
  • $\begingroup$ @N.J.Evans , No it does not. For example the Green orbit consists of 2 elliptic orbits which come together at the $x_{3}$ axis. I just want one green orbit. This goes the same for every other color. In order to do that each second point should be drawn. $\endgroup$ – just123 Nov 14 '16 at 17:59
  • $\begingroup$ @anderstood , If the intersection is in one direction, like in this link , instead of two, I should get one orbit – $\endgroup$ – just123 Nov 14 '16 at 18:01
6
$\begingroup$

Mathematica did what you asked it to do. However, if you want to consider points only when the orbit comes from one direction, you should specify it. This can be done by adding x2'[t]>0 in WhenEvent:

pscect[{x02_, y02_, x03_, y03_}] := 
 Reap[NDSolve[{abc, x2[0] == x02, y2[0] == y02, x3[0] == x03, y3[0] == y03, 
     WhenEvent[x2[t] == 0 && x2'[t] > 0, Sow[{x3[t], y3[t]}]]}, {}, {t, 0, 1000}, 
    MaxSteps -> \[Infinity]]][[-1, 1]]

Mathematica graphics

If you want the Poincaré map from the other direction, change of course to x2'[t]<0.


In addition, note that if list is a List, list[[1;;-1;;2]] or list[[;;;;2]] will return every second element, as indicated by N.J.Evans.

$\endgroup$

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