# 12 Centrality

In this tutorial, we look at measures of network centrality, which we use to identify structurally important actors. We also discuss possible ideas for identifying important edges.

Centrality originally referred to how central actors are in a network’s structure. It has become abstracted as a term from its topological origins and now refers very generally to how important actors are to a network. Topological centrality has a clear definition, but many operationalizations. Network “importance” on the other hand has many definitions *and* many operationalizations. We will explore the possible meanings and operationalizations of centrality here. There are four well-known centrality measures: degree, betweenness, closeness and eigenvector - each with its own strengths and weaknesses. The main point we want to make is that the analytical usefulness of each depends heavily on the context of the network, the type of relation being analyzed and the underlying network morphology. We don’t want to leave you with the impression that one is better than another - only that one might serve your research goals better than another.

Every node-level measure has its graph-level analogue. Centralization measures the extent to which the ties of a given network are concentrated on a single actor or group of actors. We can also look at the degree distribution. It is a simple histogram of degree, which tells you whether the network is highly unequal or not.

### 12.0.1 Loading the example network

As always, we need to load igraph. We will load in tidyverse too in case we need to do some data munging or plotting.

```
library(igraph)
library(tidyverse)
```

`## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.1 ──`

```
## ✓ tibble 3.1.3 ✓ dplyr 1.0.7
## ✓ tidyr 1.1.3 ✓ stringr 1.4.0
## ✓ readr 2.0.0 ✓ forcats 0.5.1
## ✓ purrr 0.3.4
```

```
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## x dplyr::as_data_frame() masks tibble::as_data_frame(), igraph::as_data_frame()
## x purrr::compose() masks igraph::compose()
## x tidyr::crossing() masks igraph::crossing()
## x dplyr::filter() masks stats::filter()
## x dplyr::groups() masks igraph::groups()
## x dplyr::lag() masks stats::lag()
## x purrr::simplify() masks igraph::simplify()
```

`library(reshape2)`

We will use John Padgett’s Florentine Families dataset. It is part of a famous historical datset about the relationships of prominent Florentine families in 15th century Italy. The historical puzzle is how the Medici, an upstart family, managed to accumulate political power during this period. Padgett’s goal was to explain their rise.

He looked at many relations. On the github, we have access to marriage, credit, and business partnership ties, but we will focus on marriage for now. Marriage was a tool in diplomacy, central to political alliances. A tie is drawn between families if the daughter of one family was sent to marry the son of another.

Ron Breiger, who analyzed these data in a famous paper on local role analysis, has argued these edges should be directed, tracing where daughters were sent or where finances flowed.

As always, we first load and prepare the dataset. We will do so directly from GitHub again.

```
# prepare the marriage adjacency matrix
<- read.csv("https://raw.githubusercontent.com/mahoffman/stanford_networks/main/data/florentine_marriage_edgelist.csv")
florentine_edj <- florentine_edj[,2:3]
florentine_edj
# prepare the attributes file
<- read.csv("https://raw.githubusercontent.com/mahoffman/stanford_networks/main/data/florentine_attributes.csv")
florentine_attributes
# graph the marriage network
<- graph.edgelist(as.matrix(florentine_edj), directed = T)
marriageNet V(marriageNet)$Wealth <- florentine_attributes$Gwealth[match(V(marriageNet)$name, florentine_attributes$Family)]
# Gross wealth (Florins), for 87 (92) families
# simple mean imputation of wealth (alternatively, we might think that those with NA were too poor to show up in historical records?)
V(marriageNet)$Wealth <- ifelse(is.na(V(marriageNet)$Wealth), mean(V(marriageNet)$Wealth, na.rm = T), V(marriageNet)$Wealth)
# Number of Priors, The Priorate (or city council), first created in 1282, was Florence's governing body. Count of how many seats a family had on that city council from 1282-1344
# measure of the aggregate political influence of the family over a long period of time
V(marriageNet)$Priorates <- florentine_attributes$Npriors[match(V(marriageNet)$name, florentine_attributes$Family)]
```

Let’s see how it looks.

`plot(marriageNet, vertex.size = 8, vertex.label.cex = .4, vertex.label.color = "black", vertex.color = "tomato", edge.arrow.size = 0.4)`

Based on this plot, which family do you expect is most central?

### 12.0.2 Degree Centrality

The simplest measure of centrality is degree centrality. It counts how many edges each node has - the most degree central actor is the one with the most ties.

Note:In a directed network, you will need to specify if in or out ties should be counted. These will be referred to as in or out degree respectively. If both are counted, then it is just called degree

Degree centrality is calculated using the degree function in R. It returns how many edges each node has.

`degree(marriageNet) `

```
## Acciaiuoli Guicciardini Medici Adimari Arrigucci
## 4 14 40 6 2
## Barbadori Strozzi Albizzi Altoviti Della_Casa
## 14 50 28 12 4
## Corsi Davanzati Frescobaldi Ginori Guadagni
## 2 6 12 8 20
## Guasconi Nerli Del_Palagio Panciatichi Scolari
## 24 2 4 14 6
## Aldobrandini Alessandri Tanagli Bencivenni Gianfigliazzi
## 4 2 4 2 20
## Spini Dall'Antella Martelli Rondinelli Ardinghelli
## 8 6 4 10 10
## Peruzzi Rossi Arrighi Baldovinetti Ciampegli
## 30 4 2 8 2
## Manelli Carducci Castellani Ricasoli Bardi
## 4 4 14 20 14
## Bucelli Serragli Da_Uzzano Baroncelli Raugi
## 4 4 4 2 2
## Baronci Manovelli Bartoli Solosmei Bartolini
## 2 4 2 2 2
## Belfradelli Del_Benino Donati Benizzi Bischeri
## 2 2 4 2 8
## Brancacci Capponi Nasi(?) Sacchetti Vettori
## 4 8 2 6 2
## Doffi Pepi Cavalcanti Ciai Corbinelli
## 2 2 6 2 2
## Lapi Orlandini Dietisalvi Valori Federighi
## 2 4 2 8 2
## Dello_Scarfa Fioravanti Salviati Giugni Pandolfini
## 2 4 6 6 4
## Lamberteschi Tornabuoni Mancini Di_Ser_Segna Macinghi
## 2 8 2 2 2
## Masi Pecori Pitti Popoleschi Portinari
## 2 2 4 4 2
## Ridolfi Serristori Vecchietti Minerbetti Pucci
## 8 2 2 2 2
## Da_Panzano Parenti Pazzi Rucellai Scambrilla
## 4 2 4 2 2
## Soderini
## 2
```

Who is the most degree central?

We can assign the output to a variable in the network and size the nodes according to degree.

```
V(marriageNet)$degree <- degree(marriageNet) # assignment
plot(marriageNet, vertex.label.cex = .6, vertex.label.color = "black", vertex.size = V(marriageNet)$degree, vertex.label.cex = .2) # sized by degree
```

The problem is that the degree values are a little small to plot well. We can use a scalar to increase the value of the degree but maintain the ratio.

```
plot(marriageNet,
vertex.label.cex = .6,
vertex.label.color = "black",
vertex.size = V(marriageNet)$degree*3)
```

### 12.0.3 Betweenness Centrality

Betweenness centrality captures which nodes are important in the flow of the network. It makes use of the shortest paths in the network. A path is a series of adjacent nodes. For any two nodes we can find the shortest path between them, that is, the path with the least amount of total steps (or edges). If a node C is on a shortest path between A and B, then it means C is important to the efficient flow of goods between A and B. Without C, flows would have to take a longer route to get from A to B.

Thus, betweenness effectively counts how many shortest paths each node is on. The higher a node’s betweenness, the more important they are for the efficient flow of goods in a network.

In igraph, betweenness() computes betweenness in the network

`betweenness(marriageNet, directed = FALSE)`

```
## Acciaiuoli Guicciardini Medici Adimari Arrigucci
## 0.000000 327.850305 1029.609288 93.009524 0.000000
## Barbadori Strozzi Albizzi Altoviti Della_Casa
## 162.697344 1369.979110 856.436111 125.620147 11.577398
## Corsi Davanzati Frescobaldi Ginori Guadagni
## 0.000000 260.000000 145.532681 180.571429 277.059921
## Guasconi Nerli Del_Palagio Panciatichi Scolari
## 583.679251 0.000000 0.000000 167.994891 19.801010
## Aldobrandini Alessandri Tanagli Bencivenni Gianfigliazzi
## 23.351190 0.000000 88.000000 0.000000 187.915043
## Spini Dall'Antella Martelli Rondinelli Ardinghelli
## 89.500000 174.000000 88.000000 43.186597 58.278211
## Peruzzi Rossi Arrighi Baldovinetti Ciampegli
## 604.369691 0.000000 0.000000 95.613889 0.000000
## Manelli Carducci Castellani Ricasoli Bardi
## 0.000000 5.009524 194.199423 205.097092 280.248232
## Bucelli Serragli Da_Uzzano Baroncelli Raugi
## 1.066667 81.000000 3.666667 0.000000 0.000000
## Baronci Manovelli Bartoli Solosmei Bartolini
## 0.000000 88.000000 0.000000 0.000000 0.000000
## Belfradelli Del_Benino Donati Benizzi Bischeri
## 0.000000 0.000000 88.000000 0.000000 63.995238
## Brancacci Capponi Nasi(?) Sacchetti Vettori
## 0.000000 177.000000 0.000000 197.651515 0.000000
## Doffi Pepi Cavalcanti Ciai Corbinelli
## 0.000000 0.000000 125.467749 0.000000 0.000000
## Lapi Orlandini Dietisalvi Valori Federighi
## 0.000000 88.000000 0.000000 202.285859 0.000000
## Dello_Scarfa Fioravanti Salviati Giugni Pandolfini
## 0.000000 5.951190 35.571429 96.664141 0.000000
## Lamberteschi Tornabuoni Mancini Di_Ser_Segna Macinghi
## 0.000000 23.831746 0.000000 0.000000 0.000000
## Masi Pecori Pitti Popoleschi Portinari
## 0.000000 0.000000 19.610606 0.000000 0.000000
## Ridolfi Serristori Vecchietti Minerbetti Pucci
## 213.727670 0.000000 0.000000 0.000000 0.000000
## Da_Panzano Parenti Pazzi Rucellai Scambrilla
## 16.961111 0.000000 4.361111 0.000000 0.000000
## Soderini
## 0.000000
```

We can again assign the output of betweenness() to a variable in the network and size the nodes according to it.

```
V(marriageNet)$betweenness <- betweenness(marriageNet, directed = F) # assignment
plot(marriageNet,
vertex.label.cex = .6,
vertex.label.color = "black",
vertex.size = V(marriageNet)$betweenness) # sized by betweenness
```

Betweenness centrality can be very large. It is often helpful to normalize it by dividing by the maximum and multiplying by some scalar when plotting.

```
plot(marriageNet,
vertex.label.cex = .6,
vertex.label.color = "black",
vertex.size = V(marriageNet)$betweenness/max(V(marriageNet)$betweenness) * 20)
```

### 12.0.4 Closeness Centrality

With closeness centrality we again make use of the shortest paths between nodes. We measure the distance between two nodes as the length of the shortest path between them. Farness, for a given node, is the average distance from that node to all other nodes. Closeness is then the reciprocal of farness (1/farness).

`closeness(marriageNet)`

```
## Warning in closeness(marriageNet): At centrality.c:2784 :closeness centrality is
## not well-defined for disconnected graphs
```

```
## Acciaiuoli Guicciardini Medici Adimari Arrigucci
## 0.0011723329 0.0012468828 0.0012836970 0.0011961722 0.0010822511
## Barbadori Strozzi Albizzi Altoviti Della_Casa
## 0.0012210012 0.0012970169 0.0012658228 0.0012165450 0.0011792453
## Corsi Davanzati Frescobaldi Ginori Guadagni
## 0.0011389522 0.0011467890 0.0012180268 0.0011737089 0.0012254902
## Guasconi Nerli Del_Palagio Panciatichi Scolari
## 0.0012903226 0.0011389522 0.0011834320 0.0012562814 0.0011834320
## Aldobrandini Alessandri Tanagli Bencivenni Gianfigliazzi
## 0.0011834320 0.0010141988 0.0011135857 0.0010989011 0.0012690355
## Spini Dall'Antella Martelli Rondinelli Ardinghelli
## 0.0011792453 0.0011709602 0.0010638298 0.0012195122 0.0012330456
## Peruzzi Rossi Arrighi Baldovinetti Ciampegli
## 0.0012722646 0.0011534025 0.0011061947 0.0012091898 0.0010928962
## Manelli Carducci Castellani Ricasoli Bardi
## 0.0011668611 0.0011933174 0.0012254902 0.0012269939 0.0012531328
## Bucelli Serragli Da_Uzzano Baroncelli Raugi
## 0.0011627907 0.0011389522 0.0011737089 0.0001108033 0.0001108033
## Baronci Manovelli Bartoli Solosmei Bartolini
## 0.0010416667 0.0011467890 0.0001108033 0.0001108033 0.0009727626
## Belfradelli Del_Benino Donati Benizzi Bischeri
## 0.0011001100 0.0009469697 0.0010330579 0.0011441648 0.0012360939
## Brancacci Capponi Nasi(?) Sacchetti Vettori
## 0.0012048193 0.0010976948 0.0010010010 0.0011806375 0.0010010010
## Doffi Pepi Cavalcanti Ciai Corbinelli
## 0.0011061947 0.0011061947 0.0012285012 0.0010638298 0.0011534025
## Lapi Orlandini Dietisalvi Valori Federighi
## 0.0010416667 0.0010438413 0.0010638298 0.0011337868 0.0001108033
## Dello_Scarfa Fioravanti Salviati Giugni Pandolfini
## 0.0001108033 0.0011682243 0.0011723329 0.0011641444 0.0010718114
## Lamberteschi Tornabuoni Mancini Di_Ser_Segna Macinghi
## 0.0011061947 0.0011890606 0.0011587486 0.0011587486 0.0011641444
## Masi Pecori Pitti Popoleschi Portinari
## 0.0011441648 0.0011534025 0.0012195122 0.0011587486 0.0011534025
## Ridolfi Serristori Vecchietti Minerbetti Pucci
## 0.0012315271 0.0011534025 0.0011534025 0.0011641444 0.0009560229
## Da_Panzano Parenti Pazzi Rucellai Scambrilla
## 0.0011389522 0.0011641444 0.0011337868 0.0011641444 0.0010683761
## Soderini
## 0.0011641444
```

We assign it to a node variable and plot the network, adjusting node size by closeness.

`V(marriageNet)$closeness <- closeness(marriageNet)`

```
## Warning in closeness(marriageNet): At centrality.c:2784 :closeness centrality is
## not well-defined for disconnected graphs
```

```
plot(marriageNet,
vertex.label.cex = .6,
vertex.label.color = "black",
vertex.size = V(marriageNet)$closeness/max(V(marriageNet)$closeness) * 20)
```

## 12.1 Eigenvector Centrality

Degree centrality only takes into account the number of edges for each node, but it leaves out information about ego’s alters.

However, we might think that power comes from being tied to powerful people. If A and B have the same degree centrality, but A is tied to all high degree people and B is tied to all low degree people, then intuitively we want to see A with a higher score than B.

Eigenvector centrality takes into account alters’ power. It is calculated a little bit differently in igraph. It produces a list object and we need to extract only the vector of centrality values.

`evcent(marriageNet)$vector`

```
## Acciaiuoli Guicciardini Medici Adimari Arrigucci
## 1.399699e-01 3.830752e-01 6.707160e-01 1.831812e-01 2.433106e-02
## Barbadori Strozzi Albizzi Altoviti Della_Casa
## 3.547849e-01 1.000000e+00 5.323660e-01 3.372469e-01 1.414314e-01
## Corsi Davanzati Frescobaldi Ginori Guadagni
## 7.071156e-02 7.332195e-02 3.436670e-01 1.057862e-01 3.460880e-01
## Guasconi Nerli Del_Palagio Panciatichi Scolari
## 6.811084e-01 7.071156e-02 1.383317e-01 5.090917e-01 1.367356e-01
## Aldobrandini Alessandri Tanagli Bencivenni Gianfigliazzi
## 1.509870e-01 4.503879e-03 3.390835e-02 4.479485e-02 7.162939e-01
## Spini Dall'Antella Martelli Rondinelli Ardinghelli
## 2.096823e-01 1.893404e-01 2.560082e-02 3.998861e-01 4.000982e-01
## Peruzzi Rossi Arrighi Baldovinetti Ciampegli
## 7.915554e-01 1.582815e-01 4.596917e-02 2.497482e-01 3.317283e-02
## Manelli Carducci Castellani Ricasoli Bardi
## 1.659979e-01 1.799494e-01 4.238792e-01 5.324287e-01 4.080706e-01
## Bucelli Serragli Da_Uzzano Baroncelli Raugi
## 1.218222e-01 5.798025e-02 1.593404e-01 1.498662e-17 9.937879e-18
## Baronci Manovelli Bartoli Solosmei Bartolini
## 1.421582e-02 1.070266e-01 1.321330e-17 2.188422e-17 3.400431e-03
## Belfradelli Del_Benino Donati Benizzi Bischeri
## 4.564759e-02 1.231075e-03 9.268390e-03 1.051384e-01 3.348147e-01
## Brancacci Capponi Nasi(?) Sacchetti Vettori
## 2.232934e-01 2.844521e-02 3.778238e-03 1.486187e-01 3.778238e-03
## Doffi Pepi Cavalcanti Ciai Corbinelli
## 5.630179e-02 5.630179e-02 2.359640e-01 1.405106e-02 8.908790e-02
## Lapi Orlandini Dietisalvi Valori Federighi
## 9.738994e-03 9.913900e-03 1.405106e-02 6.854784e-02 1.354681e-17
## Dello_Scarfa Fioravanti Salviati Giugni Pandolfini
## 1.851919e-17 1.350571e-01 1.467173e-01 1.011873e-01 2.254509e-02
## Lamberteschi Tornabuoni Mancini Di_Ser_Segna Macinghi
## 4.596917e-02 1.834366e-01 9.046827e-02 9.046827e-02 1.328251e-01
## Masi Pecori Pitti Popoleschi Portinari
## 1.051384e-01 8.908790e-02 2.219130e-01 1.134529e-01 8.908790e-02
## Ridolfi Serristori Vecchietti Minerbetti Pucci
## 2.507818e-01 8.908790e-02 8.908790e-02 1.328251e-01 1.316815e-03
## Da_Panzano Parenti Pazzi Rucellai Scambrilla
## 9.046017e-02 1.328251e-01 9.020762e-02 1.328251e-01 2.785107e-02
## Soderini
## 1.328251e-01
```

Then we can assign that vector to our network and plot it.

```
V(marriageNet)$eigenvector <- evcent(marriageNet)$vector
plot(marriageNet,
vertex.label.cex = .6,
vertex.label.color = "black",
vertex.size = V(marriageNet)$eigenvector/max(V(marriageNet)$eigenvector) * 20)
```

## 12.2 Bonacich Centrality

Perhaps marrying your daughters off to weaker families is a good way to ensure their loyalty? We could evaluate this using bonacich centrality. From igraph: “Interpretively, the Bonacich power measure corresponds to the notion that the power of a vertex is recursively defined by the sum of the power of its alters. The nature of the recursion involved is then controlled by the power exponent: positive values imply that vertices become more powerful as their alters become more powerful (as occurs in cooperative relations), while negative values imply that vertices become more powerful only as their alters become weaker (as occurs in competitive or antagonistic relations).”

```
V(marriageNet)$bonacich <- power_centrality(marriageNet, exponent = -2, rescale = T)
V(marriageNet)$bonacich <- ifelse(V(marriageNet)$bonacich < 0, 0, V(marriageNet)$bonacich)
plot(marriageNet,
vertex.label.cex = .6,
vertex.label.color = "black",
vertex.size = V(marriageNet)$bonacich/max(V(marriageNet)$bonacich) * 20)
```

## 12.3 Page Rank

Here is Google’s page rank measure. It uses random walks to identify individuals who are commonly encountered along such walks. Those individuals are viewed as central.

```
V(marriageNet)$page_rank <- page_rank(marriageNet, directed = TRUE)$vector
plot(marriageNet,
vertex.label.cex = .6,
vertex.label.color = "black",
vertex.size = V(marriageNet)$page_rank/max(V(marriageNet)$page_rank) * 20)
```

### 12.3.1 Measure Correlations

Most of these measures are highly correlated, meaning they don’t necessarily capture unique aspects of pwoer. However, the amount of correlation depends on the network structure. Let’s see how the correlations between centrality measures looks in the Florentine Family network. cor.test(x,y) performs a simple correlation test between two vectors.

```
# extract all the vertex attributes
<- lapply(list.vertex.attributes(marriageNet),function(x) get.vertex.attribute(marriageNet,x))
all_atts # bind them into a matrix
<- do.call("cbind", all_atts)
all_atts # add column nams
colnames(all_atts) <- list.vertex.attributes(marriageNet)
# drop the family variable
<- data.frame(all_atts[,2:ncol(all_atts)])
all_atts # convert all to numeric
<- sapply(all_atts, as.numeric)
all_atts # produce a correlation matrix
<- cor(all_atts)
cormat # melt it using reshape to function melt() to prepare it for ggplot which requires long form data
<- melt(cormat)
melted_cormat ggplot(data = melted_cormat, aes(x=Var1, y=Var2, fill=value)) +
geom_tile() +
scale_fill_distiller(palette = "Spectral", direction=-2) +
xlab("") +
ylab("")
```

What do we learn?

### 12.3.2 Centralization and Degree Distributions

To understand the measures further, we can look at their distributions. This will tell us roughly how many nodes have centralities of a given value.

```
# fitting a degree distribution on the log-log scale
= table(degree(marriageNet))
alter_hist = as.numeric(names(alter_hist))
vals = vals[2:length(vals)]
vals = alter_hist[2:length(alter_hist)]
alter_hist = data.frame(Vals = log(vals), Hist = log(as.numeric(alter_hist)), stringsAsFactors = F)
df
# plot log-log degree distribution
plot(Hist ~ Vals, data = df)
# regression line
abline(lm(Hist ~ Vals, data = df))
```

Do their marriage partners have more marriage partners than they do?

```
# degrees of your friends
<- knn(marriageNet)$knn
neighbor_degrees <- degree(marriageNet)
degrees
mean(neighbor_degrees, na.rm = T)
```

`## [1] 18.72979`

`mean(degrees)`

`## [1] 6.541667`

```
# plot neighbor degrees vs. ego degress
hist(neighbor_degrees)
```

`hist(degrees)`

We can see that most nodes in the marriage network have low betweenness centrality, and only one node has more than 40 betweenness. Degree distributions tend to be right-skewed; that is, only a few nodes in most networks have most of the ties. Evenly distributed degree is much rarer.

Finally centralization measures the extent to which a network is centered around a single node. The closer a network gets to looking like a star, the higher the centralization score will be.

```
<- centralization.degree(marriageNet)$centralization
degcent centralization.betweenness(marriageNet)$centralization
```

`## [1] 0.2881759`

`centralization.evcent(marriageNet)$centralization`

`## [1] 0.8503616`

`centralization.closeness(marriageNet)$centralization`

```
## Warning in centralization.closeness(marriageNet): At
## centrality.c:2784 :closeness centrality is not well-defined for disconnected
## graphs
```

`## [1] 0.02030026`

Can we compare our centralization scores against some baseline? Here is an example with Barabasi-Albert model, which simulates a network in which there is preferential attachment with respect to degree, the amount of which is controlled by the power parameter.

```
<- vcount(marriageNet)
N <- centralization.degree(marriageNet)$centralization
degcent
= c()
centralizations <- seq(from = 0, to = 3, by = 0.1)
powers for(e in powers){
<- barabasi.game(N, directed = F, power=e)
net <- c(centralizations, centralization.degree(net)$centralization)
centralizations
}
<- data.frame(Centralization = centralizations, Power = powers)
power_df
ggplot(power_df, aes(x = Power, y = Centralization)) +
geom_point() +
geom_hline(yintercept = degcent, linetype="dashed", color = "red") +
theme_bw()
```

## Reach N What proportion of nodes can any node reach at N steps?

```
=function(x, n = 2){
reach_n =vector(length=vcount(x))
rfor (i in 1:vcount(x)){
=neighborhood(x, n, nodes=i)
neighb =unlist(neighb)
ni=length(ni)
l=(l)/vcount(x)
r[i]
}return(r)
}
= reach_n(marriageNet, 2)
two_reach
plot(marriageNet, vertex.size = two_reach * 10, vertex.label.cex = .4, vertex.label.color = "black", vertex.color = "tomato")
```

```
= reach_n(marriageNet, 3)
three_reach
plot(marriageNet, vertex.size = three_reach * 10, vertex.label.cex = .4, vertex.label.color = "black", vertex.color = "tomato")
```

```
= reach_n(marriageNet, 4)
four_reach
plot(marriageNet, vertex.size = four_reach * 10, vertex.label.cex = .4, vertex.label.color = "black", vertex.color = "tomato")
```

```
= reach_n(marriageNet, 5)
five_reach
plot(marriageNet, vertex.size = five_reach * 10, vertex.label.cex = .4, vertex.label.color = "black", vertex.color = "tomato")
```

## 12.4 Distance weighted reach

```
=function(x){
distance_weighted_reach=shortest.paths(x) #create matrix of geodesic distances
distancesdiag(distances)=1 # replace the diagonal with 1s
=1/distances # take the reciprocal of distances
weightsreturn(apply(weights,1,sum)) # sum for each node (row)
}
= distance_weighted_reach(marriageNet)
dw_reach = dw_reach/max(dw_reach)
dw_reach
plot(marriageNet, vertex.size = dw_reach * 10, vertex.label.cex = .4, vertex.label.color = "black", vertex.color = "tomato")
```