Bernie's Website

Mapmaking with R and OpenStreetMaps

Bernhard Bieri — Sat, 28 Jan 2023 00:00:00 GMT

In this first post of the year, we’ll explore how to create artistic maps with R and OpenStreetMaps. In the process of creating the map, we’ll also discover the API capabilities of the {osmdata} package which could also be leveraged for heaps of other scientific applications. The main inspiration for this post comes from Tanya Shapiro’s visualizations.

The artsy application…

We’ll rely on the {sf}, {osmdata}, and {tidyverse} libraries to create a map of Washington, DC that includes information on university campuses and cafes a.k.a. the most important places for students.

# Import required libraries
library(sf)
library(osmdata)
library(tidyverse)

We’ll start by getting the border polygon of Washington, DC with the getbb() function from the {osmdata} library as an {sf} object. We then select the main polygon only.

# Get DC borders
dcosmborders <- getbb("washington dc", format_out = "sf_polygon")
dcosmborders <- dcosmborders[1,] # Only main polygon

Next, the code uses the opq() and add_osm_feature() functions from the {osmdata} library to get data on the city’s streets and filter it to only include “motorway”, “primary”, “secondary”, and “tertiary” roads. The resulting data is then stored in the variable “streets” and is intersected with the city’s borders to ensure that the data only includes information within the city. The same method is applied to extract data for bodies of water, universities and cafes. Note that water has both polygons and multipolygons that need to be extracted separately.

# Get big streets
streets <- getbb("washington dc") |>
  opq() |>
  add_osm_feature(key = "highway", 
                  value = c("motorway", "primary", 
                            "secondary", "tertiary")) |>
  osmdata_sf()
streets <- streets$osm_lines |>
  st_intersection(dcosmborders)

# Water polygons
water <- getbb("washington dc") |>
  opq() |>
  add_osm_feature("water", "river") |>
  osmdata_sf()
water_poly <- water$osm_polygons |>
  st_intersection(dcosmborders)
water_multipoly <- water$osm_multipolygons |>
  st_intersection(dcosmborders)

# University polygons
university <- getbb("washington dc") |>
  opq() |>
  add_osm_feature("amenity", "university") |>
  osmdata_sf()
university <- university$osm_polygons |>
  st_intersection(dcosmborders)

# Cafes points
cafe <- getbb("washington dc") |>
  opq() |>
  add_osm_feature("amenity", "cafe") |>
  osmdata_sf()
cafe <- cafe$osm_points |>
  st_intersection(dcosmborders)

Finally, we leverage {ggplot2} functions to create the map itself including various customization for the map’s appearance, such as colors, text, and themes. The color palette was manually selected using the Coolors generator.

# Setting the title code in HTML for ggtext::geom_richtext
title <- "**Washington, DC**


Map of University Campuses and Cafes in
 Washington, DC according to OSM data."

# Plot
ggplot() +
  geom_sf(data = dcosmborders,
          color = "#834ba0",
          fill = "#834ba0") +
  geom_sf(
    data = streets,
    inherit.aes = FALSE,
    color = "#ce78b3",
    size = .4
  ) +
  geom_sf(
    data = water_poly,
    inherit.aes = FALSE,
    color = "#00E5E8",
    fill = "#00E5E8"
  ) +
  geom_sf(
    data = water_multipoly,
    inherit.aes = FALSE,
    color = "#00E5E8",
    fill = "#00E5E8"
  ) +
  geom_sf(
    data = university,
    inherit.aes = F,
    fill = "#D1BE9C",
    color = "#D1BE9C"
  ) +
  geom_sf(
    data = cafe,
    fill = "#EBB9DF",
    color = "#EBB9DF",
    size = 1,
    alpha = 0.75
  ) +
  scale_y_continuous(limits = c(38.79163, 38.99597)) +
  scale_x_continuous(limits = c(-77.15979, -76.89937)) +
  ggtext::geom_richtext(
    aes(x = -77.11, y = 38.855, label = title),
    color = "white",
    label.color = NA,
    fill = NA
  ) +
  labs(caption = "Map Data Source: OpenStreetMap Contributors") +
  theme_void() +
  theme(
    text = element_text(color = "white"),
    plot.caption = element_text(color = "#ad5fad", hjust = 0.95),
    plot.background = element_rect(fill = "#573b88", color = NA),
    plot.margin = margin(t = 65, r = 10, b = 65, l = 10, unit = "pt")
  )

…and the less artsy applications:

Open Street Map is a treasure trove for GIS data and its access has been greatly facilitated by the {osmdata} package leveraging the Overpass API. Exploring the geometries you can query with the API is easy with the purpose built function of the {osmdata} package. Simply use availiable_features() and availiable_tags() to see all available features. In addition to geometries you can also often scrape location specific information such as the website of a business or artists having designed a particular fountain. Examples of what one can do with that data includes computing walking distances to amenities and creating more minimalistic art-maps.

Epilogue:

And finally, here is the full code on howw you can make beautiful artistic maps with the OSM data API interface and {ggplot2}’s mapping capabilities in about 100 lines of code.

library(sf)
library(osmdata)
library(tidyverse)

# Get DC borders
dcosmborders <- getbb("washington dc", format_out = "sf_polygon")
dcosmborders <- dcosmborders[1,] # Only main polygon

# Get big streets
streets <- getbb("washington dc") |>
  opq() |>
  add_osm_feature(key = "highway", 
                  value = c("motorway", "primary", 
                            "secondary", "tertiary")) |>
  osmdata_sf()
streets <- streets$osm_lines |>
  st_intersection(dcosmborders)

# Water polygons
water <- getbb("washington dc") |>
  opq() |>
  add_osm_feature("water", "river") |>
  osmdata_sf()
water_poly <- water$osm_polygons |>
  st_intersection(dcosmborders)
water_multipoly <- water$osm_multipolygons |>
  st_intersection(dcosmborders)

# University polygons
university <- getbb("washington dc") |>
  opq() |>
  add_osm_feature("amenity", "university") |>
  osmdata_sf()
university <- university$osm_polygons |>
  st_intersection(dcosmborders)

# Cafes
cafe <- getbb("washington dc") |>
  opq() |>
  add_osm_feature("amenity", "cafe") |>
  osmdata_sf()
cafe <- cafe$osm_points |>
  st_intersection(dcosmborders)

title <- "**Washington, DC**


Map of University Campuses and Cafes in
 Washington, DC according to OSM data."

ggplot() +
  geom_sf(data = dcosmborders,
          color = "#834ba0",
          fill = "#834ba0") +
  geom_sf(
    data = streets,
    inherit.aes = FALSE,
    color = "#ce78b3",
    size = .4
  ) +
  geom_sf(
    data = water_poly,
    inherit.aes = FALSE,
    color = "#00E5E8",
    fill = "#00E5E8"
  ) +
  geom_sf(
    data = water_multipoly,
    inherit.aes = FALSE,
    color = "#00E5E8",
    fill = "#00E5E8"
  ) +
  geom_sf(
    data = university,
    inherit.aes = F,
    fill = "#D1BE9C",
    color = "#D1BE9C"
  ) +
  geom_sf(
    data = cafe,
    fill = "#EBB9DF",
    color = "#EBB9DF",
    size = 1,
    alpha = 0.75
  ) +
  scale_y_continuous(limits = c(38.79163, 38.99597)) +
  scale_x_continuous(limits = c(-77.11979, -76.90937)) +
  ggtext::geom_richtext(
    aes(x = -77.09, y = 38.855, label = title),
    color = "white",
    label.color = NA,
    fill = NA
  ) +
  labs(caption = "Map Data Source: OpenStreetMap Contributors") +
  theme_void() +
  theme(
    text = element_text(color = "white"),
    plot.caption = element_text(color = "#ad5fad", hjust = 0.95),
    plot.background = element_rect(fill = "#573b88", color = NA),
    plot.margin = margin(
      t = 10,
      b = 10,
      l = 10,
      r = 10
    )
  )

Reuse

CC BY-SA 4.0

Citation

For attribution, please cite this work as:

Bieri, Bernhard. 2023. “Mapmaking with R and OpenStreetMaps.” January 28, 2023. https://bernhardbieri.ch/blog/2023-01-28-mapmaking-with-r-and-openstreetmaps/.

Simulating Simpson’s Paradox

Bernhard Bieri — Mon, 26 Sep 2022 00:00:00 GMT

This is the first post in a series called Bernie’s statistics aide-mémoire where I strive to understand various econometric concepts with simulations and other techniques. This first entry is dedicated to Simpson’s paradox, a well known phenomenon occuring when considering data at multiple levels of observation.

Simpson’s Paradox

Simpson’s Case Study

Simpson’s paradox has been defined in multiple ways over the past few decades and the Stanford Encyclopedia provides an excellent theoretical overview of the concept. The aim of this less extensive post is to provide a short introduction of Simpson’s paradox and illustrate it by running Monte Carlo simulations to visually explore its impact on causal inference.

In short, Simpson’s paradox manifests itself when one considers data at different levels of observation and observes the reversal or the disappearance of an association between two variables (Sprenger and Weinberger 2021). Imagine that you are running a field experiment in Statsland and run a randomized control trial to assess the causal effect of a medical treatment on a given health condition. For simplicity, assume that health status is binary e.g. . Assume that you observe a large enough sample so that the observed proportions correspond to the true proportions of the population. Finally, imagine that there are two regions in Statsland: North and South. Given this setup, the following situation may arise.

Region Arm	North Control	North Treated	South Control	South Treated	Total
Healthy	4	8	2	12	26
Sick	3	5	3	15	26
Total	7	13	5	27	52

The numbers in the table above are inspired by (Sprenger and Weinberger 2021) who use the example of (Simpson 1951) to illustrate the intuition behind Simpson’s Paradox.

One can identify two seemingly contradicting insights in the numbers above. When considering the population as a whole, the proportion of cured individuals is equal in the treatment and the control arm e.g.

However, one sees that when conditioning on the region in addition to treatment status, we notice that and

In other words, the treatment seems to be ineffective when considering the population as a whole. On the contrary, when considering the conditional probabilities within each level of observation, the treatment seems to have a positive effect on health status¹.

Definition

Theoretical Intuition

Where does this seemingly counterintuitive pattern emerge from? As (Sprenger and Weinberger 2021) point out, one can explain the situation through two observations in the data above. First, people in the northern region are more likely to recover from treatment overall. Second, individuals in the northern region are less likely to be in the treatment group. These two facts explain the disappearance of the correlation at the population level. Formally, we can show it through the following probability decomposition:

The key terms in this decomposition are and that weight the probability within the region to form the population level probability² in a way that leads to the positive association within regions to vanish in the aggregate population.

Different Forms of the Paradox

Simpson’s paradox has been defined in the following three main ways (Sprenger and Weinberger 2021):

Association Reversal
- In this first version, the association wihtin each subpopulation/region is either positive, negative, or null while the association at the population level has a different sign.
- See (Samuels 1993).
Yule’s Association Paradox
- In this second version, the association in the whole population is different from zero e.g. there is a positive or negative effect of the treatment when considering Statsland as a whole. But the effect dissappears when considering individual regions.
- See (Mittal 1991).
Amalgamation Paradox
- In this third and more general version, the association between the two variables of interest in the population as a whole is stronger than the maximum association between the two variables within each region.
- See (Good and Mittal 1987).

For a more formal characterisation of the different variants of Simpson’s Paradox see the excellent entry by (Sprenger and Weinberger 2021).

Simulations with Non-Categorical Data

Now that we gained an intuitive understanding of the paradox, let us run some simulations of an Association Reversal. Unlike in the first section of this post where we considered a binary treatment variable, we will illustrate it with a continuous independent variable . We start by writing the data generation process where we define three villages in which we record 1000 observations each. We then define three village level effects called beta as well as various moments of the independent variable and the error term . We then generate one example run of the synthetic dataset, plot it and examine a table of results of the various specifications. We define the naive full specification as:

and the village level specification for village 1 as:

which is equivalent to:

# Function generating data affected by Simpson's paradox with an
# Association Reversal
gensimpsondata <- function(N,                         # Within village beta.
                           beta       = c(-1,-1,-1),  # Within village beta.
                           mu         = c(5, 10, 15), # Mean of X within village
                           sigmax     = rep(2, 3),    # SD of X within village
                           sigmau     = rep(6, 3),    # SD of error term
                           groupFE     = 15,          # Fixed effect of Group
                           name_groups = "Village") {
  groupNo <- seq(length(mu))
  groups <- paste0(name_groups, " ", groupNo)
  datasetlist <- list()
  for (i in seq(1, length(groupNo))) {
    datasetlist[[i]] <- dplyr::tibble(
      GroupNo = groupNo[[i]],
      Group   = rep(groups[[i]], N),
      GroupFE = groupNo[[i]] * groupFE,
      X       = rnorm(N, mu[[i]], sigmax[[i]]) + groupNo[[i]],
      # X depends on village level effects
      U       = rnorm(N, 0, sigmau[[i]])
    ) |>
      dplyr::mutate(Y = beta[[i]] * X + GroupFE + U)
      # Y depends on X and Village level effects.
  }
  out <- dplyr::bind_rows(datasetlist)
}
# Generate one iteration of the data called "example".
example <- gensimpsondata(N = 1000)

In the first graph below, we consider all three villages and seemingly identify a positive association between and .

# Plot the example data.
# Plot with full sample.
plotexamplefull <- ggplot2::ggplot(example) +
  ggplot2::geom_point(ggplot2::aes(X, Y), color = "white", alpha = 0.2) +
  ggplot2::geom_smooth(
    ggplot2::aes(X, Y),
    method = "lm",
    color = "white",
    formula = y ~ x
  ) +
  ggplot2::labs(title = "Illustrating Simpson's Paradox",
                subtitle = "Simple regression of Y on X  for the full sample.",
                caption = "Simulated data.") +
  HohgantR::themebernie()
plotexamplefull

However, when running the regressions within each individual village, we find that the effect seems to be reversed! This illustrates the Association Reversal, described in the previous section (Samuels 1993).

# Plot with full sample grouped by village.
plotexample <- ggplot2::ggplot(example) +
  ggplot2::geom_point(ggplot2::aes(X, Y, colour = Group), alpha = 0.2) +
  ggplot2::geom_smooth(
    ggplot2::aes(X, Y),
    method = "lm",
    color = "white",
    formula = y ~ x
  ) +
  ggplot2::geom_smooth(ggplot2::aes(x = X, y = Y, color = Group),
                       method = "lm",
                       formula = y ~ x) +
  ggplot2::labs(title = "Illustrating Simpson's Paradox",
                subtitle = "Simple regression of Y on X  for the three villages individually.",
                caption = "Simulated data.") +
  HohgantR::themebernie()
# Display plot
plotexample

Let us quickly complement this visual intuition within a table with actual regression coefficients. Since we generated the data above, we already know the true village level association between our variables of interest and know the the village effect. We thus specify the naive regression of on before looking at the effect within each village and finally specifying a regression with village level intercepts but a single .

# Display the OLS regressions in a simple table to show the different results
# when considering the full sample and considering the village-by-village
lmall <- lm(data = example, Y ~ X)
lmvillage1 <- dplyr::filter(example, Group == "Village 1") |>
  lm(formula = Y ~ X)
lmvillage2 <- dplyr::filter(example, Group == "Village 2") |>
  lm(formula = Y ~ X)
lmvillage3 <- dplyr::filter(example, Group == "Village 3") |>
  lm(formula = Y ~ X)
# The true regression with village level intercepts
lmfixedeffect <- lm(data = example, Y ~ X + Group)

stargazer::stargazer(
  lmall,
  lmvillage1,
  lmvillage2,
  lmvillage3,
  lmfixedeffect,
  type = "html",
  style = "aer",
  title = "Simple Regressions with Full Sample and Village level data",
  column.labels = c("Full Sample Naive",
                    "Village 1",
                    "Village 2",
                    "Village 3",
                    "Full Sample FE")
)

**Simple Regressions with Full Sample and Village level data**

	Y
	Full Sample Naive	Village 1	Village 2	Village 3	Full Sample FE
	(1)	(2)	(3)	(4)	(5)

X	1.107^***	-1.002^***	-0.789^***	-1.093^***	-0.961^***
	(0.026)	(0.093)	(0.095)	(0.095)	(0.054)

GroupVillage 2					14.487^***
					(0.422)

GroupVillage 3					28.932^***
					(0.703)

Constant	4.761^***	15.316^***	27.492^***	46.366^***	15.066^***
	(0.343)	(0.591)	(1.156)	(1.713)	(0.380)

Observations	3,000	1,000	1,000	1,000	3,000
R²	0.373	0.105	0.064	0.117	0.599
Adjusted R²	0.372	0.104	0.063	0.116	0.599
Residual Std. Error	7.574 (df = 2998)	6.084 (df = 998)	6.084 (df = 998)	5.986 (df = 998)	6.055 (df = 2996)
F Statistic	1,780.833^*** (df = 1; 2998)	116.827^*** (df = 1; 998)	68.635^*** (df = 1; 998)	132.690^*** (df = 1; 998)	1,493.680^*** (df = 3; 2996)

Notes:	^***Significant at the 1 percent level.
	^**Significant at the 5 percent level.
	^*Significant at the 10 percent level.

We see in this regression table that the point estimates of reflect our graphical analysis when we look at the full sample and the within-village estimations. The fifth and last model adds village level fixed effects to show that even if this estimation is consistent with the within village estimations in this case as all within village ’s are equal to , this need not be the case if within village effects are heterogenous (different) across villages. This can be easily seen if one runs the DGP function defined above with values such as beta = c(-1, 0.5, -1). Simpson’s paradox can therefore not be solved by simply adding fixed effects.

Let us now convince ourselves that we did not get these results by chance as this was only one draw of our data generating function. To do that, we plot a distribution of the coefficient of interest in the three regressions specified at the beginning of this section which we show below.

mcsimpson <- function(reps = 10) {
  datalist <- list()
  coefvectlst <- list()
  for (i in seq(reps)) {
    datalist[[i]] <- gensimpsondata(N = 1000)
    coefvectlst[[i]] <- vector()
    lmall <- lm(data = datalist[[i]], Y ~ X)
    coefvectlst[[i]][[1]] <- lmall[["coefficients"]][["X"]]
    lmvillage1 <-
      dplyr::filter(datalist[[i]], Group == "Village 1") |>
      lm(formula = Y ~ X)
    coefvectlst[[i]][[2]] <- lmvillage1[["coefficients"]][["X"]]
    lmvillage2 <-
      dplyr::filter(datalist[[i]], Group == "Village 2") |>
      lm(formula = Y ~ X)
    coefvectlst[[i]][[3]] <- lmvillage2[["coefficients"]][["X"]]
    lmvillage3 <-
      dplyr::filter(datalist[[i]], Group == "Village 3") |>
      lm(formula = Y ~ X)
    coefvectlst[[i]][[4]] <- lmvillage3[["coefficients"]][["X"]]
    lmfixedeffect <- lm(data = datalist[[i]], Y ~ X + Group)
    coefvectlst[[i]][[5]] <- lmfixedeffect[["coefficients"]][["X"]]
  }
  coefvectdf <- as.data.frame(do.call(rbind, coefvectlst))
  coefvectdf
}
coefsMC <- mcsimpson(reps = 200) |>
  dplyr::mutate(index = seq(200)) |>
  tidyr::gather(index, coefficient, dplyr::starts_with("V")) |>
  dplyr::mutate(
    index = replace(index, index == "V1", "Full Sample: Naive"),
    index = replace(index, index == "V2", "Village 1"),
    index = replace(index, index == "V3", "Village 2"),
    index = replace(index, index == "V4", "Village 3"),
    index = replace(index, index == "V5", "Full Sample: FE")
  ) |>
  dplyr::rename(Sample = index,
                Beta = coefficient)
# Density plot of different coefficients
freqmcsimpson <- ggplot2::ggplot(coefsMC) +
  ggplot2::geom_density(ggplot2::aes(
    Beta,
    group = Sample,
    color = Sample,
    fill = Sample
  ),
  alpha = 0.2) +
  ggplot2::labs(title = "Density Plot of Coefficient Estimates Under\nDifferent Specifications",
                subtitle = "Coefficients estimated by OLS",
                caption = "Monte Carlo Simulation: 200 iterations of synthetic DGP.") +
  HohgantR::themebernie()
freqmcsimpson

Simulations such as the one we just performed are a neat way of illustrating Simpson’s paradox. We have, however, not yet fully determined a method that would formally tell us at which level associations need to be considered in an observational study with actual empirical data. One way of seeing this is through what is known as Pearl’s Simpson Machine which will be the topic of a future post (Armistead 2014; Pearl 1993)!

PS: Please reach out if you spot any errors or have any comments and suggestions via the contact form.

Code Appendix

# Libraries
library(tidyverse)
library(MASS)
library(tidyverse)
library(stargazer)
library(dagitty)
library(ggdag)
# Load non-standard fonts with {extrafont}
extrafont::loadfonts("win")
extrafont::fonts()
# Function generating data affected by Simpson's paradox with an
# Association Reversal
gensimpsondata <- function(N,                         # Within village beta.
                           beta       = c(-1,-1,-1),  # Within village beta.
                           mu         = c(5, 10, 15), # Mean of X within village
                           sigmax     = rep(2, 3),    # SD of X within village
                           sigmau     = rep(6, 3),    # SD of error term
                           groupFE     = 15,          # Fixed effect of Group
                           name_groups = "Village") {
  groupNo <- seq(length(mu))
  groups <- paste0(name_groups, " ", groupNo)
  datasetlist <- list()
  for (i in seq(1, length(groupNo))) {
    datasetlist[[i]] <- dplyr::tibble(
      GroupNo = groupNo[[i]],
      Group   = rep(groups[[i]], N),
      GroupFE = groupNo[[i]] * groupFE,
      X       = rnorm(N, mu[[i]], sigmax[[i]]) + groupNo[[i]],
      # X depends on village level effects
      U       = rnorm(N, 0, sigmau[[i]])
    ) |>
      dplyr::mutate(Y = beta[[i]] * X + GroupFE + U)
      # Y depends on X and Village level effects.
  }
  out <- dplyr::bind_rows(datasetlist)
}
# Generate one iteration of the data called "example".
example <- gensimpsondata(N = 1000)
# Plot the example data.
# Plot with full sample.
plotexamplefull <- ggplot2::ggplot(example) +
  ggplot2::geom_point(ggplot2::aes(X, Y), color = "white", alpha = 0.2) +
  ggplot2::geom_smooth(
    ggplot2::aes(X, Y),
    method = "lm",
    color = "white",
    formula = y ~ x
  ) +
  ggplot2::labs(title = "Illustrating Simpson's Paradox",
                subtitle = "Simple regression of Y on X  for the full sample.",
                caption = "Simulated data.") +
  HohgantR::themebernie()
plotexamplefull
# Plot with full sample grouped by village.
plotexample <- ggplot2::ggplot(example) +
  ggplot2::geom_point(ggplot2::aes(X, Y, colour = Group), alpha = 0.2) +
  ggplot2::geom_smooth(
    ggplot2::aes(X, Y),
    method = "lm",
    color = "white",
    formula = y ~ x
  ) +
  ggplot2::geom_smooth(ggplot2::aes(x = X, y = Y, color = Group),
                       method = "lm",
                       formula = y ~ x) +
  ggplot2::labs(title = "Illustrating Simpson's Paradox",
                subtitle = "Simple regression of Y on X  for the three villages individually.",
                caption = "Simulated data.") +
  HohgantR::themebernie()
# Display plot
plotexample
# Generate featured gif with the example data. Does not appear in blogpost.
plot1 <- ggplot2::ggplot(example) +
  ggplot2::geom_point(ggplot2::aes(X, Y), alpha = 0.2) +
  ggplot2::geom_smooth(
    ggplot2::aes(X, Y),
    method = "lm",
    color = "white",
    formula = y ~ x
  ) +
  ggplot2::theme_void() +
  ggplot2::theme(
    panel.background = ggplot2::element_rect(fill = "#222831", color = NA),
    plot.background = ggplot2::element_rect(fill = "#222831", color = NA),
    legend.position = "none"
  )
plot2 <- ggplot2::ggplot(example) +
  ggplot2::geom_point(ggplot2::aes(X, Y, colour = Group), alpha = 0.2) +
  ggplot2::geom_smooth(ggplot2::aes(x = X, y = Y, color = Group),
                       method = "lm",
                       formula = y ~ x) +
  ggplot2::theme_void() +
  ggplot2::theme(
    panel.background = ggplot2::element_rect(fill = "#222831", color = NA),
    plot.background = ggplot2::element_rect(fill = "#222831", color = NA),
    legend.position = "none"
  )
ggplot2::ggsave(plot1,
                filename = "~/GitHub/Website/content/blog/2022-09-30-simpsonsparadox/plot1.png",
                dpi = 192)
ggplot2::ggsave(plot2,
                filename = "~/GitHub/Website/content/blog/2022-09-30-simpsonsparadox/plot2.png",
                dpi = 192)
# Display the OLS regressions in a simple table to show the different results
# when considering the full sample and considering the village-by-village
lmall <- lm(data = example, Y ~ X)
lmvillage1 <- dplyr::filter(example, Group == "Village 1") |>
  lm(formula = Y ~ X)
lmvillage2 <- dplyr::filter(example, Group == "Village 2") |>
  lm(formula = Y ~ X)
lmvillage3 <- dplyr::filter(example, Group == "Village 3") |>
  lm(formula = Y ~ X)
# The true regression with village level intercepts
lmfixedeffect <- lm(data = example, Y ~ X + Group)

stargazer::stargazer(
  lmall,
  lmvillage1,
  lmvillage2,
  lmvillage3,
  lmfixedeffect,
  type = "html",
  style = "aer",
  title = "Simple Regressions with Full Sample and Village level data",
  column.labels = c("Full Sample Naive",
                    "Village 1",
                    "Village 2",
                    "Village 3",
                    "Full Sample FE")
)
mcsimpson <- function(reps = 10) {
  datalist <- list()
  coefvectlst <- list()
  for (i in seq(reps)) {
    datalist[[i]] <- gensimpsondata(N = 1000)
    coefvectlst[[i]] <- vector()
    lmall <- lm(data = datalist[[i]], Y ~ X)
    coefvectlst[[i]][[1]] <- lmall[["coefficients"]][["X"]]
    lmvillage1 <-
      dplyr::filter(datalist[[i]], Group == "Village 1") |>
      lm(formula = Y ~ X)
    coefvectlst[[i]][[2]] <- lmvillage1[["coefficients"]][["X"]]
    lmvillage2 <-
      dplyr::filter(datalist[[i]], Group == "Village 2") |>
      lm(formula = Y ~ X)
    coefvectlst[[i]][[3]] <- lmvillage2[["coefficients"]][["X"]]
    lmvillage3 <-
      dplyr::filter(datalist[[i]], Group == "Village 3") |>
      lm(formula = Y ~ X)
    coefvectlst[[i]][[4]] <- lmvillage3[["coefficients"]][["X"]]
    lmfixedeffect <- lm(data = datalist[[i]], Y ~ X + Group)
    coefvectlst[[i]][[5]] <- lmfixedeffect[["coefficients"]][["X"]]
  }
  coefvectdf <- as.data.frame(do.call(rbind, coefvectlst))
  coefvectdf
}
coefsMC <- mcsimpson(reps = 200) |>
  dplyr::mutate(index = seq(200)) |>
  tidyr::gather(index, coefficient, dplyr::starts_with("V")) |>
  dplyr::mutate(
    index = replace(index, index == "V1", "Full Sample: Naive"),
    index = replace(index, index == "V2", "Village 1"),
    index = replace(index, index == "V3", "Village 2"),
    index = replace(index, index == "V4", "Village 3"),
    index = replace(index, index == "V5", "Full Sample: FE")
  ) |>
  dplyr::rename(Sample = index,
                Beta = coefficient)
# Density plot of different coefficients
freqmcsimpson <- ggplot2::ggplot(coefsMC) +
  ggplot2::geom_density(ggplot2::aes(
    Beta,
    group = Sample,
    color = Sample,
    fill = Sample
  ),
  alpha = 0.2) +
  ggplot2::labs(title = "Density Plot of Coefficient Estimates Under\nDifferent Specifications",
                subtitle = "Coefficients estimated by OLS",
                caption = "Monte Carlo Simulation: 200 iterations of synthetic DGP.") +
  HohgantR::themebernie()
freqmcsimpson
################################
## Citing all loaded packages ##
################################
knitr::write_bib(c(.packages(), "blogdown"), paste0(here::here(), "/blog/2022-09-30-simpsonsparadox/packages.bib"))

References

Armistead, Timothy W. 2014. “Resurrecting the Third Variable: A Critique of Pearl’s Causal Analysis of Simpson’s Paradox.” The American Statistician 68 (1): 1–7. https://doi.org/10.1080/00031305.2013.807750.

Good, I. J., and Y. Mittal. 1987. “The Amalgamation and Geometry of Two-by-Two Contingency Tables.” The Annals of Statistics 15 (2): 694–711.

Mittal, Yashaswini. 1991. “Homogeneity of Subpopulations and Simpson’s Paradox.” Journal of the American Statistical Association 86 (413): 167–72. https://doi.org/10.1080/01621459.1991.10475016.

Pearl, Judea. 1993. “[Bayesian Analysis in Expert Systems]: Comment: Graphical Models, Causality and Intervention.” Statistical Science 8 (3): 266–69.

Samuels, Myra L. 1993. “Simpson’s Paradox and Related Phenomena.” Journal of the American Statistical Association 88 (421): 81–88. https://doi.org/10.1080/01621459.1993.10594297.

Simpson, E. H. 1951. “The Interpretation of Interaction in Contingency Tables.” Journal of the Royal Statistical Society: Series B (Methodological) 13 (2): 238–41. https://doi.org/10.1111/j.2517-6161.1951.tb00088.x.

Sprenger, Jan, and Naftali Weinberger. 2021. “Simpson’s Paradox.” In The Stanford Encyclopedia of Philosophy, edited by Edward N. Zalta, Summer 2021. Metaphysics Research Lab, Stanford University.

Footnotes

In this example, we refer to different levels of observations in a geographic sense. Partitioning the population could also be done across any observable characteristic of individuals such as gender as shown in the examples used by Simpson (1951) and Sprenger and Weinberger (2021)↩︎
See Stanford’s Plato entry for a formal definition.↩︎

Reuse

CC BY-SA 4.0

Citation

For attribution, please cite this work as:

Bieri, Bernhard. 2022. “Simulating Simpson’s Paradox.” September 26, 2022. https://bernhardbieri.ch/blog/2022-09-30-simpsonsparadox/.

Literate Programming in Stata

Bernhard Bieri — Thu, 25 Aug 2022 00:00:00 GMT

TLDR: Literate programming with Stata just became easier thanks to the recent release of Quarto and the continuingly increasing integration of Stata and Python. One can now render a .qmd Quarto file or a Jupyter notebook containing Stata chunks and create publishing grade outputs such as presentations, dashboards and reports at the click of a button! The prerequisites of this workflow are Stata 17, Quarto, Python, as well as a few standard Python libraries. Click here to jump to the detailed instructions and skip the intro.

What Literate Programming Is and Why You Should Care

Literate programming is a concept pioneered by Donald Knuth, a Turing Award recipient known for creating TeX. The main idea behind the early form of literate programming was to upend the traditional programming practices of the time by systematically including human readable text accompanying and explaining the logic and the purpose of a program. As he describes in “Literate Programming”, Knuth considers the programmer as an “essayist” who should strive to communicate the purpose of a program in order to create better code. While initially centered in the domain of computer science, it more recently resurged in the interdisciplinary world of “data science”.

The Resurgence of Literate Programming in the 2010’s

With the advent of data science in the past 20 years with its interdisciplinary nature, the need for human readable text accompanying code grew. This is due to the fact that the interpretation of the results of a computation lies at the center of every data science project. It is thus extremely important to include either comments in a code or leverage modern literate programming tools to communicate the purpose of one’s code.

Modern examples of this practice include Jupyter Notebooks for Python and the combination of the {knitr} package and the RMarkdown format for R. These tools allow data scientists to interweave computational output with the theoretical explanations necessary to interpret it. Thereby, they accelerate the production of scientific products such as papers, reports, dashboards, etc. However, Stata, one of the most widely used piece of statistical software still lags behind in this regard and does not provide its users with a native option to leverage literal programming workflows. Existing solutions include {markdoc} a Stata package that is akin to {knitr} in R and supports exports to PDF, HTML, Word, Markdown and other common formats. Recently, however, the Quarto revolution occurred within the R/Python community and paradoxically also changed the game for literate Stata workflows thanks to the latter’s integration with Python.

The Stata-Python-Quarto Workflow for Literate Programming

Quarto’s release earlier this summer added the missing link to the implementation of the Stata literate programming workflow described below. Quarto is essentially a language agnostic tool that enables data scientists to generate PDFs, Word Documents, dashboards and other outputs from code at the click of a button in R, Python, ObservableJS, etc. While Quarto does not work with Stata out of the box, the tighter integration of Python and Stata with the release of Stata 17 and the PyStata package enables a literate programming workflow!

In what follows, we will look at two options to use Quarto to generate similar static HTML reports based on this example script introducing Stata17’s new companion PyStata package. We will first look at how to handle classic Jupyter notebooks before moving on to rendering a native .qmd files. Both workflows are almost identical, hence if you’re used to Jupyter notebooks, simply stick to the first one. The second one may be more familiar for those migrating from R as the .qmd file structure is almost identical to the .Rmarkdown file structure.

Want to see the final product before we start? Check out the Jupyter notebook example and the native Quarto example.

A Few Prerequisites

Make sure that the following prerequisites are met before reading on. They are the same for rendering both Jupyter notebooks and .qmd files.

Python
VSCode (I found that it works best for this workflow due to the Quarto extension)
Stata 17
Quarto
The Quarto extension for VSCode
A few Python libraries and their dependencies:
- Jupyter to run Jupyter Notebooks
- Stata_setup to initialize the PyStata package which is located in the install folder of Stata 17

Additionally to run the example code, install the following packages and their dependencies:

matplotlib

# Create new project env:
conda create --name StataPythonQuarto
# Activate it:
conda activate StataPythonQuarto
# To run the Jupyter Notebook:
pip install -U jupyter
# Stata bridge itself:
pip install -U stata_setup
# For matplotlib graph:
pip install -U matplotlib

Setting up your Project

Head to VSCode, select your new environment, and open up a new Jupyter notebook or a .qmd file in your project folder. The steps below are exactly the same in both cases, simply insert the code in Jupyter chunks in the first case and in .qmd chunks in the latter case.

The first thing you have to do before starting your data analysis workflow is to set the YAML header containing the metadata of your data science project. If you’re opting for a Jupyter notebook, you’ll need to insert it in a raw chunk at the very beginning of your notebook (see the example notebook for more details). In the case you’re running with a .qmd setup, simply copy put it at the top of your file.

---
title: Running Stata within a Jupyter Notebook and Rendering to HTML with Quarto.
author: Bernhard Bieri
date: "09-02-2022"
theme: "cosmo"
format: html
---

The next step is to import the PyStata package located in the install folder of your Stata distribution with the stata_setup.config() function. Simply run the following code chunk after inserting the YAML. Note that you need to specify the Stata version you have installed on your system. .

# Setup Stata from within Python
import stata_setup
stata_setup.config("C:/Program Files/Stata17", "be")

After this you are good to go!

Running the Analysis

You can now import your data with your standard Python commands, clean them within Python before running your analysis and produce tables or graphical outputs with your favorite Stata commands.

See the following Jupyter notebook example and .qmd example for a complete workflow & output into HTML!

Previewing and Rendering your Project

Rendering your report is a one click/one line thing! If you have VSCode and the Quarto extension installed, simply hit render in the menu bar as indicated on the screenshots below. This will execute all the code chunks in the background and weave together tables, graphs, and text. It will then open up a preview in a dedicated tab and save your final output in your root folder.

Bonus Tip: You can hit the CTRL/CMD + Shift + K key-binding to render your report even faster. It works for both Jupyter notebooks and .qmd files.

rendercommands

livepreview

Reuse

CC BY-SA 4.0

Citation

For attribution, please cite this work as:

Bieri, Bernhard. 2022. “Literate Programming in Stata.” August 25, 2022. https://bernhardbieri.ch/blog/2022-08-25-litteralprogramminginstata/.

Introducing Branches to your {blogdown} Workflow

Bernhard Bieri — Wed, 10 Aug 2022 00:00:00 GMT

This is a quick tips & tricks post I decided to write after switching my personal website to the Hugo Apero theme by using this excellent guide by Silvia Canelon. In it, she describes how she uses branches to switch from one theme to the other without breaking the initial site. The original idea came from the following Twitter thread by the following Tweet by Garrick Aden-Buie and leverages what is known as “Branch Deploys” on Netlify.

Previously, I used to write my entire blog post, served it locally to make sure it rendered correctly, and published it on the main branch of my repository. This in turn triggered a build instruction on Netlify which built the site with the new post. While this workflow is fine for simple blogs with a single author, I ended up switching to using branches to compartmentalize individual blog posts, render them on a branch deploy on the web to see the final product and to avoid breaking the main site while experimenting things on branches.

Hence, I switched to the following workflow to write new content:

Head to the site’s settings on Netlify and activate branch deploys for all branches.
Create a new branch titled after the blog post I want to write
Create a new blog post using blogdown::new_post()
Write the actual post
Commit and push the changes on the new branch

And that’s already it!

NB: I am unsure why but when selecting specific branches of my repository the branch deploys did not work when I pushed changes to GitHub.

Reuse

CC BY-SA 4.0

Citation

For attribution, please cite this work as:

Bieri, Bernhard. 2022. “Introducing Branches to Your {Blogdown} Workflow.” August 10, 2022. https://bernhardbieri.ch/blog/2022-08-10-branchesblogdown/.

Coursedown: a blogdown template for courses

Bernhard Bieri — Wed, 02 Feb 2022 00:00:00 GMT

The philosophy behind this template ?

Many lecturers, professors and R-aficionados have great scripts living a peaceful but very lonely life on their machines. While they sometimes get shared on the likes of Moodle or via Dropbox, they rarely get the chance of living on a dedicated website since there is often a non-negligible upfront cost in setting it up. This is exactly where {coursedown} comes in! Designed to minimize the time banging one’s head over CSS styling options or HTML building blocks, it allows its users to create a content-centric website for their course in less than an hour.

Before we get started, let me give a shoutout to both Alison Hill’s great Share Blogdown site and Andrew Heiss’ awesome course websites which inspired me to create this template! Go check them out!

Let’s get started!

We’ll assume that you already have the necessary accounts and software installed for a standard {blogdown} site. If not, you can get started by reading this tutorial or this one. It will also assume that you are somewhat familiar with the blogdown {blogdown} publishing workflow. If you need a quick refresher, read this great post.

There are essentially three main steps to setting up your site: fork, customize, and share!

Fork

The first step in setting up your site is to “fork” it from the {coursedown}repository. Note here that the {coursedown} repository has a special structure since it actually is a template repository! Hence the only thing you need to do is to click on the green “Use this template” button and select a name for your repository.

usetemplate

createrepository

Once the repository is created, clone it to your local machine with your Git client. Then, set up the description, the title and the README of your repository to reflect the information of your course. When your repository is set up on GitHub, head to Netlify and deploy your site by linking it to their services. Note that a free plan should be more than enough to cover your needs.

netlifyaddsite

netlifyaddsite2

You should not have to change anything in the following site settings. Once once you’re done, click deploy!

netlifyaddsite3

After waiting a minute or two to let Netlify build your site, you’ll now be able to access your {coursedown} site online with an automatically generated link shown on the Netlify settings page of your site. Congrats! Your site is now online.

Customize

It’s time to make the site yours by filling it with content! Start by editing the different files in the config/_default/ directory. These files contain mostly the metadata of your site. All files contain comments explaining the function of the different YAML selectors. If something remains unclear, feel free to open an issue on the {coursedown} repo.

The next step is to look at the content directory. As its name suggests, you’ll be able to edit the content of your site here such as the building blocks of your landing page, the posts section you’ll use to organize weekly classes and further metadata about the authors of the site. Let’s start by editing the latter. Head to the content/authors/admin/_index.md file and edit it to make it your own.

Once this is done, check out the content/courses folder. You guessed it, this is where this course lives! These courses are mainly meant as additional resources for students where you can link useful resources for them to learn R or mini scripts on how to perform basic data manipulation tasks for example. Feel free to remove the ones included with the template and add your own!

The content/home folder contains all the building blocks of the main landing page. By default, the {coursedown} template uses the hero.md block with a parralax effect and an additional custom outline.md block. Edit the former to add the course title displayed on the landing page, the course code and describe it in a few words. You can also add an R style course logo if you’re feeling fancy! Simply add the image to the content/home folder and link it in the hero.md file. Note that you should not need to edit the outline.md file as it’s contents were already edited in the config/_default/params.yaml file. Finally, if you want to add a widget present in the original wowchemy template, simply add it in this folder and edit it ¹.

It’s time to create your weekly classes! Head over to the content/post folder and edit/add posts for each one of your course sessions. Each folder contains a featured image and the index.Rmarkdown file that you can edit. Feel free to sumarise the contents you plan on covering during the week in this file and do not forget to create links to your resources (labs and slides) in the yaml header. You could also add hyperlinks to the readings you plan on covering this week to make it even easier for students to access the resources.

The final step in the content folder is to edit the privacy and the terms and conditions page if you’d like to add one. Check out this EU resource to learn more about writing a GDPR compliant privacy notice.

You’re almost done! It’s now time to add the mantlepiece of your site, the slides and the scripts you prepared for your course and have linked in the content/post directory. These can be easily added to the content/static folder in their corresponding folder. It’s as easy as drag and drop! Take a moment to look at how I integrated the {iheiddown} presentations and some labs borrowed from Alison Hill’s Sharing on short notice template for illustration purposes and make them your own (these will be replaced with coursedown’s own labs shortly). Finally, note that the static folder also holds all other static resources such as pdf’s and images.

Wrapping up and going further

Congratulations! You’ve come to the end of this quick tutorial and should now have a brand new course website set up. Feel free to email me if you have any feedback or issues with the site. You can also open an issue on the GitHub repository. Head over to the {coursedown} to learn more!

Footnotes

You can find them in the themes directory if needed.↩︎

Reuse

CC BY-SA 4.0

Citation

For attribution, please cite this work as:

Bieri, Bernhard. 2022. “Coursedown: A Blogdown Template for Courses.” February 2, 2022. https://bernhardbieri.ch/blog/2022-02-02-coursedown-a-blogdown-template-for-courses/.

ERGMs and Co-Offending: an Applied Social Networks Project

Bernhard Bieri — Wed, 15 Dec 2021 00:00:00 GMT

Introduction

This blog post constitutes the second part of the course evaluation of a social networks class I took while pursuing my masters’ in International Economics at IHEID. We have explored the process of describing a network in a previous post that you can read here. Instead, we will focus on understanding why certain patterns of ties are more likely to appear than others. Since we have cross-sectional data, we’ll use an Exponential family of Random Graph Model (ERGM).

Introducing the data

The dataset that we will use to illustrate ERGMs in this post is a cross-sectional dataset on co-offending patterns of an inner city street-gang that was observed between 2005 and 2009. The data can be accessed here under the London Gang section (Grund and Densley 2015). Let’s take a look at the data!

########################### Import data ########################################
# Import adjacency matrix
gangs <- as.matrix(read.csv("LONDON_GANG.csv")[,-1])

# Import list of attributes
gangs_attr <- read.csv("LONDON_GANG_ATTR.csv")[,-1]

# Check out the data
skimr::skim(gangs_attr)

Variable type: numeric

skim_variable	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
Age	1	19.83	2.69	16	18	19	21.00	27	▇▇▃▂▂
Birthplace	1	2.44	0.96	1	2	3	3.00	4	▃▃▁▇▂
Residence	1	0.37	0.49	0	0	0	1.00	1	▇▁▁▁▅
Arrests	1	9.91	6.44	0	5	8	14.75	23	▅▇▃▃▃
Convictions	1	4.20	3.66	0	1	3	7.00	13	▇▆▂▃▂
Prison	1	0.44	0.50	0	0	0	1.00	1	▇▁▁▁▆
Music	1	0.17	0.38	0	0	0	0.00	1	▇▁▁▁▂
Ranking	1	3.46	0.82	1	3	4	4.00	5	▁▂▅▇▁

The data is comprised of two .csv documents. The first one contains an adjacency matrix describing the co-offending patterns of two individuals in the network. The second one provides us with more information about the individual nodes in the form of different attributes, such as the age or the ethnicity (measured by birthplace) of the individuals in the network for example.

The theoretical intuition behind co-offending

A sound theoretical understanding of the theory underpinning the sociological study of criminality is required before considering network models. Without going into too much detail, one can summarize the key relevant elements in the criminal sociology literature as follows:

Co-offending patterns vary among types of crime. Co-offending is more a characteristic of juvenile than adult criminality and is often short-lived. Co-offenders tend to have many accomplices as a consequence. (Reiss Jr 1988)
Gangs form as a result of a convergence of collective interests and then form a social identity and a group structure through the repeated interaction between individuals (Papachristos, Hureau, and Braga 2013; Wasserman, Faust, et al. 1994).
Grund and Densley therefore argue that it is important to conceptualize the gang as a network to shed light into the patterns driving the organisational structure of the network, most notably the role of homophily in co-offending patterns (Grund and Densley 2012, 2015).

Note that while this list is not exhaustive by any means, it gives a sufficient overview of the theoretical framework for us to analyse the network in more detail. A more curious reader might want to read the papers by Grund and Densley on which the dataset is based and which provides an excellent overview of the literature (Grund and Densley 2012, 2015).

A primer on ERGMs

Before diving into the data analysis itself, let us remind ourselves of the key elements of the theory of ERGMs and why they are helpful in understanding the pattern of ties in this cross-sectional network. The guts of the model can be intuitively explained by looking at the components of the following function:

Where:

is the probability of observing network conditional on the weighting parameter
can be broken down into:
- a vector of network characteristics such as node attributes or network properties (think homophily, transitivity, etc.)
- which is a vector of coefficients corresponding to the network characteristics we included in the vector.
is a normalizing constant.

However note that the normalizing constant can become very large depending on the included characteristics and the size of the network as is apparent in the following equation:

That’s a lot of networks to estimate, even if the number of vertices is relatively small! We’ll therefore use a Markov Chain Monte Carlo estimation technique which (if it behaves well) generates a stationary distribution of graphs with the right characteristics . This process should generate a distribution with low autocorrelation (between generated networks) and provides a representative distribution of the sample space.

Finally, let us make a rapid comment about Network Linear Regression models and why they are not ideal to answer the question at hand. While they can provide insight about the impact of homophily in tie formation, they take random networks of the same size as a baseline. The main point Grund and Densley make is that the impact of adding transitivity (a measure of network structure rather than attributes) to the baseline may lead to a reduction of the pure effect of homophily in co-offending patterns. In a nutshell, omitting network structure from the baseline graphs, leads to a positive bias of homophily on co-offending due to the fact that if an individual offends with two people, it is more likely that these two co-offenders offend together as well. Since MRQAP designs cannot incorporate transitivity measures, the authors turned to ERGMs.

Getting a first look at the graph

After having gone trough this theoretical introduction, we can confidently move forward with our analysis by importing our networks in the various formats ({igraph}, {tidygraph}, and {network}), visualizing it and describing the main features of the network. Note that a particular focus will be given on exploring homophily due to the theoretical considerations laid out above. Note that for the analytical purposes, we have generated a vector of random names and named the different vertices, these names are not in the original dataset! Finally, note that the authors have removed 6 nodes from the original network which we were not able to identify. This will lead to different results in the analytical part where we run the ERGMs and try to replicate their findings.

Homophily in Criminal Networks in 2D (hover over me!)

Homophily in Criminal Networks in 3D (turn me!)

Just like the authors (Grund and Densley 2015), we observe a certain level of homophily along ethnic lines. In other words, individuals in this network, seem to tend to co-offend more frequently with members of the same origin.

Laying out the hypotheses and taking a closer look at homophily

Before moving to the inferential analysis with an ERGM, let us investigate the role of homophily in the network beyond the simple visual inspection above (Grund and Densley 2015). We will therefore start by looking at the three central hypothesis that we will try to test with the ERGM models (Grund and Densley 2015):

“Gang members are more likely to offend with each other when they have the same ethnic background.”
“Triad closure accounts for some ethnic homogeneity in co-offending in gangs.”
“Gang members are even more likely to offend with each other when they have the same ethnic background AND share another co-offender from the same ethnic background.”

In the following graph, we see that walktrap clustering seems indeed to be happening along ethnic lines again. At this point we could run an MRQAP or network linear regression but as explained at the end of the theoretical part above, the main point of the authors is to show that the structure of the network biases naive estimates of homophily. Thus we’ll move onto the more elaborate ERGM models.

Running the Exponential family Random Graph Model (ERGM)

On table 2 (p.362) of the paper, the authors present four ERGM models that can be summarized in term of included RHS network characteristics as follows:

Model 1: Edge count and homophily (ethnicity)
Model 2: Edge count, homophily (ethnicity), and triadic closure (GWESP, fixed decay parameter at 0)
Model 3: Edge count, homophily (ethnicity), triadic closure (GWESP, fixed decay parameter at 0), and ethnicity dummies
Model 4: Edge count, homophily (ethnicity), triadic closure (GWESP, fixed decay parameter at 0), ethnicity dummies and a custom interaction term between triadic closure and homophily computed using simulations.

The present post focuses essentially on the first three models which correspond to the second, third and fourth model in the table below. We simply added an additional “super naive model” containing only an edge count on the RHS as our first model. We report and interpret goodness of fit statistics on the third model below. Finally note that we will unfortunately not get the exact same results as the authors since their sample only contains 48 individuals instead of the full 54 they include in the dataset.

To get familiar with the coefficient interpretation, let us start by considering the naive model where we only included an edge count on the RHS of the ERGM. As we saw above, we need to transform the edge coefficient slightly before interpreting it since the reported coefficients are conditional log-odds of the existence of a tie. This process is similar to the interpretation of logit models. Following the transformation (outlined in the code below), we can interpret the coefficient as adding one more tie changes the log-odds (conditional on all other parameters) of the presence of a tie by . Unsurprisingly, we see that the coefficient corresponds to the density of the network (i.e. the proportion of potential ties that are actually present in the graph). In our case, we would interpret this coefficient as the “constant” of our regression model.

	Untransformed	Transformed	Density
edges	-1.264933	0.2201258	0.2201258

Now that we know how to interpret the coefficients, it is time to look at the goodness of fit (GOF) measures that run simulations and show us how well our model captures the characteristics of the observed network. We start by taking a visual comparison between the observed network and a simulation. We immediately note that the observed network is much denser and does not capture the characteristics of our observed network very well.

After getting this visual intuition, we proceed to check the GOF quantitatively. Thankfully, the {ergm} package has a nifty function that automates the simulations and returns some key metrics that we can use to decide whether our model fits the data. In this case, the results confirm the visual inspection we did above. We compare the first moment estimates of the simulated networks (in blue) with the actual observed value (in black) in every graph. Simply put, a good fit is indicated by an overlap of the two lines. We are thus underestimating low and high degrees and overestimating medium ones. Furthermore, low edge-wise shared partners seem to be overestimated while high ones are underestimated. The triad census measure seems to be underestimated for 0 closure and 2 and overestimated for 1 and 3. All in all, we see that our naive model is not a very good fit at all!

Let us therefore proceed to estimate the more complex models that the authors suggest (Grund and Densley 2015) to see whether more complex structural elements are at play here. We will interpret the various models in the following lines before turning to the GOF diagnostics in the next section. Consistent with the authors, we see that homophily plays a significant role in the tie formation process/co-offending in all three specifications. Having a positive coefficient here implies that individuals tend to co-offend with others of the same ethnicity, confirming earlier results of the authors (Grund and Densley 2012). This confirms the first hypothesis we laid out above. Secondly, we see that triad closure defined as a GWESP measure with zero decay. positively impacts the probability of a tie and is significant throughout the specifications. This implies that if an individual offends with two others, the latter are more likely to offend together. Note that this result does not allow us to confirm the second hypothesis of the authors since the point estimate of the homophily coefficient does not change. This in turn is likely a factor of considering the full sample where they only considered 48 out of the 54 individuals in the paper. The third and final specification contains attribute dummies to account for “ethnic group effects” (note that the baseline category is West Africa). Adding these effects reinforces both the triad closure and the homophily coefficient. Finally, note that we cannot confirm or deny the third hypothesis we laid out above since we were not able to replicate the creation of the new interaction statistic between triad closure and homophily. AIC and BIC both indicate that the last model has the lowest prediction error f the four. We will therefore move forward by considering this model in the GOF checks.

ERGM results table
	Naive Model	Model 1	Model 2	Model 3
Edges	-1.26^***	-1.38^***	-3.95^***	-3.23^***
	(0.06)	(0.08)	(0.66)	(0.73)
Nodematch(Ethnicity)		0.36^***	0.34^**	0.76^***
		(0.14)	(0.13)	(0.14)
GWESP(decay = 0)			2.32^***	2.30^***
			(0.64)	(0.70)
Carribean				-0.28^**
				(0.13)
U.K.				-0.81^***
				(0.11)
East Africa				0.01
				(0.16)
AIC	1510.47	1505.66	1479.23	1425.89
BIC	1515.73	1516.19	1495.03	1457.49
Log Likelihood	-754.23	-750.83	-736.62	-706.94
^*p < 0.01; ^p < 0.05; ^*p < 0.1

The GOF checks for the third model still indicate that we could do better to fit the model to the observed data as we underestimate low and high degrees and overestimate middle ones. The edge-wise shared partner simulations still overestimate low values and underestimate high ones. Triad census values are better for 0 and 1 but worse for 3 and 4. It is therefore necessary to stress that the authors have reported better GOF estimates for their fourth model which we were not able to compute (see Grund and Densley (2015) p.363).

Conclusion

The main goal of this lengthy post was to walk the reader through an ERGM analysis by providing a practical example in the form of a replication attempt of a paper on the impact of ethnic homophily and triad closure on co-offending patterns (Grund and Densley 2015). We were able to replicate part of the paper and confirm the first hypothesis of the authors as well as infer that triad closure has a significant effect on these tie patterns. Note that we were unfortunately not able to replicate the fourth model the authors estimated nor were we able to determine which 6 nodes were taken out of the sample. This leads our results to be somewhat disappointing. Interesting avenues for further research in the area would include the creation of a panel or time series dataset which would allow us to apply new models such as stochastic actor oriented models or DyNAMs to uncover the dynamic nature of co-offending patterns.

Appendix

########################### Set chunk options ##################################
knitr::opts_chunk$set(eval = TRUE,
                      echo = FALSE,
                      fig.align = "center",
                      # out.width = "95%",
                      fig.path = "static"
                      )
########################### Load packages ######################################
rm(list = ls())
# install.packages(librarian) # If necessary
pkgs <- c("tidyverse", "randomNames",
          "igraph", "skimr", "ergm", "sna",
          "coda", "latticeExtra", "texreg",
          "manynet", "oaqc", "concaveman")
# library(migraph)
librarian::shelf(pkgs)
# Set seed for replicability:
set.seed(2193)
########################### Import data ########################################
# Import adjacency matrix
gangs <- as.matrix(read.csv("LONDON_GANG.csv")[,-1])

# Import list of attributes
gangs_attr <- read.csv("LONDON_GANG_ATTR.csv")[,-1]

# Check out the data
skimr::skim(gangs_attr)
########################### Create graph #######################################
# Create igraph object:
netigraph <- manynet::as_igraph(gangs)

# Generate random names
gen.names <- function(n, ...){
  names <- unique(randomNames::randomNames(n = n, ...))
  need <- n - length(names)
  while (need > 0) { 
    names <- unique(c(randomNames::randomNames(n = need, ...), names))
    need <- n - length(names)
    }
  return(names)
}
gangmemnames <- gen.names(ncol(gangs), which.names = "first")

gangs_attr$ethnicity <-
  dplyr::if_else(gangs_attr$Birthplace == 1, "West Africa",
                 dplyr::if_else(gangs_attr$Birthplace == 2, "Caribbean",
                                dplyr::if_else(gangs_attr$Birthplace == 3, "UK",
                                               "East Africa")))

# Add attributes to the network
V(netigraph)$name <- gangmemnames
netigraph <- netigraph %>%
  igraph::set.vertex.attribute(name = "age", value = gangs_attr$Age) %>% 
  igraph::set.vertex.attribute(name = "birthplace", value = gangs_attr$Birthplace) %>%
  igraph::set.vertex.attribute(name = "ethnicity", value = gangs_attr$ethnicity) %>%
  igraph::set.vertex.attribute(name = "residence", value = gangs_attr$Residence) %>%
  igraph::set.vertex.attribute(name = "arrests", value = gangs_attr$Arrests) %>%
  igraph::set.vertex.attribute(name = "convictions", value = gangs_attr$Convictions) %>%
  igraph::set.vertex.attribute(name = "prison", value = gangs_attr$Prison) %>% 
  igraph::set.vertex.attribute(name = "music", value = gangs_attr$Music) %>%
  igraph::set.vertex.attribute(name = "ranking", value = gangs_attr$Ranking)
  
## Notes related to the definition of the vertex attributes: ##
# - Age of the individual
# - Birthplace of the individual:
#   - 1 = West Africa
#   - 2 = Caribbean
#   - 3 = UK
#   - 4 = East Africa
# - Residence: Dummy
# - Arrests: Number of arrests
# - Conviction: Number of convictions
# - Prison: Dummy Has been to prison?
# - Music: Likes music
# - Ranking: Dummy

## Notes related to the definition of the edge attributes: ##
# - 1 (hang out together)
# - 2 (co-offend together)
# - 3 (co-offend together, serious crime)
# - 4 (co-offend together, serious crime, kin)

## Convert to other formats for further processing##
# {tidygraph} for pretty vizualisations
nettidy <- manynet::as_tidygraph(netigraph)
# {network} for running ERGMs
netnetwork <- manynet::as_network(netigraph)
########################## Initial Visualizations ##############################
# With networkD3
# Convert to networkD3 consistent object
netnetd3 <- networkD3::igraph_to_networkD3(netigraph,
                                           group = V(netigraph)$ethnicity)
# Add node size attribute as the number of arrests
netnetd3$nodes$size <- V(netigraph)$arrests
# Render
networkD3::forceNetwork(Links = netnetd3$links,
                        Nodes = netnetd3$nodes,
                        Source = 'source',
                        Target = 'target',
                        NodeID = 'name',
                        Group = 'group',
                        Nodesize = 'size',
                        colourScale =
                          networkD3::JS("d3.scaleOrdinal(d3.schemeCategory10);"),
                        linkDistance = 75,
                        fontSize = 18,
                        legend = TRUE,
                        opacity = 0.8)
# With threejs
# Step 1 Define a palette:
pal <- iheiddown::iheid_palette("SDGs", length(unique(V(netigraph)$ethnicity)))
netthreejs <- netigraph%>%
  igraph::set.vertex.attribute(name = "size", value = gangs_attr$Arrests/3) %>%
  igraph::set.vertex.attribute(name = "color",
                       value = pal[vertex_attr(netigraph, "birthplace")])
# Render
threejs::graphjs(netthreejs,
                 layout = igraph::layout_with_fr(netthreejs,
                                                 dim = 3),
                 bg = "#DAD7CD")

# Graph Density:
density <- migraph::graph_density(netigraph)
# 0.2201258

# Compute the Blau Index
# Definition:
# Probability that two entities taken at random from the dataset of interest
# (with replacement) represent the same type
#  This index reaches its minimum value (0) when there is no variety,
#  that is to say, when all individuals are classified in the same category.
#  Since the index is normalized to the 0 to 1 range, when equal to 1 it means
#  that there is certainty of observing the same attribute value when taking
#  two nodes at random
blauEthnicity <- migraph::graph_blau_index(netigraph, "ethnicity") # 0.691358

# Are certain groups more diverse than others?
nettidy <- nettidy %>%
  mutate(wt_group = membership(cluster_walktrap(nettidy)))
lbb <- graphlayouts::layout_as_backbone(nettidy)
pal1 <- iheiddown::iheid_palette("SDGs",
                                 length(unique(membership(cluster_walktrap(nettidy)))))
# Graphically
ggraph::ggraph(nettidy,
               layout = "manual",
               x = lbb$xy[, 1],
               y = lbb$xy[, 2]) +
  ggraph::geom_edge_link0(col = 0, width = 0.2, alpha = 0.25) +
  ggraph::geom_node_point(aes(color = ethnicity,
                              shape = as.factor(membership(cluster_walktrap(nettidy)))),
                          size = 3) +
  ggforce::geom_mark_hull(
    aes(x,
        y,
        group = membership(cluster_walktrap(nettidy)),
        fill = pal1[membership(cluster_walktrap(nettidy))]),
    concavity = 4,
    expand = unit(2, "mm"),
    alpha = 0.25,
    show.legend = FALSE) +
  ggplot2::labs(color = "Ethnicity",
                shape = "Cluster",
                title = "Walktrap clusters and ethnicity",
                subtitle = "Individuals with the same ethnic background seem to co-offend together.",
                caption = "Source: Grund and Densley (2015)") +
  ggraph::theme_graph() +
  ggplot2::theme(plot.caption = element_text(color = "grey20",
                      face = "italic"),
                      plot.title = element_text(size = 14),
                      plot.subtitle = element_text(color = "grey20",
                      face = "italic",
                      size = 9),
                 plot.background = element_rect(fill = "#DAD7CD"))

# Quantitatively: <- Blau Index within a cluster
blaucluster <- migraph::graph_blau_index(nettidy,
                          "ethnicity",
                          "wt_group")
# Cluster 1 Cluster 2 Cluster 3 Cluster 4 Cluster 5 Cluster 6 
# 0.4687500 0.6122449 0.6938776 0.3200000 0.0000000 0.4444444
#                                       Small cluster

####### Model 1: Standard ERGM with only an edgecount -> our baseline ##########
ergm1 <- ergm::ergm(netnetwork ~ edges)

# Log-likelihood
ergm1mle <- ergm1$mle.lik

# Coefficients
coefs1 <- data.frame(ergm1$coefficients,
                     exp(ergm1$coefficients) / (1 + exp(ergm1$coefficients)),
                     migraph::graph_density(netigraph))
colnames(coefs1) <- c("Untransformed", "Transformed", "Density")

knitr::kable(coefs1)

# Coefficients have to be reexpressed as the conditional log-odd of a tie
# occurring. In this case it is equivalent to the density by construction.
# Goodness of fit of the model -> is it a good model?
# Let's look at it visually:
ergm1.sim <- simulate(ergm1)
par(mfrow = c(1,2)) # This command enables side-by-side comparison.
plot(netnetwork, main = "Observed")
plot(ergm1.sim, main = "Simulated")
par(mfrow = c(1,1))

# Mhh one can spot differences between the two graphs, the simulated one being
# more dense than the observed network. Let's use the `statnet::gof()` function
# to get more advanced diagnostics.
ergm1.gof <- gof(ergm1,  GOF = ~ degree + triadcensus + espartners
                 + distance - model)
par(mfrow = c(2,3))
plot(ergm1.gof, plotlogodds = T)
par(mfrow = c(1,1))

# Goodness of fit measures of *non-included* network level, node level or dyad
# level measures.
# We look at this after running our model and checking whether the MCMC generated
# networks have indeed the same characteristics than the one we observe.
#
# One test of whether a local model “fits the data” is therefore how well it
# reproduces the observed global
# network properties that are not in the model. We do this by choosing a
# network statistic that is not in the
# model, and comparing the value of this statistic observed in the original 
# network to the distribution of values
# we get in simulated networks from our model, using the gof function.
# The gof function is a bit different than the summary, ergm, and simulate
# functions, in that it currently
# only takes 3 ergm-terms as arguments: degree, esp (edgewise share partners),
# and distance (geodesic distances).
# Each of these terms captures an aggregate network distribution, at either
# the node level (degree), the edge
# level (esp), or the dyad level (distance).
# 
# From page 32 of the EGRM package manual.
# 
# Conclusion, our simple model is really not a good fit! We are underestimating
# low and high degrees and over estimating medium ones. Furthermore, low
# edge-wise shared partners seem to be overestimated while high ones are
# underestimated. The triad census measure seems to be underestimated for 0
# closure and 2 and overestimated for 1 and 3. All in all, we see that our
# baseline model is not a good fit! Let's try to follow the Grund and Dempsey
# to see the result of their model specification.

# Models p.362 paper

# IMPORTANT: the network they consider in their 2015 paper is missing 6
# individuals (no reason was mentioned in the paper). Since we can't
# infer which individuals were removed from the network, we will not get the
# same results as the authors. Hopefully though, this will not impact
# the interpretation too much. Let's estimate away!
# Model 1
ergm2 <- ergm::ergm(netnetwork ~ edges + nodematch("ethnicity"))
coefs2 <- ergm2$coefficients
# Model 2
ergm3 <- ergm::ergm(netnetwork ~ edges + nodematch("ethnicity") +
                      gwesp(0, fixed = TRUE))
coefs3 <- ergm3$coefficients
# Model 3
ergm4 <- ergm::ergm(netnetwork ~ edges + nodematch("ethnicity") +
                      gwesp(0, fixed = TRUE) +
                      nodefactor("birthplace"))
coefs4 <- ergm4$coefficients
# Getting the results from model 3 into a table:
texreg::knitreg(list(ergm1, ergm2, ergm3, ergm4),
                center = TRUE,
                caption = "ERGM results table",
                custom.coef.names = c("Edges", "Nodematch(Ethnicity)",
                                      "GWESP(decay = 0)", "Carribean", "U.K.",
                                      "East Africa"),
                custom.model.names = c("Naive Model", "Model 1", "Model 2",
                                       "Model 3"),
                stars = c(0.01, 0.05, 0.10))

# Goodness of fit: -----
# The authors only provide information of the goodness of fit check for the
# fourth model. Since we don't compute it here, we'll simply do the GOF on the
# third model.

# Model 3: GOF
ergm4.gof <- ergm::gof(ergm4,
                       GOF = ~ degree + triadcensus + espartners +
                         distance - model)
par(mfrow = c(2,3))
plot(ergm4.gof, plotlogodds = T) # Add the argument "plotlogodds=T" here to rescale
par(mfrow = c(1,1))
################################
## Citing all loaded packages ##
################################
# knitr::write_bib(c(.packages(), "blogdown"), "packages.bib")

References

Cover photo by Nastya Dulhiier on Unsplash

References

Grund, Thomas U, and James A Densley. 2012. “Ethnic Heterogeneity in the Activity and Structure of a Black Street Gang.” European Journal of Criminology 9 (4): 388–406.

———. 2015. “Ethnic Homophily and Triad Closure: Mapping Internal Gang Structure Using Exponential Random Graph Models.” Journal of Contemporary Criminal Justice 31 (3): 354–70.

Papachristos, Andrew V, David M Hureau, and Anthony A Braga. 2013. “The Corner and the Crew: The Influence of Geography and Social Networks on Gang Violence.” American Sociological Review 78 (3): 417–47.

Reiss Jr, Albert J. 1988. “Co-Offending and Criminal Careers.” Crime and Justice 10: 117–70.

Wasserman, Stanley, Katherine Faust, et al. 1994. “Social Network Analysis: Methods and Applications.”

Reuse

CC BY-SA 4.0

Citation

For attribution, please cite this work as:

Bieri, Bernhard. 2021. “ERGMs and Co-Offending: An Applied Social Networks Project.” December 15, 2021. https://bernhardbieri.ch/blog/2021-12-09-ergms-and-co-offending-an-applied-social-networks-project/.

Marvellous Social Networks: an applied project

Bernhard Bieri — Wed, 15 Dec 2021 00:00:00 GMT

This blog post was originally an assignment I completed for a Social Networks class during my Master’s in International Economics at the Graduate Institute of Geneva (IHEID). This first post mostly illustrates the descriptive part of the social networks analysis process describing properties of a network of Marvel character friendships. Happy reading!

If you’d like to follow along, the dataset is available in the excellent {migraph} package.

Question 1: Centrality

This part will focus on answering the following centrality related question: What characters are the ideal candidates for crossover comics in the Marvel universe, in the global sense?

The Marvel universe is comprised of multiple franchises that include but are not limited to the Avengers, the Fantastic Four and the X-Men. The question thus naturally arises which characters are most likely to appear in comics, films or books that span across these franchises. Part of the answer to this question will be revealed in this section by looking at the characters with the highest level of betweenness centrality as these high-betweenness characters (ego) tend to be on the shortest path between two other characters (alters). It is worth mentionning two caveats of this analysis before proceeding further with our analysis. First, when looking at the measure of betweenness centrality, we are considering the global rather than the local structure of the network. Second, the initial ison_marvel_relationships is a signed but unweighted network where the ties either represent a friendly relationship or a rival relationship between characters. On the other hand, the absence of a tie indicates the absence of a relationship between the characters. For the purpose of this first question, we will examine the underlying unsigned network as we are only interested in the existence of a relationship since it indicates some kind of previous interaction in a comic book.

The results are unsurprising, since the top 5 characters in terms of betweenness centrality measure are (in order): Wolverine, Spider-Man, Invisible Woman, Hulk, and Black Panther. These are some of the older Marvel characters and are also some of the characters with the most number of appearances. Out of these top 5 characters, none is a “mainstream” villain¹ and while three are traditional mainstream characters (Black Panther, Spider-Man, and Hulk) the other two come from either the X-Men franchise or the Fantastic Four franchise. This last point leads us to the answer to the question we’re asking in this first part as both Wolverine and the Invisible Woman seem to have enough preexisting back-story in the form of past relationships with other characters to be able to bridge the gap between the different franchises with the most ease.

Warning: There was 1 warning in `dplyr::mutate()`.
ℹ In argument: `across(where(is.numeric), round, 3)`.
Caused by warning:
! The `...` argument of `across()` is deprecated as of dplyr 1.1.0.
Supply arguments directly to `.fns` through an anonymous function instead.

  # Previously
  across(a:b, mean, na.rm = TRUE)

  # Now
  across(a:b, \(x) mean(x, na.rm = TRUE))

Top 5 Nodes: Betweenness
Name	Gender	Appearances	Degree	Betweenness	Closeness	Eigenvector
Wolverine	Male	12751	0.878	0.067	0.817	0.328
Spider-Man	Male	11963	0.837	0.057	0.803	0.308
Invisible Woman	Female	5082	0.837	0.036	0.731	0.342
Hulk	Male	6062	0.878	0.035	0.742	0.353
Black Panther	Male	2189	0.653	0.034	0.721	0.255

Question 2: Community

In this subsection, we will look at the question of structural balance of the network and leverage the {signet} package to look at this issue further. More specifically, we’ll try to answer the following question: How balanced/cognitively consistent is the Marvel Relationship network? This will be interesting in our case since the original dataset is signed, meaning that there is additional binary information on the nature of the tie linking two characters (e.g. whether they are allies or foes). Theorized by the Austrian psychologist Fritz Heider in the mid 20th century Heider (1958), balancedness in a social network is driven by cognitive consistency among an ego and two alters. Cognitive consistency being defined as the absence of contradiction in the nature of the ties that the ego has with its two alters. In our case, Hulk, Iron Man and Thanos are an example of a cognitively consistent and therefore balanced triad. This is due to the fact that Hulk is friends with Iron Man and enemies with Thanos, implying/satisfying (by cognitive consistency) that Iron Man is also an enemy of Thanos. Furthermore, it is interesting to examine this concept of balance in a dynamic setting as attitudes between characters may change over time. For example, Hulk becomes an evil character in one of the universes (we’ll assume that he becomes friends with Thanos for this example). To maintain cognitive consistency in the considered triad, one of two things has to happen. Either Iron Man decides that Hulk is no longer his friend since he is a bad guy who became friends with Thanos (i.e. the friend of my enemy is my enemy) or Thanos and Iron Man become friends and every character becomes a bad guy (i.e. the friend of my friend is my friend from Thanos’ perspective).

Type	Count	Balanced?
+++	436	Yes
++-	287	No
+--	944	Yes
---	398	No
Total	2065

Method	Results
Triangles	0.668
Walk	0.071
Frustration	0.858

The {signnet} allowed us to both count the number of balanced/unbalanced triads and to compute different measures of balancedness. At the first glance, when considering the simple counting table, we seem to witness more balanced triads than unbalanced ones. This seems to be consistent with Heiders’ theory as the engine of cognitive consistency would have shaped the relations between the characters dynamically and may still be in the process of shaping. Let’s push our analysis a little further and look at the three metrics {signnet} computes: Triangles, Walk and Frustration. By looking at the results, we notice that the Frustration algorithm and the Triangles one yield consistent results while the Walk algorithm seems to contradict the former two. While this seems strange at first glance, this leads back to the different ways the metrics are computed and the way they frame the degree of balancedness of a network. Without going into too much detail, Estrada’s walk measure takes into account the proximity of imbalanced clusters while the other two are agnostic of this effect Estrada (2019). Conceptually, it’s straightforward to see that close imbalanced clusters are generating more tension than ones that are further away. Thus, the answer to our question is depending on the measure we consider as well as on the underlying theory we use to conceptualize the network with.

In conclusion, while the cognitive consistency in a social network seems like a natural law, it should be interpreted carefully, especially in our case where cognitive inconsistency may also be desirable since it ” [sometimes] evoke[s], like other patterns with unsolved ambiguities, powerful aesthetic forces of a tragic or comic nature” Heider (1958). Having panel measures of these indexes would certainly cast a light onto the dynamics of these social mechanisms and allow to answer the question at hand in more detail.

Question 3: Position

We have hinted at the difference between the global nature of the concept of betweenness centrality and the local nature of the concept of structural holes in the first part of this paper. This last part will therefore try to answer a slightly different question than in the first part of the paper to illustrate this difference. What characters are the ideal candidates for crossover comics in the Marvel universe, in the local sense?

This slight difference is consequential though as the definition of a cross-over comic is no longer the same as in part 1. Since we are now focusing on the local nature of patterns of ties, we’ll think about cross-over comics as comics where multiple characters “gang up” to fight each other. Note that we’ll consider both heroes and villains in this case as we can’t disaggregate the data accordingly. Thus, a character in a structural hole marked by a low level of constraint, will be the ideal candidate for a movie/comic bridging the universe of multiple other characters within a franchise (e.g. the Avengers). This indicates that Spider-Man, Worlverine, Black Panther, Hulk and Iron Man seeom to be the ideal candidates for such a role. Importantly, note that this is different from the conclusion that we drew in the discussion on centrality in the first part as betweenness highlights characters that were ideally placed to span across multiple franchises of the entire Marvel Network.

Finally, an interesting albeit tangential clue that we get from examining the node constraint measure is that many villains (4 out of 5 in the top 5) seem to find themselves in a part of the network with strong ties (e.g. a high level of constraint). This inverse correlation reflects the fact that villains are more likely to gang up against a hero than a hero is against a single enemy.

Head and Tail Nodes: Constraint
Name	Gender	Appearances	Constraint	Betweenness	Hero?
Ant-Man	Male	589	0.262	0.001	Yes
Emma Frost	Female	4777	0.25	0	Both
Blade	Male	438	0.223	0	Both
Kingpin	Male	1323	0.211	0.002	No
Bullseye	Male	898	0.196	0.001	No
...	...	...	...	...	...
Iron Man	Male	8579	0.102	0.027	Yes
Hulk	Male	6062	0.1	0.035	Yes
Black Panther	Male	2189	0.097	0.034	Yes
Wolverine	Male	12751	0.094	0.067	Yes
Spider-Man	Male	11963	0.093	0.057	Yes

Image credits:

Photo by Erik Mclean on Unsplash

Appendix:

This appendix does not contain any additional content. It’s only function is to print the echoes of the code used to handle, measure and visualize the networks in the previous three sections in an effort to ensure transparency and replicability of our code.

Okay I lied, it actually does one more thing, it tries to remotivate the reader who made it that far with a little randomly generated quote (courtesy of the {dang} package).

'Success is not final, failure is not fatal. It is the courage to 
continue that counts.'  Winston Churchill

And an additional graph to visualize the signed network for question 2:

# Set initial knitr options
knitr::opts_chunk$set(eval = TRUE, echo = FALSE,
                      fig.align = "center",
                      fig.asp = 0.7,
                      dpi = 300,
                      out.width = "80%",
                      fig.pos = "!H",
                      out.extra = "")
rm(list = ls())   # Clean Environment
#********************* Package Management *************************************#
library(migraph)  # Development version 29.10.2021
library(igraph)     # Latest version
library(ggraph)
library(signnet)
library(tidygraph)
library(tidyverse)  # All things data science
library(dang)       # For fun

#***************************** Load data  *************************************#
relationships <- manynet::ison_marvel_relationships
teams         <- manynet::ison_marvel_teams
# Set both objects to the same class to be more consistent
class(relationships) # "tbl_graph" "igraph"
class(teams)         # "igraph"
relationships <-  manynet::as_igraph(relationships)
teams         <- manynet::as_igraph(teams)
# relationships # Relationship network, Unimodal
# teams         # Teams network, Bipartite: teams and individuals

# Initial visualisations
manynet::autographr(relationships)
manynet::autographr(teams)

# Initial visualisation for relationships dataset shows three (unrealistic)
# isolates. Let's drop them.
# PS: Luke Cage and Iron Fist are friends in the MU
isolates <- which(degree(relationships) == 0)
relationships <- delete.vertices(relationships, isolates)

# Note that the relationships network is signed. We can separate the network
# between friends and enemies.

friends <- manynet::to_unsigned(relationships, "positive")
ennemies <- manynet::to_unsigned(relationships, "negative")
#***************************** Question 1  ************************************#

# We'll use the relationships network for this one
# Note that this is a signed network! +1 indicates a friendship tie and -1
# an enemy tie.

relDFnode <- igraph::as_data_frame(relationships, "vertices")
relDFedge <- igraph::as_data_frame(relationships, "edges")

# Create a dataframe with the different centrality measures of every node
centralityFullDF <- dplyr::tibble(
  name         = igraph::get.vertex.attribute(relationships)$name,
  degree       = migraph::node_degree(relationships),
  betweenness  = migraph::node_betweenness(relationships),
  closeness    = migraph::node_closeness(relationships),
  eigenvector  = migraph::node_eigenvector(relationships)) %>%
  arrange(
    desc(betweenness)
  )
# centralityFullDF

# Let's focus on relations rather than friends to explore which characters
# bridge universes
relUnsigned <- igraph::remove.edge.attribute(relationships, "sign")
# For the graph let's revert to a tidygraph object and add node level centrality
relUnsigned <- manynet::as_tidygraph(relUnsigned) %>%
  mutate(degree       = migraph::node_degree(relUnsigned),
         betweenness  = migraph::node_betweenness(relUnsigned),
         closeness    = migraph::node_closeness(relUnsigned),
         eigenvector  = migraph::node_eigenvector(relUnsigned))

# DF for top 5 table output
centralityRelationDF <- dplyr::tibble(
  name         = igraph::get.vertex.attribute(relUnsigned)$name,
  degree       = as.numeric(migraph::node_degree(relUnsigned)),
  betweenness  = as.numeric(migraph::node_betweenness(relUnsigned)),
  closeness    = as.numeric(migraph::node_closeness(relUnsigned)),
  eigenvector  = as.numeric(migraph::node_eigenvector(relUnsigned)))
# Perform inner join on node characteristics and  centrality measures
z <- dplyr::inner_join(igraph::as_data_frame(relUnsigned, "vertices"),
                  centralityRelationDF, "name")
# Get top 5
top5betweenness <-
  head(dplyr::arrange(z, desc(betweenness.y)), 5)[c(1,2,3, 11, 12, 13, 14)]
top5betweenness <- dplyr::rename(top5betweenness,
                                 Name = name,
                                 Degree = degree.x,
                                 Betweenness = betweenness.x,
                                 Closeness = closeness.x,
                                 Eigenvector = eigenvector.x) %>%
  dplyr::mutate(across(where(is.numeric), round, 3))
# Make outtable
kableExtra::kbl(top5betweenness, "html", caption = "Top 5 Nodes: Betweenness") %>%
  kableExtra::kable_styling(position = "center") %>%
  kableExtra::kable_material(full_width = T)
# Set layout
l <- ggraph::create_layout(relUnsigned, layout = "fr")
# Plot graph
ggraph::ggraph(relUnsigned, layout  = l) +
  ggraph::geom_node_point(aes(size  = betweenness,
                              alpha = betweenness,
                              color = Appearances)) +
  ggraph::geom_node_label(aes(filter = betweenness > 39,
                              label  = name),
                          label.padding = 0.15,
                          label.size    = 0,
                          repel         = TRUE) +
  ggraph::geom_edge_link(alpha = 0.05) +
  ggplot2::guides(alpha  = "none") +
  ggplot2::labs(color    = "Appearences",
                size     = "Node Betweenness",
                title    = "Highlighting Betweenness and Appearence",
                subtitle = "What characters are the ideal candidates for crossover comics in the Marvel universe in the global sense?",
                caption  = "Source: {migraph} (2021)") +
  ggplot2::theme_minimal() +
  ggplot2::theme(panel.border     = element_blank(),
                 panel.grid.major = element_blank(),
                 panel.grid.minor = element_blank(),
                 axis.line        = element_blank(),
                 axis.text.x      = element_blank(),
                 axis.ticks.x     = element_blank(),
                 axis.title.y     = element_blank(),
                 axis.text.y      = element_blank(),
                 axis.ticks.y     = element_blank(),
                 axis.title.x     = element_blank(),
                 plot.caption     = element_text(color = "grey20",
                                                 face  = "italic"),
                 plot.title       = element_text(size  = 14),
                 plot.subtitle    = element_text(color = "grey20",
                                                 face  = "italic",
                                                 size  = 9))
#************************* Question 2 *****************************************#
rm(list = ls())
# Back again with the relationships data
relationships <- manynet::ison_marvel_relationships

# Initial visualisation for relationships dataset shows three (unrealistic)
# isolates. Let's drop them.
# PS: Luke Cage and Iron Fist are friends in the MU
isolates <- which(degree(relationships) == 0)
relationships <- delete.vertices(relationships, isolates)
# Set linetypes
edge_linetype <- ifelse(igraph::E(relationships)$sign >= 0,
                        "solid",
                        "dashed")
edge_colour <-   ifelse(igraph::E(relationships)$sign >= 0,
                        "#0072B2",
                        "#E20020")
# Set layout
l <- ggraph::create_layout(relationships, layout = "fr")
# Plot graph
relgraph <- ggraph::ggraph(relationships, layout  = l) +
  ggraph::geom_edge_link0(alpha = 0.4,
                          edge_linetype = edge_linetype,
                          edge_colour   = edge_colour) +
  ggraph::geom_node_point(aes(color = PowerOrigin,
                              alpha = 0.5),
                          size  = 3) +
  ggraph::geom_node_label(aes(filter = name %in% c("Hulk", "Iron Man", "Thanos"),
                              label  = name),
                          label.padding = 0.15,
                          label.size    = 0,
                          repel         = TRUE) +
  ggplot2::guides(alpha  = "none") +
  ggplot2::labs(color    = "Power Origin",
                title    = "Marvel Character Network: Examining the Signs",
                subtitle = "Visualizing network balance",
                caption  = "Source: {migraph} (2021)") +
  ggplot2::theme_minimal() +
  ggplot2::theme(panel.border     = element_blank(),
                 panel.grid.major = element_blank(),
                 panel.grid.minor = element_blank(),
                 axis.line        = element_blank(),
                 axis.text.x      = element_blank(),
                 axis.ticks.x     = element_blank(),
                 axis.title.y     = element_blank(),
                 axis.text.y      = element_blank(),
                 axis.ticks.y     = element_blank(),
                 axis.title.x     = element_blank(),
                 plot.caption     = element_text(color = "grey20",
                                                 face  = "italic"),
                 plot.title       = element_text(size  = 14),
                 plot.subtitle    = element_text(color = "grey20",
                                                 face  = "italic",
                                                 size  = 9))
# We have a network were a +1 tie indicates a friendly raltionship
# and a -1 tie an animosity between two characters

# Step 1: Count the number of triangles
countTriangles <- dplyr::tibble(
  Type = c(names(signnet::count_signed_triangles(relationships)), "Total"),
  Count = c(as.numeric(signnet::count_signed_triangles(relationships)),
                     sum(as.numeric(signnet::count_signed_triangles(relationships)))),
  `Balanced?` = c("Yes", "No", "Yes", "No", ""))

t1 <- knitr::kable(countTriangles,
                align = "c",
                format = "html") %>%
  kableExtra::kable_minimal()
t1
# +++ ++- +-- --- 
# 436 287 944 398 
# The network seems to be more balanced than unbalanced with this quick
# comparaison

# Degree of balancedness:

Balancedness <- dplyr::tibble(
  Method  = c("Triangles", "Walk", "Frustration"),
  Results = c(signnet::balance_score(relationships, method = "triangles"),
              signnet::balance_score(relationships, method = "walk"),
              signnet::balance_score(relationships, method = "frustration"))) %>%
  dplyr::mutate(across(Results, round, 3))
# Make outtable
t2 <- knitr::kable(Balancedness,
                align = "c",
                format = "html") %>%
  kableExtra::kable_minimal()
t2
# Okay, we get quite a different result with the Walk method based on
# Ernesto Estrada measure of balancedness. Let's explain why.
#***************************** Question 3 *************************************#
rm(list = ls())
# Back again with the relationships data
relationships <- manynet::ison_marvel_relationships

# Initial visualisation for relationships dataset shows three (unrealistic)
# isolates. Let's drop them.
# PS: Luke Cage and Iron Fist are friends in the MU
isolates <- which(degree(relationships) == 0)
relationships <- delete.vertices(relationships, isolates)

# DF for top 5 table output
constraintRelationDF <- dplyr::tibble(
  name         = igraph::get.vertex.attribute(relationships)$name,
  constraint   = as.numeric(migraph::node_constraint(relationships)),
  betweenness  = as.numeric(migraph::node_betweenness(relationships)))
# Perform inner join on node characteristics and  centrality measures
z <- dplyr::inner_join(igraph::as_data_frame(relationships, "vertices"),
                  constraintRelationDF, "name")
# Get top 5 table 
bottom5constraint <-
  tail(dplyr::arrange(z, desc(constraint)), 5)[c(1,2,3, 11, 12)] %>%
  dplyr::mutate(across(where(is.numeric), round, 3))
top5constraint <- 
  head(dplyr::arrange(z, desc(constraint)), 5)[c(1,2,3, 11, 12)] %>%
  dplyr::mutate(across(where(is.numeric), round, 3))
top5constraint <- rbind(top5constraint, rep("...", 5))
out <- rbind(top5constraint, bottom5constraint)
rownames(out) <- c()
out$`Hero?` <- c("Yes", "Both", "Both", "No", "No", "...",
                "Yes", "Yes", "Yes", "Yes", "Yes")
out <- dplyr::rename(out,
                     Name = name,
                     Betweenness = betweenness,
                     Constraint = constraint) 
# Make outtable
kableExtra::kbl(out,
                format = "html",
                caption = "Head and Tail Nodes: Constraint",
                align = "c") %>%
  kableExtra::kable_material(full_width = F)
# *********************** Motivational Easter Egg *****************************#
dang::motivate(2)
rm(list = ls())
# Back again with the relationships data
relationships <- manynet::ison_marvel_relationships

# Initial visualisation for relationships dataset shows three (unrealistic)
# isolates. Let's drop them.
# PS: Luke Cage and Iron Fist are friends in the MU
isolates <- which(degree(relationships) == 0)
relationships <- delete.vertices(relationships, isolates)
# Set linetypes
edge_linetype <- ifelse(igraph::E(relationships)$sign >= 0,
                        "solid",
                        "dashed")
edge_colour <-   ifelse(igraph::E(relationships)$sign >= 0,
                        "#0072B2",
                        "#E20020")
# Set layout
l <- ggraph::create_layout(relationships, layout = "fr")
# Plot graph
ggraph::ggraph(relationships, layout  = l) +
  ggraph::geom_edge_link0(alpha = 0.4,
                          edge_linetype = edge_linetype,
                          edge_colour   = edge_colour) +
  ggraph::geom_node_point(aes(color = PowerOrigin,
                              alpha = 0.5),
                          size  = 3) +
  ggraph::geom_node_label(aes(filter = name %in% c("Hulk", "Iron Man", "Thanos"),
                              label  = name),
                          label.padding = 0.15,
                          label.size    = 0,
                          repel         = TRUE) +
  ggplot2::guides(alpha  = "none") +
  ggplot2::labs(color    = "Power Origin",
                title    = "Marvel Character Network: Examining the Signs",
                subtitle = "Visualizing network balance",
                caption  = "Source: {migraph} (2021)") +
  ggplot2::theme_minimal() +
  ggplot2::theme(panel.border     = element_blank(),
                 panel.grid.major = element_blank(),
                 panel.grid.minor = element_blank(),
                 axis.line        = element_blank(),
                 axis.text.x      = element_blank(),
                 axis.ticks.x     = element_blank(),
                 axis.title.y     = element_blank(),
                 axis.text.y      = element_blank(),
                 axis.ticks.y     = element_blank(),
                 axis.title.x     = element_blank(),
                 plot.caption     = element_text(color = "grey20",
                                                 face  = "italic"),
                 plot.title       = element_text(size  = 14),
                 plot.subtitle    = element_text(color = "grey20",
                                                 face  = "italic",
                                                 size  = 9))

References:

Estrada, Ernesto. 2019. “Rethinking Structural Balance in Signed Social Networks.” Discrete Applied Mathematics 268: 70–90.

Heider, Fritz. 1958. The Psychology of Interpersonal Relations. Psychology Press.

Footnotes

NB: we consider only the universe where Hulk doesn’t become a bad character.↩︎

Reuse

CC BY-SA 4.0

Citation

For attribution, please cite this work as:

Bieri, Bernhard. 2021. “Marvellous Social Networks: An Applied Project.” December 15, 2021. https://bernhardbieri.ch/blog/2021-12-15-marvellous-social-networks-an-applied-project/.

Quickstart guide to blogdown

Bernhard Bieri — Sat, 13 Nov 2021 00:00:00 GMT

Hi and welcome to my first post on my new {blogdown} website! This post will walk you through the setup of your very own personal website with wowchemy’s awesome Academic Theme and allow me to try out the functionalities of this new blogging workflow!

The what, the how and the why of blogdown?

The what and the why

{blogdown} is an R package that makes blogging for R users as straightforward as possible. While there is a little bit of an overhead in learning the structure of a site created with this package, it offers in my opinion the easiest way to share code-centric content on the web for non-web developers like me!

The how

The workflow of a {blogdown} website depicted below is almost all automatic and designed to run in the background. While you won’t have to worry about it on most days, it’s useful to take a quick look at how everything works to be able do diagnose the point of failure when an issue eventually arises. A blog post workflow can be described as follows. You’ll edit your code in R-Markdown within R-Studio, then knit that file which will execute the code chunks and render the content of your blog post into a Mardown document. Hugo, an open source website generator, will then render these elements into an HTML website you can preview locally while editing or push to a GitHub repository to deploy. In the last step of the workflow, Netlify deploys your website from your GitHub repository and publishes it. The awesome thing is that all of this happens automatically, which allows you to focus on the content of your website without having to deal with the hassle of deploying your website!

Prerequisites

Netlify, R-Studio, GitHub… If these names don’t sound familiar to you, this section is made for you! Here is a quick run down of what you need to get started:

A GitHub account
- See this quickstart guide
Git
A Git GUI interface (I recommend Fork)
A Netlify account
- Register with and link your GitHub Account
R and R-Studio
The extended version of Hugo
- See this installation guide
The blogdown package

Once you have created all the required accounts and installed the required software you’re ready to progress to the next section!

NB: I found that the easiest way of installing Hugo was through a package manager such as Chocolatey for Windows or Homebrew for macOS or Linux. See the Hugo installation guide for more details.

The setup in 30 minutes

This section will walk you through the creation of your first {blogdown} site in less than 30 minutes!

Step 1: Set up a new GitHub repository

Go to GitHub and set up a new repository with a README.

Set up a GitHub Repo

After creating your repository online, clone it by clicking on the clone button and copy-pasting the link to your Git GUI client (Fork if you followed the instructions above). This visual git interface will serve as an interface between the local version of your code (the one on your computer) and the remote one (the one on GitHub’s servers) via pull/push commands.

Create the project in R-Studio

After successfully cloning your repository to your local machine, open R and create a new project in the folder that you just created by cloning it. This will be the “root” folder of the project from now on.

Creating a new project from an existing direcotry is simply done by navigating to: File > New Project > Existing Directory in R-Studio and pointing to the folder you just created by cloning your GitHub repository.

Create your site and serve it locally

Creating your site is a one liner. Yes you read right, a one line command! Simply open up the project you just created and run the following line where you specify the theme you want to use (wowchemy’s Academic Theme in our case):

library(blogdown)
new_site(theme = "wowchemy/starter-academic")

This line will automatically create the structure of your new website and spit out some initial configuration messages. After you’ve read through them, simply run the following line to serve (read previewing in your browser while editing) your site locally:

blogdown::serve_site()

This will leverage Hugo’s live reload functionality and provide your with a live version of your site in RStudio’s “Viewer” pane. You can easily open this in your browser by clicking on the “Open in new window” button in the viewer pane. Try editing a line in one of the posts in the content > post folder and see how live reload behaves when your save your edits in RStudio.

Now that you have created your site, take the time to scroll through it and check out the different widgets that make up your home page as they will be the building blocks of your site! Once this is done, stop the live server with {r} blogdown::stop_server() and run the following command:

file.edit(".gitignore") # Opens up the .gitignore file

And paste the following elements in this file before saving it:

.Rproj.user
.Rhistory
.RData
.Ruserdata
.DS_Store
Thumbs.db

This will make sure that git does not upload these files when you push to the remote version of your repository. After this is done, let’s check if everything works fine before pushing our changes to GitHub’s servers. {blogdown} has a function for this fortunately! Simply run:

blogdown::check_gitignore() # Checks gitignore
blogdown::check_content()   # Checks content

After taking care of any messages these functions may highlight. You can safely commit and push your changes to GitHub.

Deploy your site to Netlify

The final step to get your site online, after initializing your site in the previous step is to point Netlify to your GitHub repository. Head over to Netlify and log in with your GitHub account. Then, click on New site from Git, select the repository of your site and don’t change any of the site’s settings in the last pane. Finally, click on deploy to release your site.

Netlify will then deploy your site and allocate an automatically generated and often silly URL to it. Don’t worry, you can change it! Simply head over to the Domain settings on your site’s configuration page and buy or import a domain.

Congratulations! Your site is now online and visible to the world!

Cool! My site is online but what now?

The first thing you may want to do is to do a little shakedown of your site. Spend a little bit of time serving your site, browsing through the different widgets, and reading wowchemy’s excellent documentation . While you’re doing this, reflect on what the goal of your site is i.e. what you want to share and how. This will make the configuration process of your site that much easier!

To give you a rough idea on how to start, here was my configuration process:

Opened the config folder and edited the basic configuration of the site.
Commented out the widgets I didn’t need in the config/_menus_default/menus.yaml file.
Edited the .yaml files in the content folder
Added my profile picture under content\authors\admin\avatar.jpg
Added my PDF CV to static/uploads
Added some icons to the assets/media/icons/brands folder
Removed template blog posts
Created this post by running blogdown::new_post()

Customize your site further!

Want to go further? Change the color of this element or increase the font size of that piece of text? Here are some neat documentation sites, blogs and examples!

Sources

Cover image

Reuse

CC BY-SA 4.0

Citation

For attribution, please cite this work as:

Bieri, Bernhard. 2021. “Quickstart Guide to Blogdown.” November 13, 2021. https://bernhardbieri.ch/blog/2021-11-13-quickstart-guide-to-blogdown/.

Bernie's Website

Mapmaking with R and OpenStreetMaps

The artsy application…

…and the less artsy applications:

Epilogue:

Reuse

Citation

Simulating Simpson’s Paradox

Simpson’s Paradox

Simpson’s Case Study

Definition

Theoretical Intuition

Different Forms of the Paradox

Simulations with Non-Categorical Data

Code Appendix

References

Footnotes

Reuse

Citation

Literate Programming in Stata

What Literate Programming Is and Why You Should Care

The Resurgence of Literate Programming in the 2010’s

The Stata-Python-Quarto Workflow for Literate Programming

A Few Prerequisites

Setting up your Project

Running the Analysis

Previewing and Rendering your Project

Further Readings

Reuse

Citation

Introducing Branches to your {blogdown} Workflow

Reuse

Citation

Coursedown: a blogdown template for courses

The philosophy behind this template ?

Let’s get started!

Fork

Customize

Share

Wrapping up and going further

Footnotes

Reuse

Citation

ERGMs and Co-Offending: an Applied Social Networks Project

Introduction

Introducing the data

The theoretical intuition behind co-offending

A primer on ERGMs

Getting a first look at the graph

Laying out the hypotheses and taking a closer look at homophily

Running the Exponential family Random Graph Model (ERGM)

Conclusion

Appendix

References

References

Reuse

Citation

Marvellous Social Networks: an applied project

Question 1: Centrality

Question 2: Community

Question 3: Position

Image credits:

Appendix:

References:

Footnotes

Reuse

Citation

Quickstart guide to blogdown

The what, the how and the why of blogdown?

The what and the why

The how

Prerequisites

The setup in 30 minutes

Step 1: Set up a new GitHub repository

Create the project in R-Studio

Create your site and serve it locally

Deploy your site to Netlify

Cool! My site is online but what now?

Customize your site further!

Sources