In[]:=
BCAGasEvolveList[rules_,init_,t_]:=NestList[BCAGasIterator[rules]@@#&,init,t]
In[]:=
BCAGasIterator[rules_][state_,0]:=BCA[ArrayFlatten[ReplaceAll[Partition[state,{2,2}],rules]],1]
In[]:=
BCAGasIterator[rules_][state_,1]:=BCA[ArrayPad[ArrayFlatten[Map[ReplaceAll[#,rules]&,Partition[ArrayPad[state,-1],{2,2}],{2}]],1,2],0]
In[]:=
BCAGasInit[pos_,pad_,init_:0]:=BCA[ArrayPad[ArrayPad[pos,pad,0],1,2],init]
In[]:=
wallStickRule={{a_,b_},{c_,d_}}/;Or[Count[{a,b,c,d},2]==3,And[Count[{a,b,c,d},2]==2,Count[{a,b,c,d},1]!=1]]:>{{a,b},{c,d}};
In[]:=
wallSlideRule={{a_,b_},{c_,d_}}/;And[Count[{a,b,c,d},2]==2,Count[{a,b,c,d},1]==1]:>ReplaceAll[{{a,b},{c,d}},{1->0,0->1}];
In[]:=
CAGasRule[key_,inds_]:=With[{blocks=KeySort[GroupBy[Partition[#,2]&/@Tuples[{1,0},4],Total[#,2]&]]},MapThread[Rule,{blocks[key],blocks[key][[inds]]}]]
Only one choice obviously conserves momentum:
Only one choice obviously conserves momentum:
“Physical rule”
“Physical rule”
In[]:=
physicalRule=Join[{wallStickRule,wallSlideRule},CAGasRule[0,{1}],CAGasRule[1,{4,3,2,1}],CAGasRule[2,{6,5,4,3,2,1}],CAGasRule[3,{4,2,3,1}],CAGasRule[4,{1}]]
Out[]=
{{{a_,b_},{c_,d_}}/;Count[{a,b,c,d},2]3||(Count[{a,b,c,d},2]2&&Count[{a,b,c,d},1]≠1){{a,b},{c,d}},{{a_,b_},{c_,d_}}/;Count[{a,b,c,d},2]2&&Count[{a,b,c,d},1]1({{a,b},{c,d}}/.{10,01}),{{0,0},{0,0}}{{0,0},{0,0}},{{1,0},{0,0}}{{0,0},{0,1}},{{0,1},{0,0}}{{0,0},{1,0}},{{0,0},{1,0}}{{0,1},{0,0}},{{0,0},{0,1}}{{1,0},{0,0}},{{1,1},{0,0}}{{0,0},{1,1}},{{1,0},{1,0}}{{0,1},{0,1}},{{1,0},{0,1}}{{0,1},{1,0}},{{0,1},{1,0}}{{1,0},{0,1}},{{0,1},{0,1}}{{1,0},{1,0}},{{0,0},{1,1}}{{1,1},{0,0}},{{1,1},{1,0}}{{0,1},{1,1}},{{1,1},{0,1}}{{1,1},{0,1}},{{1,0},{1,1}}{{1,0},{1,1}},{{0,1},{1,1}}{{1,1},{1,0}},{{1,1},{1,1}}{{1,1},{1,1}}}
In[]:=
Map[ArrayPlot[#,Mesh->True,ImageSize->30]&,GatherBy[Drop[physicalRule,2],Total[Flatten[First[#]]]&],{3}]//Column
Out[]=
|
, , , |
, , , , , |
, , , |
|
Every rule is reversible....
In[]:=
Map[ArrayPlot[#,Mesh->True,ImageSize->30]&,GatherBy[Union[Sort/@Drop[physicalRule,2]],Total[Flatten[First[#]]]&],{3}]//Column
Out[]=
|
, |
, , |
, , |
|
In[]:=
physicalRule2=Join[{wallStickRule,wallSlideRule},CAGasRule[0,{1}],CAGasRule[1,{4,3,2,1}],CAGasRule[2,{6,5,4,3,2,1}],CAGasRule[3,{4,3,2,1}],CAGasRule[4,{1}]]
Out[]=
{{{a_,b_},{c_,d_}}/;Count[{a,b,c,d},2]3||(Count[{a,b,c,d},2]2&&Count[{a,b,c,d},1]≠1){{a,b},{c,d}},{{a_,b_},{c_,d_}}/;Count[{a,b,c,d},2]2&&Count[{a,b,c,d},1]1({{a,b},{c,d}}/.{10,01}),{{0,0},{0,0}}{{0,0},{0,0}},{{1,0},{0,0}}{{0,0},{0,1}},{{0,1},{0,0}}{{0,0},{1,0}},{{0,0},{1,0}}{{0,1},{0,0}},{{0,0},{0,1}}{{1,0},{0,0}},{{1,1},{0,0}}{{0,0},{1,1}},{{1,0},{1,0}}{{0,1},{0,1}},{{1,0},{0,1}}{{0,1},{1,0}},{{0,1},{1,0}}{{1,0},{0,1}},{{0,1},{0,1}}{{1,0},{1,0}},{{0,0},{1,1}}{{1,1},{0,0}},{{1,1},{1,0}}{{0,1},{1,1}},{{1,1},{0,1}}{{1,0},{1,1}},{{1,0},{1,1}}{{1,1},{0,1}},{{0,1},{1,1}}{{1,1},{1,0}},{{1,1},{1,1}}{{1,1},{1,1}}}
In[]:=
Map[ArrayPlot[#,Mesh->True,ImageSize->30]&,GatherBy[Union[Sort/@Drop[physicalRule2,2]],Total[Flatten[First[#]]]&],{3}]//Column
Out[]=
|
, |
, , |
, |
|
In[]:=
ArrayPlot[First[#],ColorRules->{0->White,1->Black,2->LightRed},Frame->None,Mesh->True]&/@BCAGasEvolveList[physicalRule2,BCAGasInit[Table[1,6,6],10],30]
Out[]=
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
[With notches]
[With notches]
No notches:
Notches:
Rule 3:
Rule 3:
STGs
STGs