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
In[]:=
tms=Table[ArrayPlot[Last/@TuringMachine[r,{{1,10},Table[0,21]},10]],{r,0,4095}];
In[]:=
Show[#,ImageSize40]&/@tms;
In[]:=
%
Out[]=
Revised Code
Revised Code
In[]:=
getTuringMachineStateEvolutionFunction[state_String,rules_List]:=ToString/@(Last[TuringMachine[#,ToExpression[state],1]]&/@rules)
In[]:=
getTuringMachineStateEventFunction[state_String,rules_List]:=Module[{evolution=ToString/@(Last[TuringMachine[#,ToExpression[state],1]]&/@rules)},Module[{length=StringLength[Last[Last[System`Dump`showStringDiff[state,#]]]]},{StringDrop[state,-length]StringDrop[#,-length],StringDrop[state,-length],{"",StringTake[state,-length]}}]&/@evolution]
In[]:=
getTuringMachineStateEventFunction[states_List,rules_List]:=Catenate[getTuringMachineStateEventFunction[#,rules]&/@states]
In[]:=
getTuringMachineEventApplicationFunction[{(input_String|input_Symbol)output_String,(input_String|input_Symbol),{prefix_String,suffix_String}}]:=StringJoin[prefix,output,suffix]
In[]:=
getTuringMachineElementShifts[shiftedFragment_String,{input:{inputPrefix_String,inputSuffix_String},output:{outputPrefix_String,outputSuffix_String}}]:=Table[Rule@@({StringPart[shiftedFragment,position],{StringJoin[#1,StringTake[shiftedFragment,;;position-1]],StringJoin[StringTake[shiftedFragment,position+1;;],#2]}}&@@@{input,output}),{position,StringLength[shiftedFragment]}]
In[]:=
getTuringMachineElementShifts[{(input_String|input_Symbol)output_String,(input_String|input_Symbol),{prefix_String,suffix_String}}]:=Join[getTuringMachineElementShifts[prefix,{{"",StringJoin[input,suffix]},{"",StringJoin[output,suffix]}}],getTuringMachineElementShifts[suffix,{{StringJoin[prefix,input],""},{StringJoin[prefix,output],""}}]]
In[]:=
getTuringMachineElements[{substring_String,{prefix_String,suffix_String}}]:={StringPart[substring,#],{StringJoin[prefix,StringTake[substring,;;#-1]],StringJoin[StringTake[substring,#+1;;],suffix]}}&/@Range[StringLength[substring]]
In[]:=
getTuringMachineEventDecompositionFunction[event:{(input_String|input_Symbol)output_String,(input_String|input_Symbol),{prefix_String,suffix_String}}]:=Join[{getTuringMachineElementShifts[event]},getTuringMachineElements[{#,{prefix,suffix}}]&/@{input,output}]
In[]:=
turingMachineStateRenderingFunction:=(Inset[Framed[Style[RulePlot[TuringMachine[2506(*needsasampleofruletype*)],ToExpression[#2],0,MeshAll,FrameFalse],Hue[0.62,1,0.48]],BackgroundDirective[Opacity[0.2],Hue[0.62,0.45,0.87]],FrameMargins{{2,2},{0,0}},RoundingRadius0,FrameStyleDirective[Opacity[0.5],Hue[0.62,0.52,0.82]]],#1,Center,#3]&)
In[]:=
getTuringMachineEventRenderingForm[function_,{(input_String|input_Symbol)output_String,(input_String|input_Symbol),{prefix_String,suffix_String}}]:=Row[{Column[{function[ArrayPlot[{Last[ToExpression[StringJoin[prefix,input,suffix]]]}]],function[ArrayPlot[{Last[ToExpression[StringJoin[prefix,output,suffix]]]}]]},Center,0]}]
In[]:=
turingMachineEventRenderingFunction:=(If[First[First[#2]]===Null,Inset[Framed[Style[getTuringMachineEventRenderingForm[Identity,#2],Hue[0.09,1,0.32]],BackgroundDirective[Opacity[0.7],RGBColor[0.259,0.576,1]],FrameMargins{{2,2},{0,0}},RoundingRadius0,FrameStyleDirective[Opacity[0.4],Hue[0.09,1,0.91]]],#1,Center,#3],Inset[Framed[Style[getTuringMachineEventRenderingForm[Identity,#2],Hue[0.09,1,0.32]],BackgroundDirective[Opacity[0.7],Hue[0.14,0.34,1]],FrameMargins{{2,2},{0,0}},RoundingRadius0,FrameStyleDirective[Opacity[0.4],Hue[0.09,1,0.91]]],#1,Center,#3]]&)
In[]:=
MultiwayTuringMachine[rules_List,initialCondition_,stepCount_Integer,rest___]:=ResourceFunction["MultiwaySystem"][<|"StateEvolutionFunction"(getTuringMachineStateEvolutionFunction[#,rules]&),"StateEquivalenceFunction"SameQ,"StateEventFunction"(getTuringMachineStateEventFunction[#,rules]&),"EventDecompositionFunction"getTuringMachineEventDecompositionFunction,"EventApplicationFunction"getTuringMachineEventApplicationFunction,"SystemType""TuringMachine","EventSelectionFunction"Identity|>,{ToString[initialCondition]},stepCount,rest,"StateRenderingFunction"turingMachineStateRenderingFunction,"EventRenderingFunction"turingMachineEventRenderingFunction]
Running code
Running code
In[]:=
RulePlot[TuringMachine[2506],{{1,3,0},{0,0,0,0,0}},0,MeshAll,FrameFalse]
Out[]=
In[]:=
MultiwayTuringMachine[{2506,3506},{{1,3,0},{0,0,0,0,0}},2,"EvolutionEventsGraph",VertexSize1]
»
{{{1, 3, 0}, {0, 0, 0{{2, 2, -1}, {0, 0, 1,{{1, 3, 0}, {0, 0, 0,{,, 0, 0}}}}
»
{{{1, 3, 0}, {0, 0, 0{{2, 4, 1}, {0, 0, 1,{{1, 3, 0}, {0, 0, 0,{,, 0, 0}}}}
»
{{{2, 2, -1}, {0, 0{{1, 1, -2}, {0, 1,{{2, 2, -1}, {0, 0,{,, 1, 0, 0}}}}
»
{{{2, 4, 1}, {0, 0, 1, 0{{1, 3, 0}, {0, 0, 1, 1,{{2, 4, 1}, {0, 0, 1, 0,{,, 0}}}}
Out[]=
In[]:=
MultiwayTuringMachine[Range[1000],{{1,3,0},{0,0,0,0,0}},2,"StatesGraph",VertexSize4]
Out[]=
In[]:=
MultiwayTuringMachine[Range[1000],{{1,3,0},{0,0,0,0,0}},2,"StatesGraph",VertexSize{.4,.1}]
Out[]=
The head cannot have yet colored the end squares in the tape...
In 3 steps, the head can only have reached 3 squares to color them....
Distance between the most distant 1s can be at most 3 ; also there is a correlation between head position and tape configuration
Number of possible states after t steps / AKA number of nodes in the graph:
Pruning of cases
Pruning of cases
Only need to consider outcome from the current state+color; all rules with different outcomes for different state+colors are irrelevant.
I.e. just need a representative sample of the 4096 possible rules.....
What is the causal graph like for all these rules?
What is the causal graph like for all these rules?
Note the presence of many branchial event horizons......
Higher States, Colors
Higher States, Colors