In[]:=
(*D0throughD15representthedisplacementsoftheballsduringthecollision.*)​​D0={0,D0y[t]};​​D1={0,D1y[t]};​​D2={D2x[t],D2y[t]};​​D3={-D2x[t],D2y[t]};​​D4={D4x[t],D4y[t]};​​D5={0,D5y[t]};​​D6={-D4x[t],D4y[t]};​​D7={D7x[t],D7y[t]};​​D8={D8x[t],D8y[t]};​​D9={-D8x[t],D8y[t]};​​D10={-D7x[t],D7y[t]};​​D11={D11x[t],D11y[t]};​​D12={D12x[t],D12y[t]};​​D13={0,D13y[t]};​​D14={-D12x[t],D12y[t]};D15={-D11x[t],D11y[t]};
In[]:=
v={1,0};​​w=12,
3
2;​​x=-12,
3
2;
In[]:=
(*Theforcelaw*)​​force[disp1_,disp2_,dir_]:=-kAbs[(disp1-disp2).dir]^(3/2)dir*UnitStep[(disp1-disp2).dir]​​k=10^11;​​(*Theinitialspeedofthecueball*)​​vel0=10;
In[]:=
(*Actualsimulation*)​​eqs=Rest[Union@@({#〚1,1〛#〚2,1〛,#〚1,2〛#〚2,2〛}&/@{​​Dt[D0,t,t]force[D0,D1,{0,-1}]//Simplify,​​Dt[D1,t,t]force[D1,D0,{0,1}]+force[D1,D2,-w]+force[D1,D3,-x]//Simplify,​​Dt[D2,t,t]force[D2,D1,w]+force[D2,D4,-w]+force[D2,D5,-x]//Simplify,​​Dt[D4,t,t]force[D4,D2,w]+force[D4,D7,-w]+force[D4,D8,-x]//Simplify,​​Dt[D5,t,t]force[D5,D2,x]+force[D5,D3,w]+force[D5,D8,-w]+force[D5,D9,-x]//Simplify,​​Dt[D7,t,t]force[D7,D4,w]+force[D7,D11,-w]+force[D7,D12,-x]//Simplify,​​Dt[D8,t,t]force[D8,D4,x]+force[D8,D5,w]+force[D8,D12,-w]+force[D8,D13,-x]//Simplify,​​Dt[D11,t,t]force[D11,D7,w]//Simplify,​​Dt[D12,t,t]force[D12,D7,x]+force[D12,D8,w]+force[D12,D13,v]//Simplify,​​Dt[D13,t,t]force[D13,D8,x]+force[D13,D9,w]+force[D13,D12,-v]+force[D13,D14,v]//Simplify,​​(D0/.t0){0,0},(D1/.t0){0,0},(D2/.t0){0,0},(D4/.t0){0,0},(D5/.t0){0,0},(D7/.t0){0,0},(D8/.t0){0,0},(D11/.t0){0,0},(D12/.t0){0,0},(D13/.t0){0,0},​​(Dt[D0,t]/.t0){0,-vel0},(Dt[D1,t]/.t0){0,0},(Dt[D2,t]/.t0){0,0},(Dt[D4,t]/.t0){0,0},(Dt[D5,t]/.t0){0,0},(Dt[D7,t]/.t0){0,0},(Dt[D8,t]/.t0){0,0},(Dt[D11,t]/.t0){0,0},(Dt[D12,t]/.t0){0,0},(Dt[D13,t]/.t0){0,0}​​})];​​allsol=First[{D0,D1,D2,D3,D4,D5,D6,D7,D8,D9,D10,D11,D12,D13,D14,D15}/.NDSolve[eqs,{D0y[t],D1y[t],D2x[t],D2y[t],D4x[t],D4y[t],D5y[t],D7x[t],D7y[t],D8x[t],D8y[t],D11x[t],D11y[t],D12x[t],D12y[t],D13y[t]},{t,0,0.0004},Method->"DiscontinuityProcessing"->False]];​​sol0=allsol〚1〛;sol=Rest[allsol];
In[]:=
Plot[{(sol0-sol〚1〛).{0,1},(sol〚1〛-sol〚2〛).w,(sol〚2〛-sol〚4〛).w,(sol〚2〛-sol〚5〛).x,(sol〚4〛-sol〚7〛).w,(sol〚4〛-sol〚8〛).x,(sol〚5〛-sol〚8〛).w,(sol〚7〛-sol〚11〛).w,(sol〚7〛-sol〚12〛).x,(sol〚8〛-sol〚12〛).w,(sol〚8〛-sol〚13〛).w}/.tT,{T,0,0.0003},PlotRange0.0005]
Out[]=
In[]:=
vels=(Dt[#,t]/.t0.00035)&/@allsol;​​positions={8w+{0,2},8w,6w,6w+2v,4w,4w+2v,4w+4v,2w,2w+2v,2w+4v,2w+6v,{0,0},2v,4v,6v,8v};​​colors={GrayLevel[0.9],RGBColor[204/255,210/255,14/255],RGBColor[14/255,54/255,176/255],RGBColor[227/255,42/255,21/255],RGBColor[151/255,22/255,229/255],RGBColor[233/255,126/255,22/255],RGBColor[21/255,117/255,10/255],RGBColor[105/255,50/255,11/255],GrayLevel[30/255],RGBColor[204/255,210/255,14/255],RGBColor[14/255,54/255,176/255],RGBColor[227/255,42/255,21/255],RGBColor[151/255,22/255,229/255],RGBColor[233/255,126/255,22/255],RGBColor[21/255,117/255,10/255],RGBColor[105/255,50/255,11/255]};
In[]:=
trans[pt_,vel_,t_]:=If[t<0,{pt〚1〛,pt〚2〛,0},{pt〚1〛+vel〚1〛*t,pt〚2〛+vel〚2〛*t,0}]​​Manipulate[​​Graphics3D[​​{​​GrayLevel[0.9],Sphere[trans[8w+{0,If[t<0,2-10t,2]},vels〚1〛,t]],​​Table[{colors〚n〛,Sphere[trans[positions〚n〛,vels〚n〛,t]]},{n,2,16}],​​AbsolutePointSize[0],Point[{{-6,-9.2,0}}],Point[{{14,-9.2,0}}],Point[{{4,18,0}}]​​},ViewPoint{0,0,10},BoxedFalse,Lighting"Neutral",BackgroundRGBColor[58/255,181/255,3/255]],​​{t,-0.8,1.6},SaveDefinitions->True]
Out[]=
​
t
In[]:=
myframes=Table[​​Rasterize[Rasterize[Graphics3D[​​{​​GrayLevel[0.9],Sphere[trans[8w+{0,If[t<0,2-10t,2]},vels〚1〛,t]],​​Table[{colors〚n〛,Sphere[trans[positions〚n〛,vels〚n〛,t]]},{n,2,16}],​​AbsolutePointSize[0],Point[{{-6,-9.2,0}}],Point[{{14,-9.2,0}}],Point[{{4,18,0}}]​​},ViewPoint{0,0,10},BoxedFalse,Lighting"Neutral",BackgroundRGBColor[58/255,181/255,3/255]],ImageSize1000],ImageSize250],​​{t,-0.8,1.6,1/30}​​];​​SetDirectory[NotebookDirectory[]];Export["BilliardsHertz.gif",myframes,"DisplayDurations"{1}~Join~Table[1/30,{n,Length[myframes]-2}]~Join~{1}]
Out[]=
BilliardsHertz.gif
In[]:=
ScaleForce[f_]:=Abs[UnitStep[f]*f]^(3/4)*3.5*10^2​​ManipulateGraphics​​​​Table[{Darker@colors〚n〛,Disk[positions〚n〛]},{n,1,16}],​​Yellow,TableDisk
positions〚p〚1〛+1〛+positions〚p〚2〛+1〛
2
,ScaleForce[(allsol〚p〚1〛+1〛-allsol〚p〚2〛+1〛).Normalize[positions〚p〚2〛+1〛-positions〚p〚1〛+1〛]/.tT],{p,{{0,1},{1,2},{1,3},{2,3},{4,5},{5,6},{7,8},{8,9},{9,10},{11,12},{12,13},{13,14},{14,15},{2,4},{2,5},{3,5},{3,6},{4,7},{4,8},{5,8},{5,9},{6,9},{6,10},{7,11},{7,12},{8,12},{8,13},{9,13},{9,14},{10,14},{10,15}}},​​Black,Text[Style[ToString[Floor[T*1000]]<>"."<>ToString[Mod[Floor[T*10000],10]]<>ToString[Mod[Floor[T*100000],10]]<>" ms",FontFamily"Arial",24],{7.1,7.9}]​​,BackgroundRGBColor[58/255,181/255,3/255],ImageSize300,{T,0,0.000201},SaveDefinitions->True