In[]:=
AllGeodesics[g_]:=Module[{m=GraphDistanceMatrix[g],v=VertexList[g]},Map[v[[#]]&,Position[m,Max[m]],{2}]]
In[]:=
GraphLineDistance[g_,start_,line_]:=Min[GraphDistance[g,start,#]&/@line]
In[]:=
FindShortestPathThoughVertex[graph_,v1_,c_,v2_]:=With[{paths=FindShortestPath[graph,##]&@@@{{v1,c},{c,v2},{v1,v2}}},If[Length[paths〚1〛]+Length[paths〚2〛]-1Length[paths〚3〛],Join[paths〚1〛,Rest[paths〚2〛]],Missing["Nonexistent"]]]
In[]:=
RankedGeodesics[g_,r_]:=Module[{gg=NeighborhoodGraph[g,First@GraphCenter[g],r],o,a},o=FindShortestPath[gg,#1,#2]&@@GraphAntipodes[gg];Sort[(Total[GraphLineDistance[gg,#,o]&/@#]HighlightGraph[gg,Graph[Subgraph[gg,FindShortestPath[gg,#1,#2]&@@#]],ImageSizeTiny])&/@DeleteDuplicates[Sort/@AllGeodesics[gg]]]]
In[]:=
RankedGeodesics[g_,r_,{p1_,center_,p2_},opts___]:=Module[{gg=NeighborhoodGraph[g,center,r],o,a},o=FindShortestPathThoughVertex[gg,p1,center,p2];Sort[(Total[GraphLineDistance[gg,#,o]&/@#]{#,HighlightGraph[gg,Style[Graph[Subgraph[gg,FindShortestPathThoughVertex[gg,#1,center,#2]&@@#]],Directive[Thick,Red]],opts,ImageSizeTiny]})&/@DeleteDuplicates[Sort/@AllGeodesics[gg]]]]
In[]:=
RankedGeodesics[g_,r_,opts___]:=With[{center=First@GraphCenter[g]},RankedGeodesics[g,r,{#1,center,#2},opts]&@@GraphAntipodes[NeighborhoodGraph[g,center,r]]]
In[]:=
RankedGeodesics[GridGraph[{10,10}],4]
Out[]=
In[]:=
RankedGeodesics[GridGraph[{10,10}],4]
Out[]=
In[]:=
rg3d=RankedGeodesics[GridGraph[{10,10,10}],4];
In[]:=
First[#]Graph3D[Last[#],ImageSize200]&/@Take[rg3d,3]
Out[]=
In[]:=
First[#]Graph3D[Last[#],ImageSize200]&/@Take[rg3d,-6]
Out[]=