In[]:=
data=ParallelTable[Length/@FindTransientRepeat[CanonicalGraph[Rule@@@#]&/@WolframModel[{{1,2},{2,3}}{{2,1},{3,1}},Table[{i,i+1},{i,n}],200,"StatesList"],2],{n,15}]
Out[]=
{{1,0},{2,0},{2,0},{4,0},{4,3},{2,4},{4,7},{6,0},{5,7},{2,6},{48,10},{7,8},{28,9},{5,14},{48,3}}
In[]:=
data=ParallelTable[Length/@FindTransientRepeat[CanonicalGraph[UndirectedGraph[Rule@@@#]]&/@WolframModel[{{1,2},{2,3}}{{2,1},{3,1}},Table[{i,i+1},{i,n}],200,"StatesList"],2],{n,15}]
Out[]=
{{1,0},{0,1},{0,1},{2,1},{4,3},{2,4},{4,7},{6,0},{5,7},{2,6},{48,10},{7,8},{28,9},{5,14},{48,3}}
In[]:=
data=ParallelTable[Length/@FindTransientRepeat[CanonicalGraph[UndirectedGraph[Rule@@@#]]&/@WolframModel[{{1,2},{2,3}}{{2,1},{3,1}},Table[{i,i+1},{i,n}],500,"StatesList"],2],{n,20}]
Out[]=
{{1,0},{0,1},{0,1},{2,1},{4,3},{2,4},{4,7},{6,0},{5,7},{2,6},{48,10},{7,8},{28,9},{5,14},{48,3},{10,0},{97,6},{7,28},{161,164},{22,0}}
In[]:=
data=ParallelTable[Length/@FindTransientRepeat[CanonicalGraph[UndirectedGraph[Rule@@@#]]&/@WolframModel[{{1,2},{2,3}}{{2,1},{3,1}},Table[{i,i+1},{i,n}],500,"StatesList"],2],{n,30}]
Out[]=
In[]:=
data=ParallelTable[Length/@FindTransientRepeat[CanonicalGraph[UndirectedGraph[Rule@@@#]]&/@WolframModel[{{1,2},{2,3}}{{2,1},{3,1}},Table[{i,i+1},{i,n}],1000,"StatesList"],3],{n,30}]
Out[]=
In[]:=
%271===%271
Out[]=
True
In[]:=
data=ParallelTable[Length/@FindTransientRepeat[CanonicalGraph[UndirectedGraph[Rule@@@#]]&/@WolframModel[{{1,2},{2,3}}{{2,1},{3,1}},Table[{i,i+1},{i,n}],1000,"StatesList"],3],{n,50}]
Out[]=
In[]:=
Position[%,1001]
Out[]=
{{33,1},{35,1},{37,1},{38,1},{39,1},{41,1},{42,1},{43,1},{45,1},{46,1},{47,1},{49,1}}
In[]:=
First/@%
Out[]=
{33,35,37,38,39,41,42,43,45,46,47,49}
In[]:=
ParallelMapMonitored[Echo[Length/@FindTransientRepeat[CanonicalGraph[UndirectedGraph[Rule@@@#]]&/@WolframModel[{{1,2},{2,3}}{{2,1},{3,1}},Table[{i,i+1},{i,#}],1000,"StatesList"],3],#]&,{33,35,37,38,39,41,42,43,45,46,47,49}]
(kernel 78)
>> 38{144,18}
(kernel 80)
>> 35{666,2}
(kernel 81)
>> 33{468,6}
(kernel 77)
>> 39{297,6}
(kernel 79)
>> 37{814,6}
(kernel 74)
>> 43{488,6}
(kernel 76)
>> 41{464,6}
(kernel 75)
>> 42{409,6}
(kernel 73)
>> 45{689,6}
(kernel 72)
>> 46{303,54}
(kernel 71)
>> 47{492,6}
(kernel 70)
>> 49{600,6}
Out[]=
{{468,6},{666,2},{814,6},{144,18},{297,6},{464,6},{409,6},{488,6},{689,6},{303,54},{492,6},{600,6}}
In[]:=
Length/@FindTransientRepeat[CanonicalGraph[UndirectedGraph[Rule@@@#]]&/@WolframModel[{{1,2},{2,3}}{{2,1},{3,1}},Table[{i,i+1},{i,33}],1000,"StatesList"],3]
Out[]=
{1001,0}
In[]:=
StackedListPlot[Transpose[{If[#20,1,#2],#1}&@@@data],FrameTrue,AspectRatio1/4,ScalingFunctions"Log"]
Out[]=