7
$\begingroup$

So I enter a (0,1) adjacency matrix and I get the following graph:

enter image description here

The diameter of this graph is 4. How can I ask that two vertices which realise this diameter be drawn with different filling colour, say a, and the edges on the path of length 4 between them be drawn with color b?

Improve this question
$\endgroup$
1
  • $\begingroup$ You may have multiple instances of pairs realising the max distance $\endgroup$
    – Dr. belisarius
    Commented Feb 18, 2015 at 18:19

2 Answers 2

Reset to default
10
$\begingroup$ 
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]}]

Mathematica graphics

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. Available Method options: {"Unweighted", "Dijkstra"}.

HighlightGraph[g, PathGraph@IGFindDiameter[g]]

Mathematica graphics

Improve this answer
$\endgroup$
7
  • $\begingroup$ If you have questions, comment on this answer. $\endgroup$
    – Szabolcs
    Commented Feb 18, 2015 at 18:24
  • $\begingroup$ I had another answer using GraphPeriphery, but it turns out this one is faster. $\endgroup$
    – 2012rcampion
    Commented Feb 18, 2015 at 18:31
  • $\begingroup$ Hm, looks like this one is actually much faster for dense graphs, but slower for sparse graphs. I'll go ahead and post mine then. $\endgroup$
    – 2012rcampion
    Commented Feb 18, 2015 at 18:36
  • $\begingroup$ Beautiful, thanks! $\endgroup$
    – the_fox
    Commented Feb 18, 2015 at 18:45
  • 1
    $\begingroup$ Yes, use Directive[Red,Thick]. Pretty much all of your regular graphics options apply (see the doc for Style). $\endgroup$
    – 2012rcampion
    Commented Feb 18, 2015 at 18:51
9
$\begingroup$

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]}]

enter image description here

Szabolcs solution is very slightly faster for dense graphs, and this solution is faster for sparse graphs.

Improve this answer
$\endgroup$
1
  • $\begingroup$ @the_fox My answer is not as clean/straightforward as Szabolcs anyway. I'd only suggest using mine if you run into performance issues on large graphs. $\endgroup$
    – 2012rcampion
    Commented Feb 18, 2015 at 19:04

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.