We want to simulate a ball being dropped in a circular below from a position and elastically colliding with the wall. We can then color the starting position with the color of the wall after n (n=7 in the example below) collisions.
Define the bouncing:
In[]:=
Clear[Reflection]Reflection[k_,localslope_,xp_,yp_]:=Module{gramp,gp,xpnew,ypnew},gramp=-localslope;If[Not[NumberQ[gramp]],Print["Could not compute derivative "];Throw[$Failed]];gramp={-localslope,1};If[gramp.{xp,yp}0,Print["No reflection!, particle moves along line?"];Throw[$Failed]];gp={1,-1}Reverse[gramp];{xpnew,ypnew}=(gpgp.{xp,yp}-grampgramp.{xp,yp});{xpnew,ypnew}
k
gramp.gramp
Define the shape of the below and its derivative:
In[]:=
ClearAll[func,slope]func[x_]:=-
1-
slope[x_]=D[func[x],x]2
x
Out[]=
x
1-
2
x
Do a trial simulation:
tmax=100;sol=NDSolve[{x[0]==0.3,x'[0]==0,x''[t]==0,y[0]0.5,y'[0]0,y''[t]-9.81,c[0]==0,WhenEvent[x[t]^2+y[t]^2>1(*definethebowlhereasanequality*),{{x'[t],y'[t]}->Reflection[1,slope[x[t]],x'[t],y'[t]],{c[t]}->{c[t]+1},If[c[t]==5,"StopIntegration"]}]},{x[t],y[t],c[t]},{t,0,tmax},DiscreteVariablesElement[c,Integers]][[1]];tmax=Head[x[t]/.sol][[1,1,-1]];ParametricPlot[{x[t],y[t]}/.sol,{t,0,tmax},PlotRange->1.2,Epilog->Circle[{0,0},1]]/.Line->Arrow
Out[]=
Define a function that get’s the final position after n collisions:
ClearAll[func,slope,FindTrack,FindFinalPosition]func[x_]:=-
1-
slope[x_]=D[func[x],x];FindTrack[{x0_,y0_},n_]:=Module[{sol,x,y,c,tfinal,final},sol=NDSolveValue[{x[0]==x0,x'[0]==0,x''[t]==0,y[0]y0,y'[0]0,y''[t]-1,c[0]==0,WhenEvent[x[t]^2+y[t]^2>1(*definethebowlhereasanequality*),{{x'[t],y'[t]}->Reflection[1,slope[x[t]],x'[t],y'[t]],{c[t]}->{c[t]+1},If[c[t]==n,"StopIntegration"]}]},{x,y,c},{t,0,∞},DiscreteVariablesElement[c,Integers]];sol]FindFinalPosition[{x0_?NumericQ,y0_?NumericQ},n_]:=Module[{sol,x,y,c,tfinal,final},sol=FindTrack[{x0,y0},n];tfinal=sol[[1,1,1,-1]];final={sol[[1]][tfinal],sol[[2]][tfinal]};(*Abs[Abs[ArcTan@@final]-Pi/2]/(Pi/2)*)Abs[ArcTan@@final](*sol*)]FindFinalPosition[{0.3,0.5},4](*tryitout,anglebetween0—π*)2
x
Out[]=
2.66128
Start from a bunch of starting positions and find the position after 4 collisions
In[]:=
$HistoryLength=1;coll=5(*numberofcollisions*)nn=<|1->200,2->200,3->200,4->300,5->500,6->700,7->2000|>[[coll]];δ=1/nn;pts=Catenate@Table[AngleVector[{r,#}]&/@Subdivide[-Pi/2.0,0,Max[Ceiling[(rPi/2)/δ],4]],{r,Subdivide[0.0,0.999,nn]}];res=ParallelTable[{p,FindFinalPosition[p,coll]},{p,pts}];res=Join[res,Table[{r[[1]]{-1,1},Pi-r[[2]]},{r,res}]];(*leftandridesideofthebowlaretheoppositesoonecalculatehalfandusesymmetry*)res//=DeleteDuplicatesBy[First];
Out[]=
5
Visualize the position after 5 collisions:
We can do this for 1, 2, 3, 4, 5, and 6 collisions, increasing the complexity of the results as the number of collisions increases:
CITE THIS NOTEBOOK
CITE THIS NOTEBOOK
Elastic bouncing in circular bowl
by Sander Huisman
Wolfram Community, STAFF PICKS, November 23, 2023
https://community.wolfram.com/groups/-/m/t/3070150
by Sander Huisman
Wolfram Community, STAFF PICKS, November 23, 2023
https://community.wolfram.com/groups/-/m/t/3070150