6

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.

J. M.'s missing motivation
  • 124,525
  • 11
  • 401
  • 574
ralph
  • 1,029
  • 5
  • 11

4 Answers4

7

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}

Vitaliy Kaurov
  • 73,078
  • 9
  • 204
  • 355
  • 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}). – ralph Apr 04 '19 at 12:24
  • @ralph is 0.1 seconds is slow? What timings do you need? No criteria for timings is mentioned in your original post. – Vitaliy Kaurov Apr 04 '19 at 12:41
  • Please forgive me. I meant about 200,000 no 20,000 nodes. – ralph Apr 04 '19 at 12:57
  • @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. – Vitaliy Kaurov Apr 04 '19 at 13:51
  • 1
    @VitaliyKaurov Sorry about the comments, I was wrong: this was actually fixed in 12.0. That is why I deleted them. – Szabolcs Apr 04 '19 at 16:01
  • It would still be good to mention that thread: https://mathematica.stackexchange.com/a/14522/12 OP is likely using 11.3 or earlier. – Szabolcs Apr 04 '19 at 16:04
  • @Szabolcs OK no worries, thank you :) – Vitaliy Kaurov Apr 04 '19 at 16:09
5

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).

halmir
  • 15,082
  • 37
  • 53
  • 1
    Amazingly fast, halmir! Any idea why this solution is so much faster than GraphDistance, which I would have thought works by BreadthFirstScan internally? – Roman Apr 04 '19 at 16:05
  • 1
    @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. – Szabolcs Apr 04 '19 at 16:14
  • @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. – Szabolcs Apr 04 '19 at 16:17
  • 1
    @halmir Can you tell us whether this is a bug and if it is fixable? The quadratic complexity looks like a bug. – Szabolcs Apr 04 '19 at 16:20
  • @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: https://mathematica.stackexchange.com/a/109408/12 – Szabolcs Apr 04 '19 at 16:30
  • @Roman I found my old report. It's also from 3 years ago, but it's not the same issue. It's that GraphDiameter keeps the entire graph distance matrix in memory, making this function unusable for large graphs (you'd need many gigabytes). That function does need to compute the whole matrix, but not keep it in memory at once. This problem is still unfixed as well. – Szabolcs Apr 04 '19 at 16:35
  • @Szabolcs I confirm that for this problem, BreadthFirstScan scales with the number of vertices, whereas GraphDistance scales with the square. Terrible! – Roman Apr 04 '19 at 17:42
  • @halmir Can you change this formula for weighted graphs? Is it possible? Example of graph 'net1' and its weight 'w1' in section 'For weighted network' below. – ralph Apr 05 '19 at 11:24
  • @halmir You would have to multiply the individual transition to the next node by the weight of the edge. – ralph Apr 05 '19 at 12:04
  • @ralph I added weighted graph case. – halmir Apr 05 '19 at 14:07
  • @halmir Thanks. But the code gives a strange result if we set the weights '1' anywhere (EdgeWeight -> Table[1,20]). It should give the same result as for the non weighted network. – ralph Apr 06 '19 at 12:28
  • @ralph I got the same result. Tested with net2 and vert 4798 in your example. GroupBy[weights, Last -> First] and distance[[All, "set"]] – halmir Apr 06 '19 at 15:31
3

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}

Roman
  • 47,322
  • 2
  • 55
  • 121
  • 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}) – ralph Apr 04 '19 at 12:24
  • 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. – Roman Apr 04 '19 at 13:50
3

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.

Szabolcs
  • 234,956
  • 30
  • 623
  • 1,263
  • Thanks. And how to count the same as the 'IGDistanceCounts[graph, {vertex}]' formula but for weighted networks? – ralph Apr 04 '19 at 14:15
  • @ralph As I said above, use IGDistanceHistogram – Szabolcs Apr 04 '19 at 16:01
  • Mr=IGDistanceHistogram[net1, ??] (for weighted graph ) ??? – ralph Apr 05 '19 at 06:19
  • @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. – Szabolcs Apr 05 '19 at 07:16
  • @ralph The syntax is IGDistanceHistogram[graph, binSize, {vertex}] where binSize is the bin size used for constructing the distance histogram. You must put the vertex in a list as the syntax also accepts multiple vertices. – Szabolcs Apr 05 '19 at 07:17
  • Tahank you. Of course I read the documentation. But the result is at least strange: IGDistanceHistogram[net1, 1, {5}] vs IGDistanceCounts[net, {5}] === Drop[IGDistanceHistogram[net1, 1, {5}], 1]. – ralph Apr 05 '19 at 08:09
  • @ralph What is strange about the result? Please be explicit, show the network, show what you got, show what you think you should have gotten instead. – Szabolcs Apr 05 '19 at 08:12
  • If you mean that IGDistanceHistogram returns an additional 0, that's because the histogram bins are [0,1), [1,2), [2,3), ... The first bin will always be empty for a graph whose edges all have weight 1. – Szabolcs Apr 05 '19 at 08:20
  • The net1, net2==net are below. – ralph Apr 05 '19 at 09:43
  • 1
    You did not answer my question ... – Szabolcs Apr 05 '19 at 09:49