WOLFRAM NOTEBOOK

Event highlighting (prototype)

In[]:=
<<SetReplace`
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]]]]&,{stateIndices,Append[events〚All,1〛,{}],Prepend[events〚All,2〛,{}]}];​​TakeList[pictures,Prepend[Length/@Split[evolution["EventGenerations"]],1]]​​]
Code with new property names. Does not work yet:
(*highlightUpdatesevolution_,destroyedStyle_:Directive
,Dotted,createdStyle_:Directive
,Thick:=Module[{createdEdges,destroyedEdges,events,stateIndices,pictures},​​{createdEdges,destroyedEdges}=PositionIndex[evolution[#]]&/@{"EdgeCreatorEventIndices","EdgeDestroyerEventIndices"};​​events=Rule@@Table[Lookup[expr,#,{}],{expr,{destroyedEdges,createdEdges}}]&/@Range[evolution["AllEventsCount"]];​​stateIndices=FoldList[Join[DeleteCases[#,Alternatives@@#2〚1〛],#2〚2〛]&,Range[Length[evolution[0]]],events];​​pictures=MapThread[HypergraphPlot[evolution["AllEventsEdgesList"]〚#〛,EdgeStyleReplacePart[Table[Automatic,Length[#]],Join[Thread[Position[#,Alternatives@@#2]〚All,1〛destroyedStyle],Thread[Position[#,Alternatives@@#3]〚All,1〛createdStyle]]]]&,{stateIndices,Append[events〚All,1〛,{}],Prepend[events〚All,2〛,{}]}];​​TakeList[pictures,Prepend[Length/@Split[evolution["AllEventsGenerationsList"]],1]]​​]*)
In[]:=
highlightUpdates[WolframModel[{{x,y},{x,z}}{{x,z},{x,w},{y,w},{z,w}},{{0,0},{0,0}},5]]
Out[]=
In[]:=
highlightUpdates[WolframModel[{{1,2}}{{1,3},{3,2}},{{0,0}},4]]
Out[]=
Wolfram Cloud

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 »

You are using a browser not supported by the Wolfram Cloud. Supported browsers include recent versions of Chrome, Edge, Firefox and Safari.