ResourceFunction["MultiwayCombinator"]
In[]:=
Out[]=
ResourceFunction["MultiwayCombinator"][{s[x_][y_][z_]x[z][y[z]],k[x_][y_]x}"Sequential",s[s[s[s][s]]][s][s][k],12,"StatesGraphStructure"]
In[]:=
Out[]=
ResourceFunction["MultiwayCombinator"][{s[x_][y_][z_]x[z][y[z]],k[x_][y_]x}(First[#]&),s[s[s[s][s]]][s][s][k],2,"StatesGraph"]
In[]:=
ResourceFunction["MultiwayCombinator"][{s[x_][y_][z_]x[z][y[z]],k[x_][y_]x}"Sequential",s[s][s][s[s]][s][s],40,"StatesGraphStructure"]
In[]:=
Out[]=
ToExpression/@VertexList[%];
In[]:=
LeafCount/@%
In[]:=
{7,8,8,11,11,11,12,17,25,33,41,50,59,68,77,87,97,107,117,127,137,148,159,170,193,216,239,262,286,310,346,407,468,529,590,652,714,776,850,987,1124}
Out[]=
ListLinePlot[%311]
In[]:=
Out[]=
LeafCount/@SKFixedPointEvolveList[s[s][s][s[s]][s][s],1000]
In[]:=
{7,8,8,11,11,11,12,17,25,33,41,50,59,87,115,149,187,215,243,272,301,389,417,426,441,450,459,468,483,492,501,529,558,587,675,684,699,708,717,726,741,750,759,768,777,792,817,842,851,860,875,900,925,934,943,958,983}
Out[]=
Position[%314,87]
In[]:=
{{14}}
Out[]=
SKFixedPointEvolveList[s[s][s][s[s]][s][s],1000][[14]]
In[]:=
s[s[s[s]][s[s[s[s]][s]][s]]][s[s[s]][s[s[s[s]][s]][s]][s[s[s]][s[s[s[s]][s]][s]][s[s[s[s]][s[s[s[s]][s]][s]]]][s[s[s[s]][s[s[s[s]][s]][s]]]]][s[s[s[s]][s[s[s[s]][s]][s]]][s[s[s]][s[s[s[s]][s]][s]][s[s[s[s]][s[s[s[s]][s]][s]]]][s[s[s[s]][s[s[s[s]][s]][s]]]]]]]
Out[]=
%310[[14]]
In[]:=
s[s[s[s]][s[s[s[s]][s]][s]]][s[s[s[s[s]][s[s[s[s]][s]][s]]]][s[s][s[s[s[s]][s[s[s[s]][s]][s]]]][s[s[s]][s][s[s[s[s]][s[s[s[s]][s]][s]]]][s[s[s[s[s]][s[s[s[s]][s]][s]]]]]]][s[s[s[s]][s[s[s[s]][s]][s]]]]]
Out[]=
SKFixedPointEvolveList[s[s][s][s[s]][s][s],1000][[13]]
In[]:=
s[s[s[s]][s[s[s[s]][s]][s]]][s[s[s[s]][s[s[s[s]][s]][s]]][s[s[s[s]][s[s[s[s]][s]][s]]]][s[s[s]][s[s[s[s]][s]][s]][s[s[s[s]][s[s[s[s]][s]][s]]]][s[s[s[s]][s[s[s[s]][s]][s]]]]]]
Out[]=
%310[[13]]
In[]:=
s[s[s[s]][s[s[s[s]][s]][s]]][s[s[s[s[s]][s[s[s[s]][s]][s]]]][s[s][s[s[s[s]][s[s[s[s]][s]][s]]]][s[s[s[s]][s]][s][s[s[s[s]][s[s[s[s]][s]][s]]]]]][s[s[s[s]][s[s[s[s]][s]][s]]]]]
Out[]=
%===%%
In[]:=
False
Out[]=
SameQ@@@Transpose[{Take[%310,14],Take[SKFixedPointEvolveList[s[s][s][s[s]][s][s],1000],14]}]
In[]:=
{True,True,True,True,True,True,True,True,True,True,True,True,False,False}
Out[]=
e12=SKFixedPointEvolveList[s[s][s][s[s]][s][s],1000][[12]]
In[]:=
s[s[s[s]][s[s[s[s]][s]][s]]][s[s[s[s[s]][s[s[s[s]][s]][s]]]][s[s[s]][s[s[s[s]][s]][s]][s[s[s[s]][s[s[s[s]][s]][s]]]]][s[s[s[s]][s[s[s[s]][s]][s]]]]]
Out[]=
ResourceFunction["MultiwayCombinator"][{s[x_][y_][z_]x[z][y[z]],k[x_][y_]x},s[s][s][s[s]][s][s],15,"StatesGraphStructure"]
In[]:=
Out[]=
Position[e12,s[_][_][_]|k[_][_]]
In[]:=
{{1,0,1},{1}}
Out[]=
SKStepLargest[expr_]:=MapAt[Replace[{s[x_][y_][z_]x[z][y[z]],k[x_][y_]x}],expr,{First[ReverseSortBy[Position[expr,s[_][_][_]|k[_][_]],Length],{}]}]
In[]:=
SKFixedPointEvolveListLargest[expr_,max_Integer]:=Most[NestWhileList[SKStepLargest,expr,#1=!=#2&&LeafCount[#2]<max&,2]]
In[]:=
LeafCount/@SKFixedPointEvolveListLargest[s[s][s][s[s]][s][s],1000]
In[]:=
{7,8,8,11,11,11,12,17,25,33,41,50,59,68,77,87,97,107,117,127,137,148,159,170,193,216,239,262,286,310,346,407,468,554,640,726,837,948}
Out[]=
LeafCount/@%310
In[]:=
{7,8,8,11,11,11,12,17,25,33,41,50,59,68,77,87,97,107,117,127,137,148,159,170,193,216,239,262,286,310,346,407,468,529,590,652,714,776,850,987,1124}
Out[]=
Position[%,529]
In[]:=
{{34}}
Out[]=
Position[SKFixedPointEvolveListLargest[s[s][s][s[s]][s][s],1000][[33]],s[_][_][_]|k[_][_]]
In[]:=
{{1,0,1,1,1,0,1,1,0,1,0,1,0},{1,0,1,1,1,0,1,1,0,1,0,1,1},{1,0,1,1,1,0,1,1,0,1},{1,0,1,1,1,0,1,1,0},{1,0,1,1,1,0,1},{1,0,1,1,1,0},{1,0,1,1},{1,0,1},{1}}
Out[]=
Length/@%
In[]:=
{13,13,10,9,7,6,4,3,1}
Out[]=
FunctionToApplication[s[s[s[s]][s[s[s[s]][s]][s]]][s[s[s[s[s]][s[s[s[s]][s]][s]]]][s[s][s[s[s[s]][s[s[s[s]][s]][s]]]][s[s[s[s]][s]][s][s[s[s[s]][s[s[s[s]][s]][s]]]]]][s[s[s[s]][s[s[s[s]][s]][s]]]]]]
In[]:=
s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s[Application]s
Out[]=
ExpressionGraph[%]
In[]:=
Out[]=
/. is neither lexicographic, nor does it burrow into already inhabited burrows
/. is neither lexicographic, nor does it burrow into already inhabited burrows