In[]:=
PacletInstall["https://wolfr.am/Hypergraph.paclet",ForceVersionInstall->True]
Out[]=
PacletObject
In[]:=
<<WolframInstitute`Hypergraph`
In[]:=
RandomSmallHypergraph[size_]:=RandomHypergraph[RandomInteger[{2*size,3*size}],{{RandomInteger[{size,2*size}],2},{RandomInteger[{1,size}],3},{RandomInteger[{0,IntegerPart[size/2]}],4}},"Simple"->True,"Connected"->True]
In[]:=
RandomSmallHypergraph[3]
Out[]=
In[]:=
Table[SeedRandom[2424+i];RandomSmallHypergraph[3],{i,10}]
Out[]=
,
,
,
,
,
,
,
,
,
In[]:=
HypergraphEmbedding
Out[]=
{{0.98741,1.42926},{0.715661,0.157079},{1.94912,0.785323},{3.22133,0.357307},{0.,0.868247},{2.81859,0.979654},{2.02915,1.6772}}
In[]:=
EdgePlaces[hg_]:=Block[{g=hg,emb,newVertices,newEdges,midPoints},emb=Thread[VertexList[g]->HypergraphEmbedding[g]];newVertices=e.@@@EdgeList[g];midPoints=Mean/@TakeList[Lookup[emb,Catenate[EdgeList[g]]],Length/@EdgeList[g]];Hypergraph[Join[VertexList[g],newVertices],EdgeList[g],VertexCoordinates->Join[emb,Thread[newVertices->midPoints]],VertexStyle->Thread[newVertices->Black]]]
In[]:=
GetVertexStyles[hg_]:=Association[Options[hg]][VertexStyle]
In[]:=
EmptyHypergraph[hg_]:=Hypergraph[VertexList[hg],{},VertexCoordinates->(Thread[VertexList[hg]->HypergraphEmbedding[hg]]),VertexStyle->GetVertexStyles[hg]]
In[]:=
NeighborhoodEdge[hg_,vtx_]:=With[{placesgraph=EdgePlaces[hg]},With[{newvertices=Select[VertexList@placesgraph,ResourceFunction["ContainsQ"][e.]]},EdgeAdd[placesgraph,Prepend[Select[newvertices,ResourceFunction["ContainsQ"][vtx]],vtx],EdgeStyle->{Prepend[Select[newvertices,ResourceFunction["ContainsQ"][vtx]],vtx]->Red}]]]
In[]:=
NeighborhoodsGraph[hg_]:=With[{placesgraph=EdgePlaces[hg]},With[{newvertices=Select[VertexList@placesgraph,ResourceFunction["ContainsQ"][e.]]},EdgeAdd[EmptyHypergraph[placesgraph],Table[Prepend[Select[newvertices,ResourceFunction["ContainsQ"][vtx]],vtx],{vtx,1,VertexCount[hg]}],EdgeStyle->(Thread[Table[Prepend[Select[newvertices,ResourceFunction["ContainsQ"][vtx]],vtx],{vtx,1,VertexCount[hg]}]->Red])]]]
In[]:=
EdgeList
Out[]=
{{1,7},{5,1},{3,6},{6,3,7},{6,4,3},{1,5,2,3}}
In[]:=
VertexList
Out[]=
{1,2,3,4,5,6,7}
In[]:=
InputForm
Out[]//InputForm=
Hypergraph[{1, 2, 3, 4, 5, 6, 7}, Hyperedges[{1, 7}, {5, 1}, {3, 6}, {6, 3, 7}, {6, 4,
3}, {1, 5, 2, 3}], Simple -> True, Connected -> True]
3}, {1, 5, 2, 3}], Simple -> True, Connected -> True]
In[]:=
{#,NeighborhoodsGraph[#]}&[Hypergraph[{1,2,3,4,5,6,7},Hyperedges[{1,7},{5,1},{3,6},{6,3,7},{6,4,3},{1,5,2,3}],"Simple"->True,"Connected"->True]]
Out[]=
,
In[]:=
{#,NeighborhoodsGraph[#]}&
Out[]=
,
In[]:=
InputForm
Out[]//InputForm=
Hypergraph[{1, 2, 3, 4, 5, 6, 7}, Hyperedges[{1, 7}, {5, 1}, {3, 6}, {6, 3, 7}, {6, 4,
3}, {1, 5, 2, 3}], Simple -> True, Connected -> True]
3}, {1, 5, 2, 3}], Simple -> True, Connected -> True]
In[]:=
GridGraph[{4,4}]
Out[]=