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[]:=
DeleteFile["/Users/sw/Dropbox/Physics/Data/TagSystems/PostTagSystem/champion100-1.txt"]
In[]:=
Catch[Module[{u={0,0,1,1,1,1,1,1,0,0,1,1,0,0,1,1,0,1,1,1,0,0,1,0,0,1,1,1,0,0,0,0,0,1,1,0,1,0,0,1,1,0,0,0,0,0,1,1,0,0,1,0,1,1,0,1,1,1,0,0,0,0,1,1,0,0,0,1,1,1,1,0,0,0,0,0,0,0,0,0,0,1,0,0,0,1,1,1,1,0,0,1,1,0,1,1,1,1,0,1}},Do[u=(If[Length[#]<100,Throw[None],#]&[Last[(PutAppend[{Length/@#,Last[#]},"--","/Users/sw/Dropbox/Physics/Data/TagSystems/PostTagSystem/champion100-1.txt"];#)]&[NestList[TSCF[#,100]&,u,100]]]),10]]]
In[]:=
Monitor[Catch[Module[{u={0,0,1,1,1,1,1,1,0,0,1,1,0,0,1,1,0,1,1,1,0,0,1,0,0,1,1,1,0,0,0,0,0,1,1,0,1,0,0,1,1,0,0,0,0,0,1,1,0,0,1,0,1,1,0,1,1,1,0,0,0,0,1,1,0,0,0,1,1,1,1,0,0,0,0,0,0,0,0,0,0,1,0,0,0,1,1,1,1,0,0,1,1,0,1,1,1,1,0,1}},Do[u=(If[Length[#]<1000,Throw[None],#]&[Last[(PutAppend[{EchoFunction[Max][Length/@#],Last[#]},"--","/Users/sw/Dropbox/Physics/Data/TagSystems/PostTagSystem/champion100-1.txt"];#)]&[NestList[TSCF[#,1000000]&,u,1000]]]),{t,Infinity}]]],t]
»
18326
Out[]=
None
Investigating a length 100 champion
Investigating a length 100 champion
In[]:=
Monitor[Catch[Module[{u={0,1,0,0,1,0,1,1,0,1,0,0,1,1,1,1,0,0,1,0,1,1,1,1,0,1,1,1,1,1,0,0,1,1,1,1,0,1,0,0,1,1,1,1,0,0,0,1,1,1,1,0,0,0,0,1,0,1,0,1,0,0,0,1,0,0,0,1,1,1,1,0,1,1,0,1,1,0,0,0,1,1,1,1,0,0,1,1,0,0,1,1,1,0,0,0,1,1,0,1}},Do[u=(If[Length[#]<1000,Throw[None],#]&[Last[(PutAppend[{EchoFunction[Max][Length/@#],Last[#]},"--","/Users/sw/Dropbox/Physics/Data/TagSystems/PostTagSystem/champion100-1.txt"];#)]&[NestList[TSCF[#,1000000]&,u,1000]]]),{t,Infinity}]]],t]
»
137566
»
132698
»
81940
Out[]=
None
In[]:=
Import["/Users/sw/Dropbox/Physics/Data/TagSystems/PostTagSystem/champion100-1.txt"];
In[]:=
ToExpression/@StringSplit[%535,"\"--\""]
More searches
More searches
In[]:=
TestTS[list_,max_,gate_:1000,inc_:10000]:=Catch[Length/@NestList[If[Length[#]<gate,Throw[None],#]&[TSCF[#,inc]]&,list,max]]
In[]:=
ResourceFunction["InteractiveListSelector"][ListStepPlot[First[#]]Last[#]&/@Select[Function[ru,(If[#=!=None,Echo[{Now,ru,#}],#]&[TestTS[ru,1000,1000,10^6]])ru]/@Table[RandomInteger[1,50],100000],First[#]=!=None&]]
Out[]=
NOTE : bug in extracting plot data......
In[]:=
ResourceFunction["InteractiveListSelector"][ListStepPlot[First[#]]Last[#]&/@Select[Function[ru,(If[#=!=None,Echo[{Now,ru,#}],#]&[TestTS[ru,1000,1000,10^6]])ru]/@Table[RandomInteger[1,100],100000],First[#]=!=None&]]
In[]:=
ResourceFunction["InteractiveListSelector"][ListStepPlot[First[#]]Last[#]&/@Select[Function[ru,(If[#=!=None,Echo[{Now,ru,#}],#]&[TestTS[ru,1000,1000,10^6]])ru]/@Table[RandomInteger[1,200],100000],First[#]=!=None&]]
Out[]=
$Aborted
Recovery
Recovery
In[]:=
nbexpr=NotebookImportNotebookObject,"Echo""Expression"
Out[]=
In[]:=
Cases[nbexpr,_List]
Out[]=
In[]:=
Length[%]
Out[]=
25
In[]:=
#[[2]]&/@%562
Out[]=
In[]:=
ListStepPlot[#[[3]]]&/@%562
Out[]=
In[]:=
Max[#[[3]]]&/@%562
Out[]=
{164084,137568,137554,137568,137576,164048,137580,167768,137570,135320,97636,137572,137564,137566,137578,137596,137568,137572,137570,164088,137576,137566,137590,137582,135330}
In[]:=
Counts[%]
Out[]=
1640841,1375683,1375541,1375762,1640481,1375801,1677681,1375702,1353201,976361,1375722,1375641,1375662,1375781,1375961,1640881,1375901,1375821,1353301
In[]:=
Histogram[%567]
Out[]=