Drawing a path which realises the diameter of the graph
g = ExampleData[{"NetworkGraph", "ZacharyKarateClub"}]
dm = GraphDistanceMatrix[g];
Position[dm, Max[dm]]
(* {{15, 20}, {15, 24}, {15, 25}, {15, 29}, {15, 30}, {15,
31}, {15, 32}, {15, 33}, {20, 15}, {24, 15}, {25, 15}, {29,
15}, {30, 15}, {31, 15}, {32, 15}, {33, 15}} *)
pair = VertexList[g][[#]] & /@ First[%]
(* {17, 24} *)
path = FindShortestPath[g, Sequence @@ pair]
(* {17, 6, 1, 3, 28, 24} *)
HighlightGraph[g, {Style[pair, Yellow],
Style[UndirectedEdge @@@ Partition[path, 2, 1], Red]}]
The IGraph/M package has a fast function for this that avoids keeping the entire distance matrix in memory. I recommend it for large graphs.
<< IGraphM`
IGraph/M 0.3.91 (May 5, 2017)
Evaluate IGDocumentation[] to get started.
?IGFindDiameter
IGFindDiameter[graph]
returns a longest shortest path in graph, i.e. a shortest path with length equal to the graph diameter. AvailableMethod
options:{"Unweighted", "Dijkstra"}
.
HighlightGraph[g, PathGraph@IGFindDiameter[g]]
Assuming your graph is g
:
p = GraphPeriphery[g];
s = First[p];
d = GraphDiameter[g];
t = First@Select[Rest[p], GraphDistance[g, s, #] == d &, 1]
The vertices returned by GraphPeriphery
will be maximally distant from at least one other vertex in the graph (and that vertex will also be in GraphPeriphery
). Select one at random (the First
one works fine) and compare its distance with each other vertex in p
to the diameter, stopping at the first one. From here you can style exactly like Szabolcs did, except replace pair
with {s, t}
. Something like this:
HighlightGraph[g, {Style[PathGraph@FindShortestPath[g, s, t], Green],
Style[{s, t}, Red]}]
Szabolcs solution is very slightly faster for dense graphs, and this solution is faster for sparse graphs.