2

How to plot a stadium billiard using cartesian or polar coordinates. I want to show the reflection of a particle inside it.

This is my code so far.

B = StadiumShape[{{-1, 0}, {1, 0}}, 1];
RegionPlot[B, AspectRatio -> 1/2, BoundaryStyle->{Thick, Blue}, PlotStyle-> None]

enter image description here

user444
  • 2,414
  • 1
  • 7
  • 28
  • 1
    Please provide some code that you already have. Otherwise, search through this StackExchange ("billiard", "reflection" ...) – there are already several posts about billiards (example). – Domen Nov 23 '22 at 14:17
  • 3
    Similar to 63690. – Syed Nov 23 '22 at 14:18
  • @Domen, I've updated my question. Please see my code. I simply used the StadiumShape to plot the diagram. But I want to use a proper mathematical equation to plot it. Like they show in DESMOS (https://www.desmos.com/calculator/1hjfojqisv) – user444 Nov 24 '22 at 05:18

1 Answers1

5

  • According to the definition of StadiumShape[{{x1, y1}, {x2, y2}}, r], the distance to the Line[{{x1,y1}, {x2,y2}}] less equal to r.

  • When the r is small enough( r<= 1/2 the length of line {x1,y1},{x2,y2}), to get the boundary of StadiumShape one can simple replace less equal to equal.

eqn = RegionDistance[Line[{{-1, 0}, {1, 0}}], {x, y}] == 1

enter image description here

reg = ImplicitRegion[eqn, {x, y}]
RegionPlot[reg, AspectRatio -> Automatic]

enter image description here

Clear["Global`*"];
reflect[vector_, 
   normal_] = -(vector - 2 (vector - Projection[vector, normal])) // 
   Simplify;
R = StadiumShape[{{-1, 0}, {1, 0}}, 1];
R2 = RegionBoundary[R];
dist = RegionDistance[R2];
proj = RegionNearest[R2];
pt0 = RandomPoint[R, 1][[1]];
v0 = {1., 2.};
d0 = 0.01*Norm[v0];
sol = NDSolveValue[{r''[t] == {0, 0}, r[0] == pt0, r'[0] == v0, 
    WhenEvent[dist@r[t] <= d0, 
     r'[t] -> reflect[r'[t], r[t] - proj@r[t]]]}, r, {t, 0, 100}, 
   MaxStepSize -> 0.01];
ani = Animate[
  Show[Graphics[{{FaceForm[Darker@Green], EdgeForm[Cyan], R}}], 
   ParametricPlot[sol@t, {t, 0, c}, Mesh -> {{c}}, 
     MeshStyle -> {AbsolutePointSize[8], Red}, 
     Method -> {"BoundaryOffset" -> False}, 
     PlotStyle -> {Opacity[.9], White}, PlotPoints -> 80, 
     PerformanceGoal -> "Quality", PlotRange -> All] /. Line -> Arrow,
    Background -> LightGray, PlotRange -> 2], {c, $MachineEpsilon, 
   100}, AnimationRate -> 1, ControlPlacement -> Bottom]

enter image description here

δ = 1;
ani = Animate[
  Show[Graphics[{{FaceForm[Darker@Green], EdgeForm[Cyan], R}}], 
   ParametricPlot[sol@t, {t, c - δ, c}, Mesh -> {{c}}, 
     MeshStyle -> {AbsolutePointSize[8], Red}, 
     Method -> {"BoundaryOffset" -> False}, 
     PlotStyle -> {Opacity[.9], White}, PlotPoints -> 80, 
     PerformanceGoal -> "Quality", PlotRange -> All] /. Line -> Arrow,
    Background -> LightGray, 
   PlotRange -> 2], {c, $MachineEpsilon + δ, 100}, 
  AnimationRate -> 1, ControlPlacement -> Bottom]

enter image description here

cvgmt
  • 72,231
  • 4
  • 75
  • 133
  • 1
    I'm using Mathematica 12.0 and here, instead of getting the stadium region, it's showing three errors. 1- ImplicitRegion cannot be automatically discretized. 2- ImplicitRegion is not a valid region to plot. 3- RegionPlot called with 1 argument; 3 arguments are expected. – user444 Nov 24 '22 at 07:02
  • I'm getting an error still. It says, "Heads List and InterpolatingFunction[...] at positions 1 and 2 are expected to be the same. " – user444 Nov 24 '22 at 12:19
  • 2
    @user84456 Updated. Work on v10.4 ,v11.3 and 13.1 now. – cvgmt Nov 24 '22 at 12:28