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[]:=
LaunchKernels[]
Number Theoretic Formulation
Number Theoretic Formulation
In[]:=
PostNumericStep[{int_,len_}]:=If[int<2^(len-1),{Mod[8int/2^len,1]2^(len-1),len-1},{Mod[8int/2^len,1]2^(len+1)+13,len+1}]
In[]:=
NestList[PostNumericStep[{#[[1]],#[[2]]}]&,{14844917568,39},40]
Out[]=
{{14844917568,39},{59379670272,38},{100079727616,37},{226886107149,38},{331642831069,39},{908238786013,40},{1337681042909,41},{3810710642141,42},{8194812141021,43},{7971691945437,44},{5498488715124,43},{14889219917,44},{59556879668,43},{238227518672,42},{952910074688,41},{513105415424,40},{403154220032,39},{952909381645,40},{2052410573021,41},{2052243590621,42},{1611904595828,41},{3800240977741,42},{8027297510621,43},{5291457859037,44},{3573645391732,43},{1100442033616,42},{3721623360,41},{14886493440,40},{59545973760,39},{238183895040,38},{512407437325,39},{501937602781,40},{358482969460,39},{238169372493,40},{402921676084,39},{949188678477,40},{1992879322333,41},{1099743579613,42},{927807348,41},{3711229392,40},{14844917568,39}}
In[]:=
cyc=TSPatternEvolveList[{0,0,0,0,0,1,1,0,1,1,1,0,1,0,0,1,1,0,1,0,0,1,1,0,1,1,1,0,1,1,1,0,1,0,0,0,0,0,0},40]
Out[]=
In[]:=
ArrayPlot[%56]
Out[]=
In[]:=
frac={FromDigits[#,2],Length[#]}&/@cyc
Out[]=
{{14844917568,39},{59379670272,38},{100079727616,37},{226886107149,38},{331642831069,39},{908238786013,40},{1337681042909,41},{3810710642141,42},{8194812141021,43},{7971691945437,44},{5498488715124,43},{14889219917,44},{59556879668,43},{238227518672,42},{952910074688,41},{513105415424,40},{403154220032,39},{952909381645,40},{2052410573021,41},{2052243590621,42},{1611904595828,41},{3800240977741,42},{8027297510621,43},{5291457859037,44},{3573645391732,43},{1100442033616,42},{3721623360,41},{14886493440,40},{59545973760,39},{238183895040,38},{512407437325,39},{501937602781,40},{358482969460,39},{238169372493,40},{402921676084,39},{949188678477,40},{1992879322333,41},{1099743579613,42},{927807348,41},{3711229392,40},{14844917568,39}}
In[]:=
{FromDigits[#,2],Length[#]}&/@TSPatternEvolveList[{1,0,0,1,0,0,1,0,0,0,0,0},100]
Out[]=
{{2336,12},{4621,13},{8413,14},{3549,15},{14196,14},{30541,15},{29917,16},{21364,15},{14157,16},{23860,15},{54093,16},{79069,17},{216541,18},{318941,19},{908765,20},{1957341,21},{1957341,22},{1537908,21},{3635021,22},{7828701,23},{7818717,24},{6109044,23},{13858637,24},{20411613,25},{58150365,26},{125099485,27},{122543581,28},{87521140,27},{58160973,28},{98426164,27},{232641357,28},{501036253,29},{500387293,30},{390936436,29},{886273869,30},{1295480029,31},{3547811293,32},{5225373149,33},{14886493661,34},{32025468381,35},{31371156957,36},{22405412724,35},{14889219917,36},{25197141300,35},{59556877133,36},{128276313309,37},{128275664349,38},{100785796980,37},{238183216973,38},{512396588253,39},{501764017629,40},{357788628852,39},{227059922765,40},{358483877172,39},{238183895885,40},{402979769652,39},{950118175565,40},{2007751275741,41},{1337694834141,42},{952732825460,41},{512396418512,40},{400318232384,39},{907533579277,40},{1326397735133,41},{3630177717725,42},{5306285350365,43},{14531821428189,44},{21402910318045,45},{60971588378077,46},{131120483917277,47},{127602905701853,48},{88199157741428,47},{3811640309581,48},{15246561238324,47},{60986244953296,46},{131354989120781,47},{131354988957917,48},{103207490765684,47},{243944968697677,48},{525419778634973,49},{525417110261213,50},{412818580780916,49},{975597758281549,50},{2098765250393309,51},{2055046614699485,52},{1464787017742196,51},{918594147022669,52},{1422576774405428,51},{243230253634381,52},{972921014537524,51},{513984337622224,50},{367087490224960,49},{243900309386253,50},{412651284123700,49},{972921011766093,50},{2055937306146013,51},{1369799506742749,52},{975598399600500,51},{524693877874128,50},{409925651232576,49},{929310885508109,50}}
In[]:=
NestList[PostNumericStep[{#[[1]],#[[2]]}]&,{2336,12},100]
Out[]=
{{2336,12},{4621,13},{8413,14},{3549,15},{14196,14},{30541,15},{29917,16},{21364,15},{14157,16},{23860,15},{54093,16},{79069,17},{216541,18},{318941,19},{908765,20},{1957341,21},{1957341,22},{1537908,21},{3635021,22},{7828701,23},{7818717,24},{6109044,23},{13858637,24},{20411613,25},{58150365,26},{125099485,27},{122543581,28},{87521140,27},{58160973,28},{98426164,27},{232641357,28},{501036253,29},{500387293,30},{390936436,29},{886273869,30},{1295480029,31},{3547811293,32},{5225373149,33},{14886493661,34},{32025468381,35},{31371156957,36},{22405412724,35},{14889219917,36},{25197141300,35},{59556877133,36},{128276313309,37},{128275664349,38},{100785796980,37},{238183216973,38},{512396588253,39},{501764017629,40},{357788628852,39},{227059922765,40},{358483877172,39},{238183895885,40},{402979769652,39},{950118175565,40},{2007751275741,41},{1337694834141,42},{952732825460,41},{512396418512,40},{400318232384,39},{907533579277,40},{1326397735133,41},{3630177717725,42},{5306285350365,43},{14531821428189,44},{21402910318045,45},{60971588378077,46},{131120483917277,47},{127602905701853,48},{88199157741428,47},{3811640309581,48},{15246561238324,47},{60986244953296,46},{131354989120781,47},{131354988957917,48},{103207490765684,47},{243944968697677,48},{525419778634973,49},{525417110261213,50},{412818580780916,49},{975597758281549,50},{2098765250393309,51},{2055046614699485,52},{1464787017742196,51},{918594147022669,52},{1422576774405428,51},{243230253634381,52},{972921014537524,51},{513984337622224,50},{367087490224960,49},{243900309386253,50},{412651284123700,49},{972921011766093,50},{2055937306146013,51},{1369799506742749,52},{975598399600500,51},{524693877874128,50},{409925651232576,49},{929310885508109,50}}
In[]:=
PostNumericStep[{int_,len_}]:=If[int<2^(len-1),{Mod[8int/2^len,1]2^(len-1),len-1},{Mod[8int/2^len,1]2^(len+1)+13,len+1}]
In[]:=
Clear[PostNumericStep]
In[]:=
PostNumericStep[{n_,l_}]:=Withm=FractionalPart,Ifn<,{m,l-1},{4m+13,l+1}
l-1
2
8n
l
2
l-1
2
In[]:=
NestList[PostNumericStep,{2336,12},20]
Out[]=
{{2336,12},{4621,13},{8413,14},{3549,15},{14196,14},{30541,15},{29917,16},{21364,15},{14157,16},{23860,15},{54093,16},{79069,17},{216541,18},{318941,19},{908765,20},{1957341,21},{1957341,22},{1537908,21},{3635021,22},{7828701,23},{7818717,24}}
In[]:=
IntegerDigits[13,2]
Out[]=
{1,1,0,1}
In[]:=
FromModForm[{{1,0,1,1,1,1,0,1,0,1,0,1,1,1,1,1,1,1,1,1,1,0,1,0},{}},0]
Out[]=
{1,0,0,0,0,0,1,0,0,1,0,0,1,0,0,1,0,0,0,0,0,1,0,0,0,0,0,1,0,0,0,0,0,1,0,0,1,0,0,1,0,0,1,0,0,1,0,0,1,0,0,1,0,0,1,0,0,1,0,0,1,0,0,0,0,0,1,0,0,0,0,0}
In[]:=
FromDigits[%,2]
Out[]=
2403338077753249515552
To do
To do
Given a run, find its terminal cycle / cycle length
Given a run, find its terminal cycle / cycle length
Given a run, find its halting time
Given a run, find its halting time
Inventory all the freeways
Inventory all the freeways
FindHaltingInformation[{p_,state_},max_]/;Length[state]<3:=XXXX
Simple Setup
Simple Setup
In[]:=
With[{len=3},Table[(n->Length/@FindTransientRepeat[#,3])&[NestList[Replace[#,{{0,_,_,s___}{s,0,0},{1,_,_,s___}{s,1,1,0,1}}]&,IntegerDigits[n,2,len],100]],{n,0,2^len-1}]]
Out[]=
{0{1,1},1{1,1},2{1,1},3{1,1},4{4,2},5{4,2},6{4,2},7{4,2}}
In[]:=
Column[Row/@NestList[Replace[#,{{0,_,_,s___}{s,0,0},{1,_,_,s___}{s,1,1,0,1}}]&,IntegerDigits[5,2,3],8]]
Out[]=
101 |
1101 |
11101 |
011101 |
10100 |
001101 |
10100 |
001101 |
10100 |
In[]:=
With[{len=4},Table[(n->Length/@FindTransientRepeat[#,3])&[NestList[Replace[#,{{0,_,_,s___}{s,0,0},{1,_,_,s___}{s,1,1,0,1}}]&,IntegerDigits[n,2,len],100]],{n,0,2^len-1}]]
Minsky’s Version...
Minsky’s Version...
Minsky’s example
Cycle Finding etc.
Cycle Finding etc.
Generate all cycles that can be reached with compressed words of length n
Find the cycles as uncompressed data:
Standard cycles
Standard cycles
In compressed form: {0, these}
Or we
Non-Standard Cycles
Non-Standard Cycles
00111(000111)^n
All cycle length 6.......
Non-non-standard cycles
Non-non-standard cycles
Cycle investigation
Cycle investigation
Generating Compressed Evolution
Generating Compressed Evolution
Backwards Evolution
Backwards Evolution
Large Runs
Large Runs
initial length (uncompressed) | initial string (compressed) | steps | final string | cycle length
Potential champions
Potential champions
Many 1s cases