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
<|"Created"XXXX,"Destroyed"XXXX,"CreatedDestroyed"XXXX|>
In[]:=
HighlightUpdates[wm_]:=TakeList[MapThread[HypergraphPlot[#,GraphHighlight#2,VertexLabelsAutomatic,ImageSizeTiny]&,{wm["UpdatedStatesList"],Prepend[HighlightedEdges[wm],{}]}],Prepend[Length/@Split[wm["EventGenerations"]],1]]
In[]:=
HighlightedEdges[wmeo_]:=wmeo["AllExpressions"][[First/@Position[wmeo["CreatorEvents"],#]]]&/@Range[wmeo["EventsCount"]]
In[]:=
wm=WolframModel[{{x,y},{x,z}}{{x,z},{x,w},{y,w},{z,w}},{{0,0},{0,0}},4]
Out[]=
In[]:=
HighlightUpdates[wm]
Out[]=
[[[[[[ What is this ??? ]]]]]
In[]:=
highlightUpdatesevolution_,destroyedStyle_:Directive,Dotted,createdStyle_:Directive,Thick:=Module[{createdExpressions,destroyedExpressions,events,stateIndices,pictures},{createdExpressions,destroyedExpressions}=PositionIndex[evolution[#]]&/@{"CreatorEvents","DestroyerEvents"};events=Rule@@Table[Lookup[expr,#,{}],{expr,{destroyedExpressions,createdExpressions}}]&/@Range[evolution["EventsCount"]];stateIndices=FoldList[Join[DeleteCases[#,Alternatives@@#2〚1〛],#2〚2〛]&,Range[Length[evolution[0]]],events];pictures=MapThread[HypergraphPlot[evolution["AllExpressions"]〚#〛,EdgeStyleReplacePart[Table[Automatic,Length[#]],Join[Thread[Position[#,Alternatives@@#2]〚All,1〛destroyedStyle],Thread[Position[#,Alternatives@@#3]〚All,1〛createdStyle]]],ImageSizeTiny]&,{stateIndices,Append[events〚All,1〛,{}],Prepend[events〚All,2〛,{}]}];TakeList[pictures,Prepend[Length/@Split[evolution["EventGenerations"]],1]]]
In[]:=
highlightUpdates[wm]
Out[]=