# Poincaré map for dynamic billiard

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.

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

• I did this in Excel once... – dr.blochwave Oct 18 '14 at 13:53
• focalRadius function is missing – chris Oct 18 '14 at 13:56
• 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 (?) – chris Oct 18 '14 at 13:58
• @chris yes indeed, but it runs without it, just remove the tick of "foci" (see image), and it'll be fine. – Ellie Oct 18 '14 at 13:58
• 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. – chris Oct 18 '14 at 14:04

{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]};
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

or

or

• 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 :( – Ellie Oct 18 '14 at 15:53
• sure: you just have to find the intersections of the lines with your plane... – chris Oct 18 '14 at 16:42
• I want to vote this up 1000 times! Thank you very much! – Sam Lisi Apr 17 '18 at 14:52