WOLFRAM NOTEBOOK

Hypergraph Geodesics

Source Code

User Policies

In[]:=
excludeUser[username_]:=Function[expr,If[$UserName=!=username,expr],HoldAll]
In[]:=
excludeStephen=excludeUser["sw"];

Dependencies

In[]:=
excludeStephen[​​<<SetReplace`;​​Quiet[ParallelEvaluate[<<SetReplace`],CloudConnect::clver]];

Geodesics Plotting

In[]:=
findShortestPath[edges_,endpoints:{{_,_}...}]:=FindShortestPath[Catenate[Partition[#,2,1,1]&/@edges],#,#2]&@@@endpoints
In[]:=
pathEdges[edges_,path_]:=Select[Count[Alternatives@@path]@#≥2&]@edges
In[]:=
plotGeodesic[edges_,endpoints:{{_,_}...},o:OptionsPattern[]]:=With[{vertexPaths=findShortestPath[edges,endpoints]},WolframModelPlot[edges,o,GraphHighlightCatenate[pathEdges[edges,#]~Join~#&/@vertexPaths]]]
In[]:=
plotGeodesic[edges_,endpoints:{__:Except@List},o:OptionsPattern[]]:=plotGeodesic[edges,{endpoints},o]
In[]:=
plotRandomGeodesic[edges_,o:OptionsPattern[]]:=With[{vertices=Union@Catenate@edges},plotGeodesic[edges,Table[RandomChoice@vertices,2],o]]

Examples

In[]:=
plotGeodesic[WolframModel[{{1,2,3},{4,2,5}}{{6,3,1},{3,6,4},{1,2,6}},Automatic,1000]@"FinalState",{{924,1000},{738,951},{874,948}},VertexSize0.12]
Out[]=
In[]:=
plotRandomGeodesic[WolframModel[{{1,2,3},{4,2,5}}{{6,3,1},{3,6,4},{1,2,6}},Automatic,1000]@"FinalState",VertexSize0.12]
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.