Event highlighting (prototype)
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[]=