Wolfram Cloud Document

In[]:=

TMRuleCases[1,2]

Out[]=

{{1,1}{1,1,-1},{1,1}{1,0,-1},{1,0}{1,1,-1},{1,0}{1,0,-1},{1,1}{1,1,1},{1,1}{1,0,1},{1,0}{1,1,1},{1,0}{1,0,1}}

{pos,tape}

For each state, what color, and left or right....

{{1,-1},{0,1}}

In[]:=

MARules[k_]:=Tuples[Join[Table[{i,1},{i,0,k-1}],Table[{i,-1},{i,0,k-1}]],k]

In[]:=

MARules[2]

Out[]=

{{{0,1},{0,1}},{{0,1},{1,1}},{{0,1},{0,-1}},{{0,1},{1,-1}},{{1,1},{0,1}},{{1,1},{1,1}},{{1,1},{0,-1}},{{1,1},{1,-1}},{{0,-1},{0,1}},{{0,-1},{1,1}},{{0,-1},{0,-1}},{{0,-1},{1,-1}},{{1,-1},{0,1}},{{1,-1},{1,1}},{{1,-1},{0,-1}},{{1,-1},{1,-1}}}

In[]:=

Length[%]

Out[]=

In[]:=

MAStep[rule_,{pos_,tape_}]:=With[{u=rule[[1+tape[[pos]]]]},{pos+u[[2]],ReplacePart[tape,posu[[1]]]}]

In[]:=

MAEvolveList[rule_,{pos_,tape_},t_]:=NestList[MAStep[rule,#]&,{pos,tape},t]

In[]:=

With[{t=4},MAEvolveList[{{1,1},{0,-1}},{t+1,Table[0,2t+1]},t]]

Out[]=

{{5,{0,0,0,0,0,0,0,0,0}},{6,{0,0,0,0,1,0,0,0,0}},{7,{0,0,0,0,1,1,0,0,0}},{8,{0,0,0,0,1,1,1,0,0}},{9,{0,0,0,0,1,1,1,1,0}}}

In[]:=

ResourceFunction["InteractiveListSelector"][ResourceFunction["ParallelMapMonitored"][ArrayPlot[Last/@With[{t=10},MAEvolveList[#,{t+1,Table[0,2t+1]},t]]]#&,MARules[2]]]

Out[]=



Add



Clear

Copy

In[]:=

ResourceFunction["InteractiveListSelector"][ResourceFunction["ParallelMapMonitored"][ArrayPlot[Last/@With[{t=10},MAEvolveList[#,{t+1,ReplacePart[Table[0,2t+1],t1]},t]]]#&,MARules[2]]]

Out[]=



Add



Clear

Copy

In[]:=

ResourceFunction["InteractiveListSelector"][ResourceFunction["ParallelMapMonitored"][ArrayPlot[(Last/@With[{t=10},MAEvolveList[#,{t+1,ReplacePart[Table[0,2t+1],t1]},t]])/2]#&,MARules[3]]]

Out[]=



Add



Clear

Copy