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[]:=
ResourceFunction["InteractiveListSelector"][ParallelTable[Enclose[With[{s=Confirm[TimeConstrained[LeafCount/@NestList[BetaReduce[#,1]&,#,30],5]]},If[Last[Length/@FindTransientRepeat[s,4]]>0,Nothing,If[Length[Union[Differences[Take[s,-20]]]]<3,Nothing,ListStepPlot[s,PlotTheme->"Minimal"]->#]]],Function[fail,"failed"->#]]&[RandomLambda[3,3]],200000]]
In[]:=
ResourceFunction["InteractiveListSelector"][ParallelMap[Enclose[With[{s=Confirm[TimeConstrained[LeafCount/@NestList[BetaReduce[#,1]&,#,30],5]]},If[Last[Length/@FindTransientRepeat[s,4]]>0,Nothing,If[Length[Union[Differences[Take[s,-20]]]]<3,Nothing,ListStepPlot[s,PlotTheme->"Minimal"]->#]]],Function[fail,"failed"->#]]&,EnumerateLambdas[3,2]]]
Out[]=
In[]:=
ResourceFunction["InteractiveListSelector"][ParallelMap[Enclose[With[{s=Confirm[TimeConstrained[LeafCount/@NestList[BetaReduce[#,1]&,#,30],5]]},If[Last[Length/@FindTransientRepeat[s,4]]>0,Nothing,If[Length[Union[Differences[Take[s,-20]]]]<3,Nothing,ListStepPlot[s,PlotTheme->"Minimal"]->#]]],Function[fail,"failed"->#]]&,EnumerateLambdas[2,3]]]
Out[]=
In[]:=
Length[EnumerateLambdas[2,3]]
Out[]=
24886
In[]:=
ListStepPlot/@Union[ParallelMap[LeafCount/@NestList[BetaReduce[#,1]&,#,30]&,EnumerateLambdas[2,2]]]
Out[]=
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
In[]:=
ParallelMap[Length/@FindTransientRepeat[LeafCount/@NestList[BetaReduce[#,1]&,#,30],4]&,EnumerateLambdas[2,2]]
Out[]=
{{0,1},{0,1},{0,1},{0,1},{0,1},{0,1},{0,1},{0,1},{0,1},{0,1},{0,1},{0,1},{0,1},{0,1},{1,1},{1,1},{1,1},{1,1},{1,1},{1,1},{1,1},{1,1},{1,1},{1,1},{1,1},{1,1},{1,1},{1,1},{1,1},{2,1},{2,1},{0,1},{3,1},{2,1},{2,1},{1,1},{2,1},{2,1},{2,1},{2,1},{2,1},{2,1},{1,1},{1,1},{1,1},{1,1},{1,1},{1,1},{1,1},{1,1},{1,1},{1,1},{1,1},{1,1},{1,1},{1,1}}
In[]:=
Position[%,{3,1}]
Out[]=
{{33}}
In[]:=
EnumerateLambdas[2,2][[33]]
Out[]=
λ.[λ.[1[1]][λ.[1[2]]]]
In[]:=
ResourceFunction["InteractiveListSelector"][ListStepPlot[First[#],PlotTheme->"Minimal"]->Last[#]&/@ParallelMap[If[Max[Differences[First[#]]]==0,Nothing,#]&[(LeafCount/@NestList[BetaReduce[#,1]&,#,30])->#]&,EnumerateLambdas[2,2]]]
Out[]=
In[]:=
ResourceFunction["InteractiveListSelector"][ListStepPlot[First[#],PlotTheme->"Minimal"]->Last[#]&/@ParallelMap[If[Max[Differences[First[#]]]==0,Nothing,#]&[(LeafCount/@NestList[BetaReduce[#,1]&,#,30])->#]&,EnumerateLambdas[3,2]]]
In[]:=
Labeled[ListStepPlot[LeafCount/@NestList[BetaReduce[#,1]&,#,10],Center,Frame->True,AspectRatio->1/2,PlotRange->{0,20}],Text[LambdaConvert[#,"BracketParens"]]]&/@{λ.[λ.[λ.[2[2]]][λ.[1[λ.[2]]]]],λ.[λ.[λ.[2[2]]][λ.[1[λ.[2[3]]]]]],λ.[λ.[λ.[1][λ.[2[2]]]][λ.[λ.[2[1]][λ.[3[2]]]]]],λ.[λ.[λ.[1][λ.[2[2]]]][λ.[λ.[2[1]][λ.[2[3]]]]]]}
Out[]=
,
,
,
[[[22]][1[2]]] |
[[[22]][1[23]]] |
[[[1][22]][[21][32]]] |
[[[1][22]][[21][23]]] |
In[]:=
ResourceFunction["InteractiveListSelector"][ListStepPlot[First[#],PlotTheme->"Minimal"]->Last[#]&/@ParallelMap[If[Max[Differences[First[#]]]==0,Nothing,#]&[(LeafCount/@NestList[BetaReduce[#,1]&,#,30])->#]&,EnumerateLambdas[3,2]]]
In[]:=
Counts[ParallelMap[If[Max[Differences[#]]==0,Nothing,Length/@FindTransientRepeat[#,4]]&[(LeafCount/@NestList[BetaReduce[#,1]&,#,30])]&,EnumerateLambdas[3,2]]]
Out[]=
{2,1}109,{3,1}547,{31,0}216,{4,1}836,{2,3}6,{5,1}687,{1,2}7,{6,1}400,{3,2}31,{3,3}26,{2,2}26,{7,1}177,{1,3}1,{4,2}28,{6,2}3,{5,2}9,{0,2}3,{4,3}28,{8,1}65,{1,1}1,{9,1}13,{10,1}4,{5,3}9,{6,3}2,{7,2}1,{11,1}1
In[]:=
Keys[%]
Out[]=
{{2,1},{3,1},{31,0},{4,1},{2,3},{5,1},{1,2},{6,1},{3,2},{3,3},{2,2},{7,1},{1,3},{4,2},{6,2},{5,2},{0,2},{4,3},{8,1},{1,1},{9,1},{10,1},{5,3},{6,3},{7,2},{11,1}}
In[]:=
Cases[%,{_,1}]//Sort
Out[]=
{{1,1},{2,1},{3,1},{4,1},{5,1},{6,1},{7,1},{8,1},{9,1},{10,1},{11,1}}
In[]:=
Position[ParallelMap[If[Max[Differences[#]]==0,0,Length/@FindTransientRepeat[#,4]]&[(LeafCount/@NestList[BetaReduce[#,1]&,#,30])]&,EnumerateLambdas[3,2]],{11,1}]
Out[]=
{{29045}}
In[]:=
Select[%130,Last[#]>1&]
Out[]=
{{2,3},{1,2},{3,2},{3,3},{2,2},{1,3},{4,2},{6,2},{5,2},{0,2},{4,3},{5,3},{6,3},{7,2}}
In[]:=
KeySelect[%129,Last[#]>1&]
Out[]=
{2,3}6,{1,2}7,{3,2}31,{3,3}26,{2,2}26,{1,3}1,{4,2}28,{6,2}3,{5,2}9,{0,2}3,{4,3}28,{5,3}9,{6,3}2,{7,2}1
In[]:=
Total[%]
Out[]=
180
4,4
4,4