[MaxP]

Combinator Termination

An expression is exploding iff we start an evolution with that expression as an init, it will not terminate.
An expression is exploding if:
1
.
One of the further states contains the init.
2
.
One of the further states contains another exploding expression.

Evolution Code

In[]:=
recursingCombinatorExpression[expr_,maxSteps_]:=recursingCombinatorExpression[expr,maxSteps]=!FreeQ[Rest[SKFixedPointEvolveList[expr,∞,maxSteps]],expr]
In[]:=
explodingCombinatorExpression[expr_,maxSteps_]:=explodingCombinatorExpression[expr,maxSteps]=AnyTrue[Catenate[Level[#,{0,∞},HeadsTrue]&/@SKFixedPointEvolveList[expr,∞,maxSteps]],recursingCombinatorExpression[#,maxSteps]&]
s[x_][y_][z_]x[z][y[z]]
In[]:=
explodingCombinatorExpression[s[s][s][s],300]
Out[]=
False
In[]:=
explodingCombinatorExpression[s[s[s]][s][s][s][s[k]],200]
Out[]=
True
In[]:=
explodingCombinatorExpression
s[
][
][
][
][
][
][
][
][
][
][
][
]
,100
Out[]=
True
In[]:=
recursingCombinatorExpression
s[
][
][
][
][
][
][
][
][
][
][
][
]
,100
Out[]=
True
In[]:=
LeafCount/@SKOuterEvolveList[s[s][s][s[s][s]][s[s][s]],40]
Out[]=
{9,11,13,15,21,27,37,47,57,70,83,96,116,126,146,166,186,213,226,239,255,265,281,297,313,336,349,372,382,405,428,451,481,497,513,532,545,564,574,593,612}
In[]:=
ListLinePlot[%]
Out[]=
10
20
30
40
100
200
300
400
500
600
In[]:=
ListStepPlot[Differences[LeafCount/@SKOuterEvolveList[s[s][s][s[s][s]][s[s][s]],200]]]
Out[]=
50
100
150
200
10
20
30
40
In[]:=
explodingCombinatorExpression[s[s][s][s[s][s]][s[s][s]],20]
Out[]=
False
In[]:=
recursingCombinatorExpressionX[expr_,maxSteps_]:=recursingCombinatorExpressionX[expr,maxSteps]=!FreeQ[Rest[SKOuterEvolveList[expr,maxSteps]],expr]
In[]:=
recursingCombinatorExpressionX[s[s][s][s[s][s]][s[s][s]],30]
Out[]=
False
In[]:=
evolxxx=SKOuterEvolveList[s[s][s][s[s][s]][s[s][s]],100];
In[]:=
Position[evolxxx,s[s][s][s[s][s]][s[s][s]]]
Out[]=
{{1}}
AnyTrue[Catenate[Level[#,{0,∞},HeadsTrue]&/@SKOuterEvolveList[expr,∞,maxSteps]],recursingCombinatorExpression[#,maxSteps]&]

Causal graphs

Metadata is expression[contents, creatorEvent]
In[]:=
addMetadataToInitExpression[expr_,nextExpressionIDFunction_,saveExpressionContentsFunction_,saveExpressionGenerationFunction_]:=Map[With[{id=nextExpressionIDFunction[]},saveExpressionContentsFunction[id,#];saveExpressionGenerationFunction[id,0];expression[#,id,0]]&,expr,{0,∞},HeadsTrue]
In[]:=
addMetadataToInitExpression[s[s][s][s]]
Out[]=
expression[expression[expression[expression[s,0][expression[s,0]],0][expression[s,0]],0][expression[s,0]],0]
In[]:=
%//.expression[expr_,0]expr
Out[]=
s[s][s][s]
In[]:=
addMetadataToInitExpression[x]
Out[]=
expression[x,0]
In[]:=
Clear[skRulesWithMetadata]
In[]:=
outputIDs
Out[]=
outputIDs
Thread[expression/@{inputID1s,inputID2stripExpression[s[x]],inputID3->stripExpression[s[x][y]],inputID4->stripExpression[s[x][y][z]]}event[eventID]]
In[]:=
skRulesWithMetadata[nextExpressionIDFunction_,nextEventIDFunction_,saveExpressionContentsFunction_,saveExpressionGenerationFunction_]:={​​expression[expression[expression[expression[s,inputID1_,t1_][x_],inputID2_,t2_][y_],inputID3_,t3_][z_],inputID4_,t4_](With[{outputIDs=Table[nextExpressionIDFunction[],3],eventID=nextEventIDFunction[],gen=Max[t1,t2,t3,t4]+1},(Sow[Join[Thread[expression/@{inputID1,inputID2,inputID3,inputID4}event[eventID]],Thread[event[eventID]expression/@{outputIDs〚1〛,outputIDs〚2〛,outputIDs〚3〛}]]];saveExpressionContentsFunction@@@Transpose[{outputIDs,{x[z],y[z],x[z][y[z]]}}];​​saveExpressionGenerationFunction@@@Transpose[{outputIDs,{gen,gen,gen}}];​​expression[expression[x[z],outputIDs〚1〛,gen][expression[y[z],outputIDs〚2〛,gen]],outputIDs〚3〛,gen])]),​​expression[expression[expression[k,inputID1_,_][x_],inputID2_,_][y_],inputID3_,_]With[{eventID=nextEventIDFunction[]},(Sow[Thread[expression/@{inputID1,inputID2,inputID3}event[eventID]]];x)]}
In[]:=
stripExpression[expr_]:=expr//.expression[e_,_,_]e
In[]:=
skStepWithMetadata[expr_,nextExpressionIDFunction_,nextEventIDFunction_,saveExpressionContentsFunction_,saveExpressionGenerationFunction_]:=With[{rules=skRulesWithMetadata[nextExpressionIDFunction,nextEventIDFunction,saveExpressionContentsFunction,saveExpressionGenerationFunction]},MapAt[Replace[rules],expr,{First[Sort[Position[expr,Alternatives@@First/@rules]],Nothing]}]]
In[]:=
Options[skExpressionsEventsGraph]=Options[Graph];
In[]:=
generationsFromExpressions[edges_,egens_]:=Association[(#->Max[Cases[edges,(expression[e_]->#):>egens[e]]]+1)&/@(Union[Cases[edges,_event,{2}]])]
In[]:=
skExpressionsEventsGraph[init_,steps_,graphOpts:OptionsPattern[]]:=Module[{expressionID,eventID,nextExpressionIDFunction,nextEventIDFunction,saveExpressionContentsFunction,initWithMetadata,expressionContents,expressionGenerations,saveExpressionGenerationFunction,edges,g},​​expressionID=0;​​eventID=0;​​expressionContents=<||>;​​expressionGenerations=<||>;​​nextExpressionIDFunction=++expressionID&;​​nextEventIDFunction=++eventID&;​​saveExpressionContentsFunction=(expressionContents[#]=#2)&;​​saveExpressionGenerationFunction=(expressionGenerations[#]=#2)&;​​initWithMetadata=addMetadataToInitExpression[init,nextExpressionIDFunction,saveExpressionContentsFunction,saveExpressionGenerationFunction];edges=Flatten@Reap[FixedPoint[skStepWithMetadata[#,nextExpressionIDFunction,nextEventIDFunction,saveExpressionContentsFunction,saveExpressionGenerationFunction]&,initWithMetadata,steps]]〚-1〛;​​g=Graph[Cases[initWithMetadata,expression[_,id_,_]expression[id],All,HeadsTrue],edges,FilterRules[{graphOpts},Except[VertexLabels]],VertexStyle{_expressionResourceFunction["WolframPhysicsProjectStyleData"]["ExpressionsEventsGraph","ExpressionVertexStyle"],_eventResourceFunction["WolframPhysicsProjectStyleData"]["ExpressionsEventsGraph","EventVertexStyle"]},EdgeStyleResourceFunction["WolframPhysicsProjectStyleData"]["ExpressionsEventsGraph","EdgeStyle"],VertexLabelsReplace[OptionValue[VertexLabels],Automatic(expression[e_]StandardForm[Text[stripExpression[expressionContents[e]]]])]];Graph[g,GraphLayoutReplace[OptionValue[GraphLayout],Automatic{"LayeredDigraphEmbedding","VertexLayerPosition"(VertexList[g]/.Join[Normal[KeyMap[expression,2(Max[expressionGenerations]-expressionGenerations)]],Normal[2(Max[expressionGenerations]-generationsFromExpressions[edges,expressionGenerations])+1]])​​}]]​​]