Compiled Version
Compiled Version
“Nearest” Version
“Nearest” Version
In[]:=
simulateGas[initPos_,initVel_,width_,steps_]:=NestList[Function[state,Module[{ps,vs,nf,cols,intersection,unitDisplacement,mag},{ps,vs}=state;(*applyvelocities*)ps+=vs;(*ball-to-ballcollisions*)nf=Nearest[ps{"Index","Distance"}];cols=DeleteDuplicatesBy[Catenate[MapIndexed[{#1[[1]],#2[[1]],#1[[2]]}&,nf[ps,{All,2}][[All,2;;]],{2}]],Sort@*Most];Function[{i,j,dist},intersection=(dist-2)*(ps[[i]]-ps[[j]])/dist/2;ps[[i]]-=intersection;ps[[j]]+=intersection;unitDisplacement=(ps[[i]]-ps[[j]])/2;mag=(vs[[i]]-vs[[j]]).unitDisplacement*unitDisplacement;vs[[i]]-=mag;vs[[j]]+=mag;]@@@cols;(*ball-to-wallcollisions*)Do[If[ps[[i,d]]<1,ps[[i,d]]=1.0;vs[[i,d]]*=-1];If[ps[[i,d]]>width-1,ps[[i,d]]=width-1;vs[[i,d]]*=-1],{d,Length[initPos[[1]]]},{i,Length[initPos]}];{ps,vs}]],{initPos,initVel},steps]
In[]:=
sim=simulateGas[RandomPoint[Rectangle[{1,1},{50,50}],100],(*initialpositions*)RandomPoint[Disk[{0,0},0.5],100],(*initialvelocities*)100.0,(*boxsize*)1000(*steps*)];
In[]:=
Manipulate[Graphics[{{FaceForm[],EdgeForm[Red],Rectangle[{0,0},{100,100}]},Disk/@sim[[t,1]]}],{t,1,Length[sim],1},SaveDefinitionsTrue]
Out[]=
In[]:=
sim2=simulateGas[RandomPoint[Rectangle[{1,1},{20,20}],10],(*initialpositions*)RandomPoint[Disk[{0,0},0.5],10],(*initialvelocities*)20.0,(*boxsize*)1000(*steps*)];
In[]:=
Manipulate[Graphics[{{FaceForm[],EdgeForm[Red],Rectangle[{0,0},{20,20}]},Style[Disk/@sim2[[t,1]],Gray]}],{t,1,Length[sim2],1},SaveDefinitionsTrue]
Out[]=
In[]:=
sim2
Out[]=
In[]:=
Dimensions[%]
Out[]=
{1001,2,10,2}
HardSphereGasSimulation
HardSphereGasSimulation
In[]:=
HardSphereGasSimulation0[initPos_,initVel_,width_,steps_]:=NestList[Function[state,Module[{ps,vs,nf,cols,intersection,unitDisplacement,mag},{ps,vs}=state;(*applyvelocities*)ps+=vs;(*ball-to-ballcollisions*)nf=Nearest[ps{"Index","Distance"}];cols=DeleteDuplicatesBy[Catenate[MapIndexed[{#1[[1]],#2[[1]],#1[[2]]}&,nf[ps,{All,2}][[All,2;;]],{2}]],Sort@*Most];Function[{i,j,dist},intersection=(dist-2)*(ps[[i]]-ps[[j]])/dist/2;ps[[i]]-=intersection;ps[[j]]+=intersection;unitDisplacement=(ps[[i]]-ps[[j]])/2;mag=(vs[[i]]-vs[[j]]).unitDisplacement*unitDisplacement;vs[[i]]-=mag;vs[[j]]+=mag;]@@@cols;(*ball-to-wallcollisions*)Do[If[ps[[i,d]]<1,ps[[i,d]]=1.0;vs[[i,d]]*=-1];If[ps[[i,d]]>width-1,ps[[i,d]]=width-1;vs[[i,d]]*=-1],{d,Length[initPos[[1]]]},{i,Length[initPos]}];{ps,vs}]],{initPos,initVel},steps]
In[]:=
sim2=HardSphereGasSimulation0[RandomPoint[Rectangle[{1,1},{20,20}],10],(*initialpositions*)RandomPoint[Disk[{0,0},0.5],10],(*initialvelocities*)20.0,(*boxsize*)1000(*steps*)];
Overpaints are due to “backups” when spheres interpenetrate...
CA version
CA version