Unordered Hypergraphs

Max Piskunov : 9a28d3dec6dc8d0699ef9a16a2145b5ae79faf3d

Documents [aka Source Code]

Dependencies

In[]:=
getResourceFunction[filename_]:=NotebookEvaluate[FileNameJoin[filename],EvaluationElements"InitializationCell"]
In[]:=
If[$UserName==="sw","NO!",getResourceFunction[FileNameJoin[{$Dropbox,"Physics/CodeDevelopment/FunctionRepositorySources",#<>".nb"}]]&/@{"ParallelMapMonitored","EnumerateHypergraphs","EnumerateWolframModelRules"}];

Data

In[]:=
allUnorderedHypergraphEvolutionsPlots[{{1,3}}{{3,3}},5]=Import[FileNameJoin[{$Dropbox,"Physics/Data/2020/UnorderedHypergraphs-01/allUnorderedHypergraphEvolutionsPlots-13-33-5.wxf"}]];

Utilities

In[]:=
allSignatureInstances[enumerate_,canonicalize_][signature_]:=Union[ParallelMapMonitored[canonicalize,enumerate[signature],"Label""signature instances enumeration"]]
In[]:=
canonicalizeVertexNames[sort_][edges_]:=With[{vertices=vertexList@edges},First@MinimalBy[sort[edges/.Thread[vertices#]]&/@Permutations@vertices,#&,1]]

Enumeration of Hypergraphs

In[]:=
vertexList[edges_List]:=Union@Catenate@edges
In[]:=
canonicalUnorderedHypergraph=canonicalizeVertexNames[Sort[Sort/@#]&];
In[]:=
allUnorderedHypergraphs=allSignatureInstances[EnumerateHypergraphs[#,"Monitored""ordered hypergraphs enumeration"]&,canonicalUnorderedHypergraph];
In[]:=
allUnorderedHypergraphs=allSignatureInstances[EnumerateHypergraphs[#]&,canonicalUnorderedHypergraph];

Enumeration of Rules

In[]:=
vertexList[in_out_]:=Union@Catenate[vertexList/@{in,out}]
In[]:=
canonicalUnorderedHypergraphRule=canonicalizeVertexNames[Sort/@Map[Sort,#,{2}]&];
In[]:=
allUnorderedHypergraphRules=allSignatureInstances[EnumerateWolframModelRules[#,"Monitored""ordered rules enumeration"]&,canonicalUnorderedHypergraphRule];
In[]:=
allUnorderedHypergraphRules=allSignatureInstances[EnumerateWolframModelRules[#]&,canonicalUnorderedHypergraphRule];

Translation

In[]:=
unorderedToOrderedHypergraph[edges_]:=Catenate@MapIndexed[Thread[{e[#2〚1〛],#}]&,edges]
In[]:=
unorderedToOrderedHypergraphRule[rule_]:=unorderedToOrderedHypergraph/@rule
In[]:=
orderedToUnorderedHypergraph[edges_]:=With[{graph=Graph[DirectedEdge@@@edges]},Function[edgeVertex,SelectFirst[#=!=edgeVertex&]/@List@@@IncidenceList[graph,edgeVertex]]/@VertexList[graph]〚First/@Position[VertexInDegree[graph],0]〛]

Plotting

In[]:=
$hyperedgePattern={_,_,_..};
In[]:=
unorderedHypergraphPlot[edges_,opts:OptionsPattern[]]:=WolframModelPlotedges,opts,"ArrowheadLength"0,EdgeStyle<|$hyperedgePatternTransparent|>,"EdgePolygonStyle"<|$hyperedgePatternDirective
,Opacity[0.1],EdgeFormDirective
,Opacity[0.7]|>

Exploration

In[]:=
initialUnorderedHypergraphSelfLoop[rule_]:=unorderedToOrderedHypergraph@WolframModel[rule,Automatic]@0
In[]:=
allUnorderedHypergraphEvolutionsPlots[signature_,steps_]:=ParallelMapMonitored[Function[rule,Labeled[unorderedHypergraphPlot@orderedToUnorderedHypergraph@(WolframModel[#,initialUnorderedHypergraphSelfLoop@rule,steps,"FinalState"]&)@unorderedToOrderedHypergraphRule@rule,rule]],allUnorderedHypergraphRules@signature,"Label""evolution & plotting"]
In[]:=
unorderedHypergraphEvolutionStatesPlots[rule_,steps_]:=unorderedHypergraphPlot/@orderedToUnorderedHypergraph/@WolframModel[unorderedToOrderedHypergraphRule[rule],initialUnorderedHypergraphSelfLoop@rule,steps,"StatesList"]
In[]:=
labelToTooltippedIcon[Labeled[plot_,label_]]:=Tooltip[Show[plot,ImageSizeTiny],label]