Wolfram Cloud Document

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

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

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[]=

{}

Clear

Copy

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

In[]:=

nbexpr=NotebookImportNotebookObject

TagSystems-12.nb

,"Echo""Expression"

Out[]=

{18326,

⋯27⋯

,

⋯1⋯

}

large output

show less

show all

set size limit...

In[]:=

Cases[nbexpr,_List]

Out[]=

{

⋯1⋯

}

large output

show less

show all

set size limit...

In[]:=

Length[%]

Out[]=

25

In[]:=

#[[2]]&/@%562

Out[]=

In[]:=

ListStepPlot[#[[3]]]&/@%562

Out[]=



,