# How to Build Up the Betweenness Centrality Score

Can the Betweenness Centrality score FOR EACH VERTEX in a graph be deconstructed as follows. For instance, in the graph below, the betweenness centrality score of vertex D is 3.5. Can this calculated value of 3.5 be broken out in terms of the following columns in a table.

Here is the code for the graph and the overall betweenness centrality measure.

Clear[g]
edges = {A \[UndirectedEdge] B, A \[UndirectedEdge] C,
B \[UndirectedEdge] D, C \[UndirectedEdge] D,
D \[UndirectedEdge] F};
g = Graph[edges, VertexLabels -> "Name", VertexLabels -> Automatic,
VertexSize -> 0.01, VertexLabelStyle -> 14]


BetweennessCentrality[g];
SortBy[{VertexList[g], BetweennessCentrality[g]}\[Transpose], N@*Last]

 {{F,0.}, {A,0.5}, {B,1.}, {C,1.}, {D,3.5}}


Suppose the graph is directed, such as

edges = {TX -> R1, R1 -> R3, R3 -> R5, R5 -> RX, TX -> R2, R2 -> R4,
R4 -> R6, R6 -> RX, R1 -> R2, R2 -> R3, R3 -> R4, R4 -> R5,
R5 -> R6, TX -> R7, TX -> R8, R7 -> R9, R9 -> R6, R9 -> RX,
R8 -> R6};
g = Graph[edges, VertexLabels -> Automatic]


In this case, the Betweenness of R5=4 which is not the same value from the code provide for the undirected graph case at the top of this note.

• column 1 should include {A, B} and {A, C}, no?
– kglr
Commented May 30, 2021 at 20:23
• see above desired table, to be generated for EACH VERTEX Commented May 30, 2021 at 20:39
• thank you @PRG.
– kglr
Commented May 30, 2021 at 20:51
• many thanks for your considerations; I'm basically trying to pull apart the betweenness measure; that is, (1) for each pair of vertices (s,t), compute the shortest paths between them. (2) For each pair of vertices (s,t), determine the fraction of shortest paths that pass through the vertex in question (here, vertex D). (3) Sum this fraction over all pairs of vertices (s,t). I'd like the intermediate calculations generated that result in (3) Commented May 30, 2021 at 21:21

ClearAll[spathsallpairs, spathsthrough, numberofshortestpaths, numberofspthrough]

spathsallpairs = Module[{g = #},
FindPath[g, ##, {GraphDistance[g, ##]}, All] & @@@ Subsets[VertexList@g, {2}]] &;

spathsthrough[g_, v_] := DeleteDuplicates[
Join @@ (Cases[{a_, ___, v, ___, b_} :> {a, b}] /@ spathsallpairs[g])]

numberofshortestpaths = Length @ FindPath[#, ##2, {GraphDistance[#, ##2]}, All] &;

numberofspthrough[v_] := Count[{_, ___, v, ___, _}]@
FindPath[#, ##2, {GraphDistance[#, ##2]}, All] &;


Example:

edges = {"A" \[UndirectedEdge] "B", "A" \[UndirectedEdge] "C",
"B" \[UndirectedEdge] "D", "C" \[UndirectedEdge] "D", "D" \[UndirectedEdge] "F"};
g = Graph[edges, VertexLabels -> "Name", VertexLabels -> Automatic,
VertexSize -> 0.01, VertexLabelStyle -> 14]


 spathsthrough[g, "D"]


{{"A", "F"}, {"B", "C"}, {"B", "F"}, {"C", "F"}}

ndst = numberofspthrough["D"][g, ##] & @@@ spathsthrough[g, "D"]

{2, 1, 1, 1}

nst = numberofshortestpaths[g, ##] & @@@ spathsthrough[g, "D"]

{2, 2, 1, 1}

ratios = ndst/nst;

Grid[Join[{{"{v1,v2}", "number of sp thru D", "number of sp", "ratio"}},
Transpose[{spathsthrough[g, "D"], ndst, nst, ratios}],
{{"", "", "Total: ", N@Total@ratios}}],
Dividers -> All,  Alignment -> Center]


• truly remarkable kglr; many many thanks for sharing your wonderful talents!!! Commented May 30, 2021 at 21:57
• How about if the graph is directed; for example, consider the graph Commented May 30, 2021 at 23:47
• @PRG, I think, replacing Subsets[VertexList@g, {2}] with Tuples[VertexList@g, {2}] or with DeleteCases[{v_,v_}]@Tuples[VertexList@g, {2}] should work for directed graphs.
– kglr
Commented May 30, 2021 at 23:52
• Brilliant --- many thanks again ... ur the best!! ... :) Commented May 30, 2021 at 23:57