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
Definitions
Definitions
Also consider a version that shares common subexpressions:
In[]:=
CombinatorTree[expr_]:=ExpressionGraph[ReplaceRepeated[expr,(f_?(!ListQ[#]&))[x_]{f,x}]]
In[]:=
CombinatorEvolutionGraph[rules_List,init_,t_Integer]:=NestGraph[CombinatorStep[rules,#]&,If[!ListQ[#],{#},#]&[init],t]
In[]:=
CombinatorStep[rules_,expr_]:=MapAt[Replace[#,rules]&,expr,If[Length[#]0,{{}},#]&[#]]&/@Position[expr,Alternatives@@(First/@rules)]
(This shows all possible rewriting locations; many won’t be done if a particular event selection function is used...)
In[]:=
CombinatorAnnotate[rules_List,expr_,f_:Framed]:=MapAt[f,expr,Position[expr,Alternatives@@(First/@rules)]]
Notes
Notes
λI system guarantees “ordinary confluence” ... requires any variable from the left to appear on the right in any rule [ K is a selector and violates this , but S is part of λI ]
In λI, if any evaluation order terminates, all will. If any evaluation order doesn’t terminate, none will.
Experiments
Experiments
In[]:=
CombinatorTree/@{s[s][s],s[s[s]]}
Out[]=
In[]:=
MultiwayCombinator[{s[x_][y_][z_]x[z][y[z]],k[x_][y_]x},s[s[s][s][s]][s][s],3,"StatesGraph"]
Out[]=
In[]:=
ToExpression/@VertexList[%40]
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]]}
In[]:=
CombinatorTree/@%
Out[]=
In[]:=
Level[s[s[s][s[s]]][s][s],{0,Infinity},HeadsTrue]
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]}
Above a certain size, the rule can’t see beyond the subexpression....
In[]:=
CombinatorEvolutionGraph[{s[x_][y_][z_]x[z][y[z]],k[x_][y_]x},s[s[s][s][s]][s][s],7]
Out[]=
In[]:=
CombinatorTree/@VertexList[%]
Out[]=
In[]:=
CombinatorEvolutionGraph[{s[x_][y_][z_]x[z][y[z]],k[x_][y_]x},s[s[s[s]]][s][s][s],14]
Out[]=
In[]:=
With[{g=CombinatorEvolutionGraph[{s[x_][y_][z_]x[z][y[z]],k[x_][y_]x},s[s[s[s]]][s][s][s],20]},Graph[g,VertexLabels(#LeafCount[#]&/@VertexList[g])]]
Out[]=
In[]:=
With[{g=CombinatorEvolutionGraph[{s[x_][y_][z_]x[z][y[z]],k[x_][y_]x},s[s[s[s]]][s][s][s],20]},Pick[VertexList[g],#0&/@VertexOutDegree[g],True]]
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]]]]]]]]}
In[]:=
Length[%]
Out[]=
1
No subgraph like this:
To find common subexpressions, start from ensemble of all possible initial conditions....
To find common subexpressions, start from ensemble of all possible initial conditions....
Non-terminating
Non-terminating