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[]:=
AllInits[count_] := Tuples[{Range[0, 2], IntegerDigits[#, 2, count] & /@ Range[0, 2^count - 1]}]
In[]:=
AllInits[min_ ;; max_] := Catenate[AllInits /@ Range[min, max]]
In[]:=
Get["~/git/PostTagSystem/Kernel/init.m"];Get["GeneralUtilities`"];
In[]:=
system1 = PostTagSystem[{0, {1, 1, 1}}]
Out[]=
PostTagSystemEvolution
In[]:=
system1["Properties"]
Out[]=
{EvolutionObject,Properties,StateCount,StateGraph,State,CycleSources}
In[]:=
system1["StateGraph", VertexLabels Automatic]
Out[]=
In[]:=
system1["CycleSources"]
Out[]=
{6}
In[]:=
system2 = PostTagSystem[AllInits[0 ;; 2]]
Out[]=
PostTagSystemEvolution
In[]:=
system2["StateGraph", VertexLabels Automatic]
Out[]=
In[]:=
system2["CycleSources"]
Out[]=
{9,28}
In[]:=
system9 = PostTagSystem[List @@@ AllInits[0 ;; 9]];
In[]:=
system9["CycleSources"]
Out[]=
{9,28,73,104,110,676,754,2998,3033,3370,3502,3589,3896,5293,5710,7829,7856}
In[]:=
graph9 = system9["StateGraph"]
Out[]=
Graph
Cycle length up to 3*9-long inits!
In[]:=
Length /@ (VertexOutComponent[graph9, #] &) /@ system9["CycleSources"]
Out[]=
{2,6,2,6,4,10,2,28,8,6,6,16,2,4,10,6,40}
In[]:=
Replace[ system9["State", #] & /@ VertexOutComponent[graph9, Last[system9["CycleSources"]]], {phase_, state_} Replace[phase, {0 "0", 1 "1", 2 "2"}] <> StringJoin[Replace[state, {0 "", 1 "■"}, 1]], {1}]
Out[]=
{1■■■■■■,0■■■■■■,2■■■■■■■,0■■■■■■■,2■■■■■■■■,0■■■■■■■■,2■■■■■■■■■,1■■■■■■■■,0■■■■■■■■,1■■■■■■■■,2■■■■■■■■,0■■■■■■■■,1■■■■■■■■,2■■■■■■■■,1■■■■■■■,0■■■■■■■,2■■■■■■■■,1■■■■■■■,0■■■■■■■,2■■■■■■■■,1■■■■■■■,2■■■■■■■,1■■■■■■,2■■■■■■,0■■■■■■,1■■■■■■,2■■■■■■,0■■■■■■,2■■■■■■■,1■■■■■■,0■■■■■■,1■■■■■■,0■■■■■■,2■■■■■■■,1■■■■■■,2■■■■■■,0■■■■■■,1■■■■■■,2■■■■■■,0■■■■■■}
In[]:=
PostTagSystemCycleLengths[maxInitSize_] := With[ {system = PostTagSystem[AllInits[0 ;; maxInitSize]]}, Union[Length /@ (VertexOutComponent[system["StateGraph"], #] &) /@ system["CycleSources"]]]
In[]:=
PostTagSystemCycleLengths[9]
Out[]=
{2,4,6,8,10,16,28,40}
In[]:=
PostTagSystemCycleLengths[10]
Out[]=
{2,4,6,8,10,12,16,28,40}
In[]:=
PostTagSystemCycleLengths[11]
Out[]=
{2,4,6,8,10,12,14,16,28,40}
In[]:=
PostTagSystemCycleLengths[12]
Out[]=
{2,4,6,8,10,12,14,16,28,40}
In[]:=
PostTagSystemCycleLengths[13]
Out[]=
{2,4,6,8,10,12,14,16,28,40}
In[]:=
PostTagSystemCycleLengths[14]
Out[]=
{2,4,6,8,10,12,14,16,20,22,28,40}
Curiously, one of the evolutions for init size 15 seems to run away! That is, it does not seem to terminate in a while, and is using > 30 GB of RAM. Did we just find a non-terminating init?
In[]:=
PostTagSystem[AllInits[15]]
Out[]=
$Aborted
In[]:=
PostTagSystem[AllInits[14]]
{{0},{1503,0},{1503,1},{1503,2},{1503},{1519,0},{1519,1},{1519,2},{1519},{3830,0},{3830,1},{3830,2},{3830},{}}
Out[]=
PostTagSystemEvolution
In[]:=
%6["InitStates"][[1503]]
Out[]=
25260
In[]:=
Length[VertexOutComponent[%6["StateGraph"], 25260]]
Out[]=
192
In[]:=
%6["State", 25260]
Out[]=
{0,{0,0,0,1,0,1,1,1,0,1,1,1,1,1}}
In[]:=
GraphSinks[%6["StateGraph"]]
Out[]=
{43}
In[]:=
%6["State", 43]
Out[]=
{0,{}}
In[]:=
PostTagSystem[{0,{0,0,0,1,0,1,1,1,0,1,1,1,1,1}}]
Out[]=
PostTagSystemEvolution
In[]:=
AllInits[count_] := Tuples[{Range[0, 2], IntegerDigits[#, 2, count] & /@ Range[0, 2^count - 1]}]
In[]:=
AllInits[min_ ;; max_] := Catenate[AllInits /@ Range[min, max]]
In[]:=
Get["~/git/PostTagSystem/Kernel/init.m"];Get["GeneralUtilities`"];
In[]:=
in = 16346 + 1