Find the list of unreachable events from a given event

(i.e. events not in the future light cone of a given event)
getCausallyDisconnectedRegions[{"AB""BAAB","A""BA"},"AB",4]
In[]:=
Out[]=
HighlightGraph[ResourceFunction["SubstitutionSystemCausalGraph"][{"AB""BAAB","A""BA"},"AB",4],{26,27,28,29,38,39,40,41,42,43,44,45}]
In[]:=
Out[]=

An event A is causally disconnected from B if the future light cones of A and B do not intersect

“A is causally connected to B” means there is a path from A to B in the causal graph
ImageReflect
,TopBottom
In[]:=
Out[]=

Black hole test: does every “final event” lie in the future light cone of all events

getCausallyDisconnectedRegions[{"AB""BAAB","A""BA"},"AB",4]
In[]:=
Out[]=
getCausallyDisconnectedRegions[{"AB""BAB","A""BA"},"AB",4]
In[]:=
{}
Out[]=
If there no black holes in evidence, there would be no unreachable elements, i.e. this list of disconnected regions would be empty
{ node  list of final nodes unreachable from this node , ... }
Currently looking at nodes at step t, and at what nodes at step 2 t are unreachable.

Code


Black hole finding

getCausallyDisconnectedRegions[{"AB""BAAB","A""BA"},"AB",1,4]
In[]:=
{2{26,27,28,29,38,39,40,41,42,43,44,45}}
Out[]=
getCausallyDisconnectedRegions[{"AB""BAAB","A""BA"},"AB",1,4]
In[]:=
{2{26,27,28,29,38,39,40,41,42,43,44,45}}
Out[]=
Graph[ResourceFunction["SubstitutionSystemCausalGraph"][{"AB""BAAB","A""BA"},"AB",4],VertexLabelsAutomatic]
In[]:=
Out[]=
getCausallyDisconnectedRegions[{"AB""BAAB","A""BA"},"AB",2,5]
In[]:=
Out[]=
First/@%
In[]:=
{2,4,5,6,7,8,9}
Out[]=
The LHS events are ones whose future light cones are not “complete”
What is the “causal connection graph” of nodes 2, 4, 5, 6, 8?
Case 1: “final null set” of A and B are identical
Case 2: “final null set” of A contains final null set of B
Case 3: intersect (A  X and B  X)
Case 4: disjoint
Clear[IntersectionRule]
In[]:=
IntersectionRule[s1_->list1_,s2_->list2_]/;!IntersectingQ[list1,list2]:={}
In[]:=
IntersectionRule[s1_->list1_,s2_->list2_]/;(SubsetQ[list1,list2]&&!SubsetQ[list2,list1]):={DirectedEdge[s1,s2]}
In[]:=
IntersectionRule[s1_->list1_,s2_->list2_]/;(SubsetQ[list2,list1]&&!SubsetQ[list1,list2]):={DirectedEdge[s2,s1]}
In[]:=
IntersectionRule[s1_->list1_,s2_->list2_]/;Sort[list1]===Sort[list2]:={DirectedEdge[s1,s2],DirectedEdge[s2,s1]}
In[]:=
IntersectionRule[s1_->list1_,s2_->list2_]/;(IntersectingQ[list1,list2]&&!SubsetQ[list1,list2]&&!SubsetQ[list2,list1]):={UndirectedEdge[s1,s2]}
In[]:=
getCausallyConnectedRegions[{"AB""BAAB","A""BA"},"AB",2,5]
In[]:=
Out[]=
CausalConnectionGraph[rule_,init_,ti_,tf_]:=With[{u=getCausallyConnectedRegions[rule,init,ti,tf]},SimpleGraph[Flatten[Outer[IntersectionRule,u,u,1]]]]
In[]:=
CausalConnectionGraphAt[rule_,init_,ti_,tf_]:=With[{u=getCausallyConnectedRegionsAt[rule,init,ti,tf]},SimpleGraph[Flatten[Outer[IntersectionRule,u,u,1]]]]
In[]:=
CausalConnectionGraph[{"AB""BAAB","A""BA"},"AB",2,5]
In[]:=
Out[]=
CausalConnectionGraph[{"AB""BAAB","A""BA"},"AB",2,6]
In[]:=
Out[]=
CausalConnectionGraph[{"AB""BAAB","A""BA"},"AB",3,6]
In[]:=
Out[]=
CausalConnectionGraph[{"AB""BAAB","A""BA"},"AB",3,7]
In[]:=
Out[]=
Graph3D[%]
In[]:=
Out[]=
Graph[CausalConnectionGraph[{"AB""BAAB","A""BA"},"AB",3,7],VertexLabelsAutomatic]
In[]:=
Out[]=
CausalConnectionSummary[rule_,init_,ti_,tf_]:=With[{g=CausalConnectionGraph[rule,init,ti,tf]},Fold[VertexContract[#1,#2]&,g,ConnectedComponents[g]]]
In[]:=
CausalConnectionSummaryAt[rule_,init_,ti_,tf_]:=With[{g=CausalConnectionGraphAt[rule,init,ti,tf]},Fold[VertexContract[#1,#2]&,g,ConnectedComponents[g]]]
In[]:=
ConnectedComponents[CausalConnectionGraph[{"AB""BAAB","A""BA"},"AB",3,7]]
In[]:=
{{14},{6,10,15},{16},{11,17},{2,4,7},{18},{8,12,19},{20},{13,21},{5,9},{1,3}}
Out[]=
Fold[VertexContract[#1,#2]&,CausalConnectionGraph[{"AB""BAAB","A""BA"},"AB",3,7],ConnectedComponents[CausalConnectionGraph[{"AB""BAAB","A""BA"},"AB",3,7]]]
In[]:=
Out[]=
CausalConnectionSummary[{"AB""BAAB","A""BA"},"AB",2,7]
In[]:=
Out[]=
CausalConnectionSummary[{"AB""BAAB","A""BA"},"AB",3,7]
In[]:=
Out[]=
CausalConnectionSummary[{"AB""BAAB","A""BA"},"AB",4,7]
In[]:=
Out[]=
CausalConnectionSummary[{"AB""BAAB","A""BA"},"AB",4,8]
In[]:=
Out[]=
CausalConnectionSummaryAt[{"AB""BAAB","A""BA"},"AB",4,8]
In[]:=
Out[]=

All rules

ResourceFunction["ParallelMapMonitored"][TimeConstrained[{ResourceFunction["SubstitutionSystemCausalGraph"][#,"AABA",5],CausalConnectionSummary[#,"AABA",3,7]},5]&,ResourceFunction["EnumerateSubstitutionSystemRules"][{23,22},2]]
In[]:=
LinkObject
:Unable to communicate with closed link LinkObject[59367@10.20.50.7,59368@10.20.50.7,7964,41].
KernelObject
:Subkernel connected through KernelObject
Name: \lambda
KernelID: \30
 appears dead.
Parallel`Developer`QueueRun
::req
:Requeueing evaluations {64} assigned to KernelObject
Name: \lambda
State: \defunct
.
LaunchKernels
:Kernel KernelObject
Name: \lambda
State: \defunct
 resurrected as KernelObject
Name: \lambda
KernelID: \94
.
Out[]=
ResourceFunction["ParallelMapMonitored"][TimeConstrained[{With[{g=ResourceFunction["SubstitutionSystemCausalGraph"][#,"AABA",5]},HighlightGraph[g,Complement[VertexOutComponent[g,1,3],VertexOutComponent[g,1,2]],VertexLabelsAutomatic]],Graph[CausalConnectionSummary[#,"AABA",3,7],VertexLabelsAutomatic]},5]&,Take[ResourceFunction["EnumerateSubstitutionSystemRules"][{23,22},2],10]]
In[]:=
Out[]=
With[{g=ResourceFunction["SubstitutionSystemCausalGraph"][{"AB""BAAB","A""BA"},"AB",5]},HighlightGraph[g,Complement[VertexOutComponent[g,1,3],VertexOutComponent[g,1,2]],VertexLabelsAutomatic]]
In[]:=
Out[]=
Graph[CausalConnectionGraph[{"AB""BAAB","A""BA"},"AB",3,7],VertexLabelsAutomatic]
In[]:=
Out[]=
Graph[CausalConnectionSummary[{"AB""BAAB","A""BA"},"AB",3,7],VertexLabelsAutomatic]
In[]:=
Out[]=
With[{g=ResourceFunction["SubstitutionSystemCausalGraph"][{"AB""BAAB","A""BA"},"AB",5]},Complement[VertexOutComponent[g,1,3],VertexOutComponent[g,1,2]]]
In[]:=
{6,7,11,12,20,21,29}
Out[]=
Subgraph[%64,%]
In[]:=
Out[]=
ResourceFunction["ParallelMapMonitored"][TimeConstrained[With[{g=ResourceFunction["SubstitutionSystemCausalGraph"][#,"AABA",7],gs=CausalConnectionSummaryAt[#,"AABA",4,7]},{HighlightGraph[g,First/@gs,VertexLabelsAutomatic,GraphLayout"LayeredDigraphEmbedding",AspectRatio1/2],Graph[gs,VertexLabelsAutomatic]}],5]&,Take[ResourceFunction["EnumerateSubstitutionSystemRules"][{23,22},2],10]]
In[]:=
Out[]=
ResourceFunction["ParallelMapMonitored"][TimeConstrained[With[{g=ResourceFunction["SubstitutionSystemCausalGraph"][#,"AABA",7],gs=CausalConnectionSummaryAt[#,"AABA",4,7]},{HighlightGraph[g,First/@gs,VertexLabelsAutomatic,GraphLayout"LayeredDigraphEmbedding",AspectRatio1/2],Graph[gs,VertexLabelsAutomatic]}],5]&,ResourceFunction["EnumerateSubstitutionSystemRules"][{23,22},2]]
In[]:=
Out[]=

Failure of global hyperbolicity:


,


WolframModel case

IntersectionRule[s1_->list1_,s2_->list2_]/;!IntersectingQ[list1,list2]:={}
In[]:=
IntersectionRule[s1_->list1_,s2_->list2_]/;(SubsetQ[list1,list2]&&!SubsetQ[list2,list1]):={DirectedEdge[s1,s2]}
In[]:=
IntersectionRule[s1_->list1_,s2_->list2_]/;(SubsetQ[list2,list1]&&!SubsetQ[list1,list2]):={DirectedEdge[s2,s1]}
In[]:=
IntersectionRule[s1_->list1_,s2_->list2_]/;Sort[list1]===Sort[list2]:={DirectedEdge[s1,s2],DirectedEdge[s2,s1]}
In[]:=
IntersectionRule[s1_->list1_,s2_->list2_]/;(IntersectingQ[list1,list2]&&!SubsetQ[list1,list2]&&!SubsetQ[list2,list1]):={UndirectedEdge[s1,s2]}
In[]:=
getWolframModelCausallyConnectedRegionsAt[rules_,initialCondition_,initialTime_Integer,finalTime_Integer]:=Module[{newEventsInitialCausalGraph,newEventsFinalCausalGraph,causalGraph,initialEventsList,previousEventsList,newEventsList},​​newEventsInitialCausalGraph=ResourceFunction["WolframModel"][rules,initialCondition,finalTime-1,"CausalGraph"];​​newEventsFinalCausalGraph=ResourceFunction["WolframModel"][rules,initialCondition,finalTime,"CausalGraph"];​​initialEventsList=VertexList[ResourceFunction["WolframModel"][rules,initialCondition,initialTime,"CausalGraph"]];​​previousEventsList=VertexList[ResourceFunction["WolframModel"][rules,initialCondition,initialTime-1,"CausalGraph"]];​​newEventsList=Complement[VertexList[newEventsFinalCausalGraph],VertexList[newEventsInitialCausalGraph]];​​#->Intersection[newEventsList,VertexOutComponent[newEventsFinalCausalGraph,#]]&/@Complement[initialEventsList,previousEventsList]]
In[]:=
WMCausalConnectionGraphAt[rule_,init_,ti_,tf_]:=With[{u=getWolframModelCausallyConnectedRegionsAt[rule,init,ti,tf]},SimpleGraph[Flatten[Outer[IntersectionRule,u,u,1]]]]
In[]:=
WMCausalConnectionSummaryAt[rule_,init_,ti_,tf_]:=With[{g=WMCausalConnectionGraphAt[rule,init,ti,tf]},Fold[VertexContract[#1,#2]&,g,ConnectedComponents[g]]]
In[]:=
allrules32=
;
In[]:=
RandomSample[allrules32,6]
In[]:=
Out[]=
ResourceFunction["ParallelMapMonitored"][TimeConstrained[With[{g=ResourceFunction["WolframModel"][#,Automatic,7,"LayeredCausalGraph"],gs=WMCausalConnectionSummaryAt[#,Automatic,4,7]},{HighlightGraph[g,First/@gs,VertexLabelsAutomatic,AspectRatio1/2],Graph[gs,VertexLabelsAutomatic]}],5]&,%87]
In[]:=
Out[]=
ResourceFunction["ParallelMapMonitored"][TimeConstrained[With[{g=ResourceFunction["WolframModel"][#,Automatic,7,"LayeredCausalGraph"],gs=WMCausalConnectionSummaryAt[#,Automatic,4,7]},{HighlightGraph[g,First/@gs,VertexLabelsAutomatic,AspectRatio1/2],Graph[gs,VertexLabelsAutomatic]}],5]&,allrules32]
In[]:=
Out[]=
Counts[ResourceFunction["ParallelMapMonitored"][Framed[TimeConstrained[With[{g=ResourceFunction["WolframModel"][#,Automatic,7,"LayeredCausalGraph"],gs=WMCausalConnectionSummaryAt[#,Automatic,4,7]},IndexGraph[gs]],5]]&,allrules32]]
In[]:=
Out[]=
Counts[ResourceFunction["ParallelMapMonitored"][Framed[TimeConstrained[With[{gs=WMCausalConnectionSummaryAt[#,Automatic,5,10]},IndexGraph[gs]],5]]&,allrules32]]
In[]:=
Out[]=
Counts[ResourceFunction["ParallelMapMonitored"][Framed[TimeConstrained[With[{gs=WMCausalConnectionSummaryAt[#,Automatic,5,10]},IndexGraph[gs]],5]]&,allrules32]]
In[]:=
Out[]=
ResourceFunction["ParallelMapMonitored"][TimeConstrained[With[{gs=WMCausalConnectionSummaryAt[#,Automatic,5,10]},{#,Framed[IndexGraph[gs]]}],5]&,allrules32];
In[]:=
ResourceFunction["InteractiveListSelector"][Last[#]->Take[#,UpTo[3]]&/@GatherBy[%,Last]]
In[]:=
Out[]=
ResourceFunction["WolframModel"][{{1,2},{3,2}}{{4,1},{4,3},{1,2}},Automatic,10,"LayeredCausalGraph"]
In[]:=
Out[]=
ResourceFunction["WolframModel"][{{1,2},{3,2}}{{4,1},{4,3},{1,2}},Automatic,15,"LayeredCausalGraph"]
In[]:=
Out[]=
ResourceFunction["WolframModel"][{{1,2},{3,2}}{{4,1},{4,3},{1,2}},Automatic,15,"StatesPlotsList"]
In[]:=
Out[]=
ResourceFunction["WolframModel"][{{1,2},{3,2}}{{4,1},{4,3},{1,2}},Automatic,25,"LayeredCausalGraph"]
In[]:=
Out[]=
WMCausalConnectionSummaryAt[{{1,2},{3,2}}{{4,1},{4,3},{1,2}},Automatic,7,20]
In[]:=
Out[]=
Table[WMCausalConnectionSummaryAt[{{1,2},{3,2}}{{4,1},{4,3},{1,2}},Automatic,t,20],{t,10}]
In[]:=
Out[]=
Graph[Rule@@@ResourceFunction["WolframModel"][{{1,2},{3,2}}{{4,1},{4,3},{1,2}},Automatic,15,"FinalState"]]
In[]:=
Out[]=
Graph3D[%]
In[]:=
Out[]=
ResourceFunction["WolframModel"][{{1,2},{3,2}}{{4,1},{4,3},{1,2}},Automatic,10,"EventsStatesPlotsList"]
In[]:=
Out[]=
ResourceFunction["WolframModel"][{{1,2},{3,2}}{{4,1},{4,3},{1,2}},{{1,2},{3,2},{3,4},{1,4}},15,"LayeredCausalGraph"]
In[]:=
Out[]=
ResourceFunction["WolframModel"][{{1,2},{3,2}}{{4,1},{4,3},{1,2}},Table[{0,0},8],15,"LayeredCausalGraph"]
In[]:=
Out[]=
ResourceFunction["WolframModel"][{{1,2},{3,2}}{{4,1},{4,3},{1,2}},Table[{0,0},8],12,"StatesPlotsList"]
In[]:=
Out[]=
Table[Framed[WMCausalConnectionSummaryAt[{{1,2},{3,2}}{{4,1},{4,3},{1,2}},Table[{0,0},n],7,25]],{n,15}]
In[]:=
Out[]=
ResourceFunction["WolframModel"][{{1,2},{3,2}}{{4,1},{4,3},{1,2}},Table[{0,0},3],15,"LayeredCausalGraph"]
In[]:=
Out[]=
ResourceFunction["WolframModel"][{{1,2},{3,2}}{{4,1},{4,3},{1,2}},Table[{0,0},3],12,"StatesPlotsList"]
In[]:=
Out[]=
Graph[Rule@@@ResourceFunction["WolframModel"][{{1,2},{3,2}}{{4,1},{4,3},{1,2}},Table[{0,0},3],15,"FinalState"]]
In[]:=
Out[]=
Graph3D[%]
In[]:=
Out[]=
ResourceFunction["WolframModel"<