7
$\begingroup$

There's a very nice demonstration of dynamic billiard written by Dan S. Reznik that can be found on demonstrations wolfram(along with the code): here

I was thinking whether it would be possible to draw the Poincaré map of the system for different setups (different parameters: initial angle etc), or for a whole run, meaning an animated Poincaré map (like the animated map for the kicked rotator on wiki).

The aim is to draw a Poincaré map for a run, if possible, by run I mean: as you see in the image below, you can press the "play" button for "start position angle" and see the animation.

enter image description here

Any assistance would be greatly appreciated. Thanks to Dan S. Reznik again for this beautiful piece of code.

$\endgroup$
  • $\begingroup$ I did this in Excel once... $\endgroup$ – dr.blochwave Oct 18 '14 at 13:53
  • $\begingroup$ focalRadius function is missing $\endgroup$ – chris Oct 18 '14 at 13:56
  • $\begingroup$ it seems the function you want is getEllipseRefls. You should be able to extract from it the trajectory in order to build your Poincare map (?) $\endgroup$ – chris Oct 18 '14 at 13:58
  • $\begingroup$ @chris yes indeed, but it runs without it, just remove the tick of "foci" (see image), and it'll be fine. $\endgroup$ – Phonon Oct 18 '14 at 13:58
  • $\begingroup$ so what is it you want to slice? extract x position at y=0? For Poincare maps I know you would plot e.g. x and $\dot x$ but here it is not clear. $\endgroup$ – chris Oct 18 '14 at 14:04
7
$\begingroup$

you could start with a simple hack of your code to extract the intersections; Something like

  {x1, y1} = Transpose[line]; 
  {x2, y2} = Transpose[RotateLeft[line]];
  gr2 = {(x1^2 - x1*x2 + y1*(-y1 + y2)), (y1 - y2)} // Transpose // Most;

which can be encapsulated in the ellipseSimLowLevel as follows

  ellipseSimLowLevel[ellPos_, θ_, aimAt_, refls_, ella_, ellb_, showFocii_] := 
  Module[{sph = Circle[{0, 0}, 1.], pt, rhat, nfact = .5, ab, 
  pr = 1.5, line, gr, fdist, focii, ellX, x1, y1, x2, y2, gr2},
  ab = {ella, ellb};
 ellX = ella*clamp[ellPos, -1, 1];
 pt = {ellX, ellipseY[ellX, ab]};
 fdist = focalRadius[ella, ellb];
 focii = 
 If[ella > 
  ellb, {{-fdist, 0}, {fdist, 0}}, {{0, -fdist}, {0, fdist}}];
 rhat = 
 Switch[aimAt, "f1", unit[focii[[1]] - pt], "f2", 
 unit[focii[[2]] - pt], _,(*-r2d[θ Degree].normEllipse[pt,
 ab]*)r2d[θ Degree].{0, -1}];
 line = getEllipseRefls[pt, rhat, ab, refls][[All, 1]];
 gr = {{Scale[sph, ab, {0, 0}]}, {Black, Line[line], 
  PointSize[Medium], Point[line]},
 {PointSize[Large], Red, Thickness[Large], 
  Arrow[{pt - nfact*rhat, pt}]},
 If[showFocii, {PointSize[Large], Blue, Point[focii]}, {}]};
 gr = Graphics[gr, Frame -> True, AspectRatio -> Automatic, 
 ImageSize -> {450, 450}, PlotRange -> {{-pr, pr}, {-pr, pr}}];
 (* NEW PART *)
{x1, y1} = Transpose[line]; 
{x2, y2} = Transpose[RotateLeft[line]];
 gr2 = {(x1^2 - x1*x2 + y1*(-y1 + y2)), (y1 - y2)} // Transpose // Most;
 gr2 = Graphics[Map[Point, gr2], Frame -> True, AspectRatio -> 1, 
 ImageSize -> {450, 450}];
 Row@{gr, gr2}
 (* END OF NEW PART *)
 ];    

Then the above Manipulate produces

Mathematica graphics

or

Mathematica graphics

or

Mathematica graphics

$\endgroup$
  • $\begingroup$ Okay, is there a way to put a manipulate bar next to the others, that would allow to change the coordinates through which the plane of intersection with phase space passes? sounds unlikely, thought I'd ask :( $\endgroup$ – Phonon Oct 18 '14 at 15:53
  • $\begingroup$ sure: you just have to find the intersections of the lines with your plane... $\endgroup$ – chris Oct 18 '14 at 16:42
  • $\begingroup$ I want to vote this up 1000 times! Thank you very much! $\endgroup$ – Sam Lisi Apr 17 '18 at 14:52

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.