Simple BCAs
Simple BCAs
In[]:=
ResourceFunction["InteractiveListSelector"][Table[ArrayPlot[ResourceFunction["BlockCellularAutomaton"][{{2,2}{1,1},{1,1}{2,2},{1,2}{1,2},{2,1}{2,1},{2,0}{0,2},{1,0}{1,0},{0,2}{2,0},{0,1}{0,1},{0,0}{0,0}},CenterArray[IntegerDigits[i,3],40],300],PlotRange->{0,2}]->i,{i,50}]]
Out[]=
In[]:=
{4,40,43,5}//Sort
Out[]=
{4,5,40,43}
In[]:=
ResourceFunction["InteractiveListSelector"][Table[ArrayPlot[ResourceFunction["BlockCellularAutomaton"][{{2,2}{1,1},{1,1}{2,2},{1,2}{1,2},{2,1}{2,1},{2,0}{0,2},{1,0}{1,0},{0,2}{2,0},{0,1}{0,1},{0,0}{0,0}},CenterArray[IntegerDigits[i,3],40],300],PlotRange->{0,2}]->i,{i,51,150}]]
In[]:=
ResourceFunction["InteractiveListSelector"][Table[ArrayPlot[ResourceFunction["BlockCellularAutomaton"][{{2,2}{1,1},{1,1}{2,2},{1,2}{1,2},{2,1}{2,1},{2,0}{0,2},{1,0}{1,0},{0,2}{2,0},{0,1}{0,1},{0,0}{0,0}},CenterArray[IntegerDigits[i,3],42],300],PlotRange->{0,2}]->i,{i,150}]]
In[]:=
ArrayPlot[{IntegerDigits[121,3]},Mesh->True,ImageSize->{Automatic,10}]
Out[]=
In[]:=
qsrule[k_,perm_]:=With[{u=DeleteCases[Union[Sort/@Tuples[Range[0,k-1],2]],{0,0}]},Union[Prepend[Join[#,Map[Reverse,#,{2}]]&@Thread[u->u[[perm]]],{0,0}->{0,0}]]]
In[]:=
With[{k=3},Length[DeleteCases[Union[Sort/@Tuples[Range[0,k-1],2]],{0,0}]]]
Out[]=
5
In[]:=
qsrule[3,{4,3,2,1,5}]
»
{{0,1}{1,2},{0,2}{1,1},{1,1}{0,2},{1,2}{0,1},{2,2}{2,2}}
Out[]=
{{0,0}{0,0},{0,1}{1,2},{0,2}{1,1},{1,0}{2,1},{1,1}{0,2},{1,1}{2,0},{1,2}{0,1},{2,0}{1,1},{2,1}{1,0},{2,2}{2,2}}
In[]:=
Reverse/@{{0,1}{1,2},{0,2}{1,1},{1,1}{0,2},{1,2}{0,1},{2,2}{2,2}}
Out[]=
{{1,2}{0,1},{1,1}{0,2},{0,2}{1,1},{0,1}{1,2},{2,2}{2,2}}
In[]:=
Length[%]
Out[]=
6
In[]:=
With[{k=2},DeleteCases[Union[Sort/@Tuples[Range[0,k-1],2]],{0,0}]]
Out[]=
{{0,1},{1,1}}
In[]:=
ResourceFunction["InteractiveListSelector"][ArrayPlot[ResourceFunction["BlockCellularAutomaton"][#,CenterArray[{1,1},80],100],PlotRange->{0,2}]->#&/@(qsrule[2,#]&/@Permutations[Range[2]])]
Out[]=
In[]:=
ResourceFunction["InteractiveListSelector"][ArrayPlot[ResourceFunction["BlockCellularAutomaton"][#,CenterArray[{1},80],100],PlotRange->{0,2}]->#&/@(qsrule[3,#]&/@Permutations[Range[5]])]
Out[]=
Reversible BCA
Reversible BCA
BCA
BCA
though the result is