6
$\begingroup$

Consider the graph:

graph = {1 <-> 2, 1 <-> 4, 1 <-> 5, 1 <-> 8, 1 <-> 10, 1 <-> 26, 1 <-> 37, 1 <-> 42, 1 <-> 62, 1 <-> 86, 1 <-> 93, 1 <-> 100, 2 <-> 3, 2 <-> 7, 2 <-> 9, 2 <-> 12, 2 <-> 14, 2 <-> 17, 2 <-> 18, 2 <-> 25, 2 <-> 36, 2 <-> 41, 2 <-> 46, 2 <-> 50, 2 <-> 55, 2 <-> 72, 2 <-> 75, 3 <-> 6, 3 <-> 28, 3 <-> 34, 3 <-> 63, 4 <-> 13, 4 <-> 21, 5 <-> 20, 5 <-> 35, 5 <-> 40, 5 <-> 45, 5 <-> 48, 5 <-> 74, 6 <-> 31, 6 <-> 70, 9 <-> 11, 9 <-> 54, 9 <-> 67, 11 <-> 16, 11 <-> 24, 11 <-> 58, 11 <-> 60, 11 <-> 61, 11 <-> 65, 11 <-> 69, 12 <-> 27, 13 <-> 15, 13 <-> 33, 13 <-> 76, 14 <-> 30, 15 <-> 19, 15 <-> 96, 15 <-> 98, 16 <-> 57, 16 <-> 90, 19 <-> 22, 19 <-> 23, 19 <-> 39, 19 <-> 80, 19 <-> 83, 21 <-> 38, 22 <-> 59, 22 <-> 82, 25 <-> 29, 25 <-> 56, 25 <-> 94, 26 <-> 32, 26 <-> 43, 26 <-> 71, 27 <-> 47, 30 <-> 77, 30 <-> 78, 33 <-> 79, 33 <-> 97, 39 <-> 49, 39 <-> 51, 40 <-> 44, 40 <-> 73, 42 <-> 68, 48 <-> 52, 48 <-> 81, 50 <-> 53, 50 <-> 64, 50 <-> 89, 56 <-> 66, 56 <-> 92, 59 <-> 91, 62 <-> 88, 67 <-> 87, 74 <-> 95, 82 <-> 84, 82 <-> 85, 82 <-> 99};

net = Graph[graph, VertexShapeFunction -> "Name"]

Let's choose any node 'g' in the graph:

g=19;

Let 'r' denote the distance (counted in the number of nodes) from the node 'g':

d = GraphDiameter[net]
r = Range[1, d]

How to count all neighboring nodes within radius 'r' from the node 'g' ?

For example for node g=19 we have 6 nodes for r=1 (nodes: 80,83,22,39,23,15). For r=2 we have 7 nodes: 59,82,49,51,98,96,13.

Improve this question
$\endgroup$

4 Answers 4

Reset to default
3
$\begingroup$

How to count all neighboring nodes within radius 'r' from the node 'g' ?

Use IGraph/M.

IGNeighborhoodSize does precisely this and is probably your fastest bet, but I do not have time to benchmark it against other solutions right now.

If you want to do it for multiple distances in one go, use IGDistanceCounts,

IGDistanceCounts[graph, {vertex}]

This gives you the counts of other vertices found at all (unweighted) distances. You can then simply Accumulate that list to get the result for all r at the same time.

For weighted distances, use IGDistanceHistogram.

Improve this answer
$\endgroup$
10
  • $\begingroup$ Thanks. And how to count the same as the 'IGDistanceCounts[graph, {vertex}]' formula but for weighted networks? $\endgroup$
    – ralph
    Commented Apr 4, 2019 at 14:15
  • $\begingroup$ @ralph As I said above, use IGDistanceHistogram $\endgroup$
    – Szabolcs
    Commented Apr 4, 2019 at 16:01
  • $\begingroup$ Mr=IGDistanceHistogram[net1, ??] (*for weighted graph *) ??? $\endgroup$
    – ralph
    Commented Apr 5, 2019 at 6:19
  • $\begingroup$ @ralph Did you check the documentation? If you checked the documentation and you found it to be unclear, you are very welcome to suggest improvements. $\endgroup$
    – Szabolcs
    Commented Apr 5, 2019 at 7:16
  • 1
    $\begingroup$ You did not answer my question ... $\endgroup$
    – Szabolcs
    Commented Apr 5, 2019 at 9:49
7
$\begingroup$

I will choose a bit better GraphLayout for a tree: 

net = Graph[graph, VertexLabels -> "Name", GraphLayout -> "RadialEmbedding"];

I suggest don't just count directly - get an object - a subgraph - of your query, so you can then run various computations on it and don't need count all over again based on different criteria w/ a different code. 

nei[v_, d_] := NeighborhoodGraph[net, v, d]

Take distance 1:

nei[19, 1]

enter image description here

and see it is right:

HighlightGraph[net, nei[19, 1]]

enter image description here

Now you can compute whatever you need:

VertexList[nei[19, 1]]
Length[%] - 1

{19, 15, 22, 23, 39, 80, 83}

6

For the distance 2:

VertexList[nei[19, 1]]
VertexList[nei[19, 2]]
Complement[%, %%]
Length[%]

{19, 15, 22, 23, 39, 80, 83}

{19, 13, 15, 22, 23, 39, 49, 51, 59, 80, 82, 83, 96, 98}

{13, 49, 51, 59, 82, 96, 98}

7

Timings for large graphs

net = RandomGraph[BarabasiAlbertGraphDistribution[20000, 1]];

nei[v_, d_] := NeighborhoodGraph[net, v, d]

dist15:=Length[Complement[VertexList[nei[#,15]],VertexList[nei[#,14]]]&@RandomInteger[1000]]

Table[AbsoluteTiming[dist15;][[1]], 5]

{0.097359, 0.094737, 0.092589, 0.08872, 0.087478}

Improve this answer
$\endgroup$
7
  • $\begingroup$ Thank you. The code gives correct results but is memory-consuming for large networks (around 200,000 nodes: net = RandomGraph [BarabasiAlbertGraphDistribution [20,000, 1] and d = {1,2,3,4, ..., 15}). $\endgroup$
    – ralph
    Commented Apr 4, 2019 at 12:24
  • $\begingroup$ @ralph is 0.1 seconds is slow? What timings do you need? No criteria for timings is mentioned in your original post. $\endgroup$
    – Vitaliy Kaurov
    Commented Apr 4, 2019 at 12:41
  • $\begingroup$ Please forgive me. I meant about 200,000 no 20,000 nodes. $\endgroup$
    – ralph
    Commented Apr 4, 2019 at 12:57
  • $\begingroup$ @Szabolcs i was just answering question without performance consideration as it was not asked in the OP, which had a tiny graph. I added benchmark after he made a comment, and then he changed his comment again. $\endgroup$
    – Vitaliy Kaurov
    Commented Apr 4, 2019 at 13:51
  • 1
    $\begingroup$ @VitaliyKaurov Sorry about the comments, I was wrong: this was actually fixed in 12.0. That is why I deleted them. $\endgroup$
    – Szabolcs
    Commented Apr 4, 2019 at 16:01
5
$\begingroup$

You could build it using BreadthFirstScan:

net = RandomGraph[BarabasiAlbertGraphDistribution[200000, 1]];

distance = 
  GroupBy[Reap[
     BreadthFirstScan[net, 
      19, {"DiscoverVertex" -> (Sow[#3 -> #1] &)}]][[2, 1]], 
   First -> Last, Association[{"length" -> Length[#], "set" -> #}] &];

Get length:

distance[3, "length"]

1194

distance[[All, "length"]]

<|0 -> 1, 1 -> 214, 2 -> 1194, 3 -> 3058, 4 -> 5826, 5 -> 10069, 6 -> 15110, 7 -> 19992, 8 -> 23821, 9 -> 24910, 10 -> 24767, 11 -> 21459, 12 -> 17869, 13 -> 13525, 14 -> 9119, 15 -> 5146, 16 -> 2406, 17 -> 1025, 18 -> 337, 19 -> 106, 20 -> 34, 21 -> 11, 22 -> 1|>

and set distance[21, "set"]

{182224, 145742, 171910, 124658, 125540, 128520, 196392, 166986, 159530, 196846, 144772}

For weighted graphs:

SeedRandom[123];net2 = Graph[net, EdgeWeight -> RandomInteger[{1, 20}, EdgeCount[net]]];

edgeWeight[g_, x_, y_] := 
   With[{weight = PropertyValue[{g, UndirectedEdge[x, y]},EdgeWeight]},
       If[NumericQ[weight], weight, 0]]

Clear[dist]; dist[_] := 0;
weights = 
  Reap[BreadthFirstScan[net2, 
     9, {"DiscoverVertex" -> ((dist[#1] = 
           dist[#2] + edgeWeight[net2, #1, #2]; 
          Sow[#1 -> dist[#1]]) &)}]][[2, 1]];

set = Select[weights, #[[2]] <= 5 &];

set[[;; 10]]

{9 -> 0, 66 -> 4, 126 -> 5, 160 -> 5, 190 -> 3, 274 -> 3, 283 -> 4,
312 -> 4, 519 -> 5, 537 -> 4}

set // Length

105

Note that BreadthFirstScan approach might not work in general (non tree graphs).

Improve this answer
$\endgroup$
12
  • 1
    $\begingroup$ Amazingly fast, halmir! Any idea why this solution is so much faster than GraphDistance, which I would have thought works by BreadthFirstScan internally? $\endgroup$
    – Roman
    Commented Apr 4, 2019 at 16:05
  • 1
    $\begingroup$ @Roman I had the conviction that GraphDistance compute the entire GraphDistanceMatrix even if you gave it only one vertex. I do not remember what led me to this conclusion though. I do remember that I put a lot of effort into this functionality area in IGraph/M as I could not use M's built-ins for large graphs. $\endgroup$
    – Szabolcs
    Commented Apr 4, 2019 at 16:14
  • $\begingroup$ @Roman A qucik test tells me that on a tree (which is being benchmarked here) the complexity of GraphDistance is quadratic in the graph size even when given just one vertex. That should not be so. $\endgroup$
    – Szabolcs
    Commented Apr 4, 2019 at 16:17
  • 1
    $\begingroup$ @halmir Can you tell us whether this is a bug and if it is fixable? The quadratic complexity looks like a bug. $\endgroup$
    – Szabolcs
    Commented Apr 4, 2019 at 16:20
  • $\begingroup$ @Roman I strongly suspect that I may have reported this issue to Wolfram in the past. See e.g. this post I wrote 3 years ago, where I mention it: mathematica.stackexchange.com/a/109408/12 $\endgroup$
    – Szabolcs
    Commented Apr 4, 2019 at 16:30
3
$\begingroup$

To count how many nodes there are at every distance (unsorted Association): use this if you want to Lookup a particular distance:

Counts@GraphDistance[net, g]

<|4 -> 4, 5 -> 12, 3 -> 7, 6 -> 26, 7 -> 20, 2 -> 7, 8 -> 15, 1 -> 6, 0 -> 1, 9 -> 2|>

Look them all up in order:

BinCounts[GraphDistance[net, g], {0, d, 1}]

{1, 6, 7, 7, 4, 12, 26, 20, 15, 2, 0, 0}

Improve this answer
$\endgroup$
2
  • $\begingroup$ Thank you. The code gives correct results but is memory-consuming for large networks (around 200,000 nodes: net = RandomGraph [BarabasiAlbertGraphDistribution [20,000, 1] and d = {1,2,3,4, ..., 15}) $\endgroup$
    – ralph
    Commented Apr 4, 2019 at 12:24
  • $\begingroup$ Yes if you want only short distances then @szabolcs has better tools available. This GraphDistance solution is only good if you want the distances to all nodes in the graph. $\endgroup$
    – Roman
    Commented Apr 4, 2019 at 13:50

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.