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
In[]:=
ClearAll[causalGraph];
In[]:=
causalGraph[state_List]:=(Sow[#state&/@state];causalGraph/@state)
In[]:=
causalGraph[•]:={}
In[]:=
object=WolframModel[<|"PatternRules"{{x_,y_},{x_,z_}}{{x,z},{x,{{x,y},{x,z}}},{y,{{x,y},{x,z}}},{z,{{x,y},{x,z}}}}|>,{{•,•},{•,•}},1]
Out[]=
In[]:=
state=Nest[SubsetReplace[#,p:{{x_,y_},{x_,z_}}:>Sequence[{x,z},{x,p},{y,p},{z,p}]]&,{{•,•},{•,•}},1];
In[]:=
WolframModelPlot[Map[v,state,{2}]]
Out[]=
In[]:=
WolframModelPlot[Map[v,object[-1],{2}]]
Out[]=
In[]:=
object["CausalGraph"]
Out[]=
In[]:=
SimpleGraph[Flatten[Reap[causalGraph[#]]&/@object[-1]],VertexLabelsv_(StandardForm[Column[v]])]
Out[]=
In[]:=
destroyedExpressions=Merge[Association/@Thread[object["DestroyerEvents"]object["AllExpressions"]],#&];
In[]:=
createdExpressions=Merge[Association/@Thread[object["CreatorEvents"]object["AllExpressions"]],#&];
In[]:=
destroyedExpressions
Out[]=
1{{•,•},{•,•}},∞{{•,•},{•,{{•,•},{•,•}}},{•,{{•,•},{•,•}}},{•,{{•,•},{•,•}}}}
In[]:=
createdExpressions
Out[]=
0{{•,•},{•,•}},1{{•,•},{•,{{•,•},{•,•}}},{•,{{•,•},{•,•}}},{•,{{•,•},{•,•}}}}
In[]:=
expressionDependencyGraph=Catenate[Catenate[Outer[#1#2&,Lookup[destroyedExpressions,#,{}],Lookup[createdExpressions,#,{}],1]]&/@Range[object["EventsCount"]]];
In[]:=
Graph[expressionDependencyGraph,DirectedEdgesTrue,VertexLabelsv_(StandardForm[Column[v]])]
Out[]=
In[]:=
SimpleGraph[Flatten[Reap[causalGraph[#]]&/@state]]
Out[]=