10
$\begingroup$

I am trying to learn how in an efficient way can one find the diameter of a random graph, that is, the longest shortest path, and its corresponding end-nodes.

The direct built-in function GraphDiameter seems to work normally and quite rapidly for small systems. What I do is as follows: generate a random ER graph with n nodes and edge probability p, check that it is connected, if yes find the diameter of the graph.

n = 10;
p = 0.5;
gtest = RandomGraph[BernoulliGraphDistribution[n, p]]
If[ConnectedGraphQ[gtest] == True, d = GraphDiameter[gtest]; 
 Print[d];]

For such parameter it works quite rapidly and usually returns diameters of around $3,$ though it doesn't return the end-nodes this distance corresponds to.

But for much larger graphs, namely $n=10^4,$ and still $p=0.5,$ even in cases the graph is indeed connected, GraphDiameter simply returns $Aborted[]. Which I assume means the search was taking too long and the kernel aborted it.

In the light of this, my questions are:

  • What is happening when the abort message is being returned?
  • Is there a way to efficiently obtain the graph diameter even for such large graphs within Mathematica? Or is the built-in GraphDiameter function known to be the most efficient option within Mathematica?
  • Is asking for the end-nodes corresponding to the found diameter an additional overhead in terms of computation or it can easily be retrieved if a finite diameter has been found?

Any feedback on these types of computations on graphs would be much appreciated.

$\endgroup$
  • $\begingroup$ Relevant: cs.stackexchange.com/a/200 $\endgroup$ – Henrik Schumacher Jul 31 at 12:35
  • $\begingroup$ Would GraphPeriphery help? $\endgroup$ – Chip Hurst Jul 31 at 14:05
  • $\begingroup$ @ChipHurst Good suggestion, GraphPeriphery lists all such vertices, it doesn't indicate which two vertices are maximally distant, unless there are only 2 such vertices, i.e. the diameter corresponds to a unique $(i,j)$ tuple. $\endgroup$ – user929304 Jul 31 at 15:40
  • $\begingroup$ Can you please check if the computation finishes with IGraph/M? I do not get $Aborted[] with GraphDiameter either. Maybe you run out of memory? $\endgroup$ – Szabolcs Aug 1 at 6:50
  • $\begingroup$ @Szabolcs I just checked it, for n=10000 and p=0.2, IGDiameter did finish and correctly found a diameter of $2$ taking $543$ sec (absolute timing). For the same graph the suggested solution of user halmir takes $144$ sec and only $0.7$ sec when Aggressive is set to False, both yielding same result of $2.$ $\endgroup$ – user929304 Aug 1 at 9:32
11
$\begingroup$

For large graphs, "PseudoDiameter" method could help:

g = RandomGraph[BernoulliGraphDistribution[10000, 0.5]];

GraphDiameter[gtest, 
  Method -> "PseudoDiameter"] // AbsoluteTiming

{181.635, 2}

GraphDiameter[gtest, 
  Method -> {"PseudoDiameter", 
    "Aggressive" -> False}] // AbsoluteTiming

{1.42781, 2}

PseudoDiameter finds an approximate graph diameter. It works by starting from a vertex u, and finds a vertex v that is farthest away from u. This process is repeated by treating v as the new starting vertex, and ends when the graph distance no longer increases. A vertex from the last level set that has the smallest degree is chosen as the final starting vertex u, and a traversal is done to see if the graph distance can be increased. This graph distance is taken to be the pseudo-diameter.

“Aggressive” -> True or False — whether to make extra effort in finding the optimal graph diameter

To find path, GraphPeriphery could be used:

GraphPeriphery[g, 
  Method -> {"PseudoDiameter", 
    "Aggressive" -> False}] // AbsoluteTiming

{1.23822, {2615, 181}}

FindShortestPath[g, Sequence @@ %[[2]]]

{2615, 18, 181}

$\endgroup$
  • $\begingroup$ Thanks for sharing this option and suboption! It would be quite useful to have this documented ... $\endgroup$ – Szabolcs Jul 31 at 19:06
  • 5
    $\begingroup$ @Szabolcs indeed it's documented under PseudoDiameter (GraphUtilities) which is obsolete now. $\endgroup$ – halmir Jul 31 at 19:18
  • 1
    $\begingroup$ Nice, then we can even see the source code (at least for the GraphUtilities version). Before I read your message, I tried to reimplement this method, and ran into an issue where VertexDegree is surprisingly slow for large graphs, and has worse than expected complexity (cubic in the number of vertices for graphs of constant density). Just letting you know. Already reported to support. $\endgroup$ – Szabolcs Jul 31 at 19:34
  • $\begingroup$ Thanks halmir for this nice answer, the pseudo option had skipped me! I tested it for a graph with n=10000 and p=0.2, it took $144$ seconds to find the diameter, and only $0.7$ seconds when Aggressive was set to False, both found same diameter. The speedup without Aggressive is quite impressive! $\endgroup$ – user929304 Aug 1 at 9:36
9
$\begingroup$

Basically a brute-force approach and thus probably not more efficient than GraphDiameter, but a way to obtain also a path that realizes the diameter:

n = 100;
p = 0.05;
g = RandomGraph[BernoulliGraphDistribution[n, p]];
A = GraphDistanceMatrix[g];
maxdistpairs = Position[UpperTriangularize[A, 1], Max[A]];
maxpath = FindShortestPath[g, ##] & @@ maxdistpairs[[1]];

HighlightGraph[g, UndirectedEdge @@@ Partition[maxpath, 2, 1]]

enter image description here

If the graph is disconnected, the empty list {} is returned as maxpath.

Edit

This is just a heuristic but it tends to deliver surprisingly good results. It is based on the intuition that the minimum and the maximum of the first eigenvector of the graph Lapacian tend to be be well separated. So this method computes the first eigenvector v and extracts its minimum and maximum

Generating a large connected graph:

g = RandomGraph[{10000, 14000}];
comp = ConnectedComponents[g];
g = IndexGraph@Subgraph[g, comp[[Ordering[Length /@ comp, -1][[1]]]]];

Solving the eigenvalue problem and extracting maximum i and maximum j:

A = With[{a = SparseArray[{N@VertexDegree[g]}]},
   ArrayFlatten[{
     {N@KirchhoffMatrix[g], a\[Transpose]},
     {a, 0.}
     }
    ]
   ];
{\[Lambda], u} = Eigensystem[A, -1, Method -> "Arnoldi"];
v = Most[u[[1]]];
i = Ordering[v, -1][[1]];
j = Ordering[v, 1][[1]];
path = FindShortestPath[g, i, j];
estimateddiameter = Length[path] - 1
truediameter = Max[GraphDistanceMatrix[g]]

I have not theorem however that could certify the quality of this approximate diameter.

Maybe you find something useful in this script by Fan Chung. At least upper bounds for the diameter in terms of eigenvalues can be found there; these could be used to assess the quality of the approximation a posteriorily.

$\endgroup$
  • $\begingroup$ Thanks Henrik! This indeed solves the problem of how to retrieve the corresponding node indices. However, for large node numbers, the search for graph diameter seems to be quite a demanding computational task. Therefore, I figured maybe we can find an approximate workaround, e.g.: instead of finding the actual diameter, could we efficiently find a tuple of nodes $(i,j)$ whose graph distance is at least greater or equal to $d?$ where we can set parameter $d$ to an integer near the expected length of longest path (e.g. $\ln(n)$). $\endgroup$ – user929304 Jul 31 at 16:08
  • $\begingroup$ What a neat idea, still haven't figured out why it works but I love it! :) I just tested it for a graph of n=10000 nodes and it took about $10$ seconds and returned a diameter of $6$ (real diameter was $7$), so quite a good approximation! To compare the timings, the solution of user halmir took $0.01$ sec and $0.004$ sec when Aggressive was set to False (both yielded diameter $7$). I reckon the main overhead in your approach lies in VertexDegree which I also have noticed is quite slow, e.g. when trying to compute the degree dist: Histogram[VertexDegree[g], {1}, "Probability"]. $\endgroup$ – user929304 Aug 1 at 9:43
7
$\begingroup$

IGraph/M has IGDiameter for computing the diameter and IGFindDiameter for finding a longest shortest path, including the endpoints.

Diameter computation is approximately cubic in the number of vertices. Based on a quick fit, I expect a 300 second (5 minute) running time for a RandomGraph[BernoulliGraphDistribution[10000, 0.5]]. Now you know how long you need to wait—so try it!

Example:

g = RandomGraph[BernoulliGraphDistribution[1000, 0.5]];

IGDiameter[g] // Timing
(* {0.355301, 2} *)

IGFindDiameter[g] // Timing
(* {0.332708, {1, 4, 2}} *)
$\endgroup$
  • $\begingroup$ By the way thanks for pointing out in the other discussions that VertexDegree is quite slow. Do you happen to know of alternative more efficient ways of computing the degree sequence/distribution (using IGraph/M possibly)? $\endgroup$ – user929304 Aug 1 at 16:02
  • $\begingroup$ @user929304 Assuming that the graph is simple, Total@AdjacencyMatrix[g]. $\endgroup$ – Szabolcs Aug 1 at 17:43

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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