Some Code
Some Code
getBranchEventsList[rules_,initialCondition_,stepCount_Integer]:=Module[{initialCausalGraph,branchingEvents,branchEventsWithDuplication},initialCausalGraph=SimpleGraph[ResourceFunction["SubstitutionSystemCausalGraph"][rules,initialCondition,stepCount]];branchingEvents=VertexList[initialCausalGraph][[Position[VertexOutDegree[initialCausalGraph],_?(#≥2&)][[All,1]]]];branchEventsWithDuplication={};(branchEventsWithDuplication=Join[branchEventsWithDuplication,Subsets[Rest[VertexOutComponent[initialCausalGraph,{#},1]],{2}]])&/@branchingEvents;DeleteDuplicates[branchEventsWithDuplication]]
In[]:=
getNewBranchEventsList[rules_,initialCondition_,stepCount_Integer]:=Module[{branchEvents,oldBranchEvents},If[stepCount>0,branchEvents=Sort/@getBranchEventsList[rules,initialCondition,stepCount];oldBranchEvents=Sort/@getBranchEventsList[rules,initialCondition,stepCount-1];Complement[branchEvents,oldBranchEvents],{}]]
In[]:=
getCausalConnectionsList[rules_,initialCondition_,stepCount_Integer]:=Module[{branchEventsList,newBranchEventsList,combinedBranchEventsList,finalCausalGraph,terminalEvents},branchEventsList=If[stepCount>0,getBranchEventsList[rules,initialCondition,stepCount-1],{}];newBranchEventsList=getNewBranchEventsList[rules,initialCondition,stepCount];combinedBranchEventsList=Union[branchEventsList,newBranchEventsList];finalCausalGraph=SimpleGraph[ResourceFunction["SubstitutionSystemCausalGraph"][rules,initialCondition,stepCount]];terminalEvents=VertexList[finalCausalGraph][[Position[VertexOutDegree[finalCausalGraph],0][[All,1]]]];With[{terminalEvent=#},(branchEventsList=Select[branchEventsList,!SubsetQ[VertexOutComponent[ReverseGraph[finalCausalGraph],terminalEvent],#]&])]&/@terminalEvents;<|"Connected"Complement[combinedBranchEventsList,Union[branchEventsList,newBranchEventsList]],"Disconnected"Union[branchEventsList,newBranchEventsList]|>]
In[]:=
causallyConnectedQ[rules_,initialCondition_,stepCount_Integer]:=Module[{disconnectedEventsList,connectedEventsList},disconnectedEventsList=Sort/@getCausalConnectionsList[rules,initialCondition,Ceiling[stepCount/2]]["Disconnected"];connectedEventsList=Sort/@getCausalConnectionsList[rules,initialCondition,stepCount]["Connected"];Length[Complement[disconnectedEventsList,connectedEventsList]]0]
In[]:=
getEventHorizons[rules_,initialCondition_,stepCount_Integer]:=Module[{disconnectedEventsList,connectedEventsList},disconnectedEventsList=Sort/@getCausalConnectionsList[rules,initialCondition,Ceiling[stepCount/2]]["Disconnected"];connectedEventsList=Sort/@getCausalConnectionsList[rules,initialCondition,stepCount]["Connected"];Complement[disconnectedEventsList,connectedEventsList]]
In[]:=
getWolframModelBranchEventsList[rules_,initialCondition_,stepCount_Integer]:=Module[{initialCausalGraph,branchingEvents,branchEventsWithDuplication},initialCausalGraph=SimpleGraph[ResourceFunction["WolframModel"][rules,initialCondition,stepCount,"CausalGraph"]];branchingEvents=VertexList[initialCausalGraph][[Position[VertexOutDegree[initialCausalGraph],_?(#≥2&)][[All,1]]]];branchEventsWithDuplication={};(branchEventsWithDuplication=Join[branchEventsWithDuplication,Subsets[Rest[VertexOutComponent[initialCausalGraph,{#},1]],{2}]])&/@branchingEvents;DeleteDuplicates[branchEventsWithDuplication]]
In[]:=
getWolframModelNewBranchEventsList[rules_,initialCondition_,stepCount_Integer]:=Module[{branchEvents,oldBranchEvents},If[stepCount>0,branchEvents=Sort/@getWolframModelBranchEventsList[rules,initialCondition,stepCount];oldBranchEvents=Sort/@getWolframModelBranchEventsList[rules,initialCondition,stepCount-1];Complement[branchEvents,oldBranchEvents],{}]]
In[]:=
getWolframModelCausalConnectionsList[rules_,initialCondition_,stepCount_Integer]:=Module[{branchEventsList,newBranchEventsList,combinedBranchEventsList,finalCausalGraph,terminalEvents},branchEventsList=If[stepCount>0,getWolframModelBranchEventsList[rules,initialCondition,stepCount-1],{}];newBranchEventsList=getWolframModelNewBranchEventsList[rules,initialCondition,stepCount];combinedBranchEventsList=Union[branchEventsList,newBranchEventsList];finalCausalGraph=SimpleGraph[ResourceFunction["WolframModel"][rules,initialCondition,stepCount,"CausalGraph"]];terminalEvents=VertexList[finalCausalGraph][[Position[VertexOutDegree[finalCausalGraph],0][[All,1]]]];With[{terminalEvent=#},(branchEventsList=Select[branchEventsList,!SubsetQ[VertexOutComponent[ReverseGraph[finalCausalGraph],terminalEvent],#]&])]&/@terminalEvents;<|"Connected"Complement[combinedBranchEventsList,Union[branchEventsList,newBranchEventsList]],"Disconnected"Union[branchEventsList,newBranchEventsList]|>]
In[]:=
wolframModelCausallyConnectedQ[rules_,initialCondition_,stepCount_]:=Module[{disconnectedEventsList,connectedEventsList},disconnectedEventsList=Sort/@getWolframModelCausalConnectionsList[rules,initialCondition,Ceiling[stepCount/2]]["Disconnected"];connectedEventsList=Sort/@getWolframModelCausalConnectionsList[rules,initialCondition,stepCount]["Connected"];Length[Complement[disconnectedEventsList,connectedEventsList]]0]
In[]:=
getWolframModelEventHorizons[rules_,initialCondition_,stepCount_Integer]:=Module[{disconnectedEventsList,connectedEventsList},disconnectedEventsList=Sort/@getWolframModelCausalConnectionsList[rules,initialCondition,Ceiling[stepCount/2]]["Disconnected"];connectedEventsList=Sort/@getWolframModelCausalConnectionsList[rules,initialCondition,stepCount]["Connected"];Complement[disconnectedEventsList,connectedEventsList]]
In[]:=
Substitution System Example
Substitution System Example
causallyConnectedQ["AB""BAAAB","ABA",6]
In[]:=
False
Out[]=
getEventHorizons["AB""BAAAB","ABA",6]
In[]:=
{{3,4}}
Out[]=
HighlightGraph[ResourceFunction["SubstitutionSystemCausalGraph"]["AB""BAAAB","ABA",6],{3,4}]
In[]:=
Out[]=
getCausalConnectionsList["AB""BAAAB","ABA",6]
In[]:=
Connected{{2,3},{4,7},{4,12},{5,2},{5,3},{7,12},{8,14},{10,6}},Disconnected{{4,3},{5,6},{5,10},{5,18},{6,18},{7,3},{7,8},{7,14},{7,25},{8,25},{9,16},{10,11},{10,18},{10,20},{11,20},{12,3},{12,23},{13,12},{13,23},{14,25},{14,27},{15,14},{15,27},{16,17},{18,19},{20,21},{23,24},{25,26},{27,28}}
Out[]=
Wolfram Model Example
Wolfram Model Example
wolframModelCausallyConnectedQ[{{1,2},{2,3}}{{3,4},{3,4},{4,1}},Automatic,10]
In[]:=
False
Out[]=
getWolframModelEventHorizons[{{1,2},{2,3}}{{3,4},{3,4},{4,1}},Automatic,10]
In[]:=
{{6,7}}
Out[]=
HighlightGraph[ResourceFunction["WolframModel"][{{1,2},{2,3}}{{3,4},{3,4},{4,1}},Automatic,10,"CausalGraph"],{6,7}]
In[]:=
Out[]=
getWolframModelCausalConnectionsList[{{1,2},{2,3}}{{3,4},{3,4},{4,1}},Automatic,10]
In[]:=
Connected{{2,3},{4,7},{5,3},{5,6},{5,7},{6,3},{6,5},{10,16},{11,9},{11,19},{14,20},{17,10},{17,16},{18,13},{18,16},{19,20}},Disconnected{{6,7},{10,8},{11,15},{12,26},{15,28},{15,29},{18,17},{19,15},{19,25},{20,25},{21,30},{22,24},{23,31},{25,26},{25,27},{26,27},{28,29},{28,30},{29,30}}
Out[]=