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
[Nov 22, 2020 Programming Adventures]
[Nov 22, 2020 Programming Adventures]
Out[]=
Out[]=
s[s[s]][s][s][s][k] |
s[s][s][s[s]][s][k] |
s[s[s]][s[s[s]]][s][k] |
s[s][s][s[s[s]][s]][k] |
s[s[s[s]][s]][s[s[s[s]][s]]][k] |
s[s[s]][s][k][s[s[s[s]][s]][k]] |
s[s][k][s[k]][s[s[s[s]][s]][k]] |
s[s[k]][k[s[k]]][s[s[s[s]][s]][k]] |
s[k][s[s[s[s]][s]][k]][k[s[k]][s[s[s[s]][s]][k]]] |
k[k[s[k]][s[s[s[s]][s]][k]]][s[s[s[s]][s]][k][k[s[k]][s[s[s[s]][s]][k]]]] |
k[s[k]][s[s[s[s]][s]][k]] |
s[k] |
But it could also take 31 steps (and involve an intermediate expression of size 65):
Out[]=
In[]:=
SCombinatorAutomatonTreeGeneral[s[s[s[s]]][s[s[s]]][s[s]],Application[x_,y_]x+y,1,VertexSize.6]
Out[]=
In[]:=
Groupings[Table[s,6],Construct2]
Out[]=
{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[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]],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]]]}
In[]:=
grps6=Map[First,GatherBy[{#,CombinatorFixedPoint[#]}&/@Groupings[Table[s,6],Construct2],Last],{2}]
Out[]=
{{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[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]]]]]},{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]]]}}
In[]:=
CombinatorFixedPoint/@{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[]=
{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[]:=
Map[CombinatorExpressionGraph,%552,{2}]
Out[]=
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
This is the (only) winning valuation function for k=2
This is the (only) winning valuation function for k=2
k=3
k=3
All candidate discriminating k=3’s, working up to size 9