You are using a browser not supported by the Wolfram Cloud
Supported browsers include recent versions of Chrome, Edge, Firefox and Safari.
I understand and wish to continue anyway »
WOLFRAM NOTEBOOK
TuringMachine[]
In[]:=
RulePlot[TuringMachine[{{1,1}{2,0,-1},{1,0}{2,1,1},{2,1}{1,0,1},{2,0}{1,1,-1}}],{1,{{},0}},20]
Out[]=
In[]:=
RulePlot[TuringMachine[{{1,1}{1,1,0},{1,0}{2,1,1},{2,1}{1,0,1},{2,0}{1,1,-1}}],{1,{{},0}},20]
Out[]=
{2,1,1}
In[]:=
TMMutation[rule_,{s_,k_}]:=MapAt[Switch[RandomChoice[Range[3]],1,ReplacePart[#,1->RandomInteger[{1,s}]],2,ReplacePart[#,2->RandomInteger[{0,k-1}]],3,ReplacePart[#,3->RandomChoice[{-1,0,1}]]]&,rule,{RandomInteger[{1,Length[rule]}],2}]
In[]:=
TMLifetime[rule_,init_,tmax_]:=With[{tme=TuringMachine[rule,init,tmax]},If[#==0,Infinity,tmax-#]&[LengthWhile[Rest[Reverse[tme]],#===Last[tme]&]]]
In[]:=
TMLifetime[{{1,1}{2,0,-1},{1,0}{2,1,1},{2,1}{1,0,1},{2,0}{1,1,-1}},{1,{{},0}},20]
»
0
Out[]=
∞
In[]:=
TMLifetime[{{1,1}{1,1,0},{1,0}{2,1,1},{2,1}{1,0,1},{2,0}{1,1,-1}},{1,{{},0}},20]
»
18
Out[]=
2
In[]:=
InitTM[{s_,k_}]:=Catenate[Table[{si,ki}->{si,ki,0},{si,1,s},{ki,0,k-1}]]
In[]:=
InitTM[{2,2}]
Out[]=
{{1,0}{1,0,0},{1,1}{1,1,0},{2,0}{2,0,0},{2,1}{2,1,0}}
In[]:=
TMAdaptiveList[initrule_,{s_,k_},init_,tmax_,smax_]:=NestList[With[{u=TMMutation[First[#],{s,k}]},With[{t=TMLifetime[u,init,tmax]},If[t!=Infinity&&t>=Last[#],{u,t},#]]]&,{initrule,TMLifetime[initrule,init,tmax]},smax]
In[]:=
SeedRandom[234234];TMAdaptiveList[InitTM[{2,2}],{2,2},{1,{{},0}},100,1000];
In[]:=
Last/@%
Out[]=
In[]:=
ListStepPlot[%]
Out[]=
In[]:=
RulePlot[TuringMachine[First[#]],{1,{{},0}},7,Mesh->True]&/@First/@SplitBy[SeedRandom[234234];TMAdaptiveList[InitTM[{2,2}],{2,2},{1,{{},0}},100,1000],Last]
Out[]=
,
,
,
,
,
WRONG:
Tuples[Range[s],sk]
In[]:=
AllTM[{s_,k_}]:=Flatten[Table[{si,ki}->{sip,kip,dir},{si,1,s},{ki,0,k-1},{sip,1,s},{kip,0,k-1},{dir,-1,1}],3]
In[]:=
22223
Out[]=
48
TMLifetime[u,init,tmax]
{{1,1}{1,1,0},{1,0}{2,1,1},{2,1}{1,0,1},{2,0}{1,1,-1}}
In[]:=
LaunchKernels[]
Out[]=
KernelObject,KernelObject,KernelObject,KernelObject,KernelObject,KernelObject,KernelObject,KernelObject,KernelObject,KernelObject
In[]:=
ParallelTable[SeedRandom[234234+i];TMAdaptiveList[InitTM[{2,2}],{2,2},{1,{{},0}},100,1000],{i,10}];
All TMs
All TMs
Multiway
Multiway
Definition 1: A multiway busy beaver has at least branch that keeps going as long as possible
Definition 2: A multiway busy beaver has the largest number of nodes in its multiway graph
Definition 3: Maximum parallelism
Mutation could affect LHS as well as RHS of rules
Mutation could affect LHS as well as RHS of rules