Political salience, endogenous bandwagoning, and regime resilience: Replication code for figures

Replication code for figures in Schweighofer-Kodritsch, Huck, and Humphreys (2025).

Note: code replicates all figures in text, but uses color rather than linetype to distinguish lines.

1 Setup

We use a small set of helper functions to characterize distributions and identify equilibria.

# helpers

# Density function
f <- function(x) {
  0.5 * (1 + sin(8 * x))
}

# Cumulative distribution function
F <- function(x) {
  ifelse(
    x < -1, 0,
    ifelse(
      x > 1, 1,
      0.5 * ((x + 1) - (cos(8 * x) - cos(8)) / 8)
    )
  )
}

# Bounding function
bound <- function(df) {
  df |>
    mutate(
      m2 = ifelse(m2 < 0, 0, m2),
      m2 = ifelse(m2 > 1, 1, m2)
    )
}

# Equilibrium identification
equilibrium <- function(df) {
  df |>
    group_by(ra, rd, sig) |>
    mutate(
      stable = (sign(m - m2) > sign(lag(m) - lag(m2))) & (lag(m2) != 0),
      unstable = sign(m - m2) < sign(lag(m) - lag(m2)),
      pure = (m == 0 & m2 <= 0) | (m == 1 & m2 >= 1)
    ) |>
    filter(stable | unstable | pure) |>
    ungroup() |>
    mutate(
      equilibrium = ifelse(unstable, "unstable", "stable"),
      equilibrium = ifelse(pure, "stable", equilibrium)
    )
}


# Add TeX labels
tex_labs <- function(df, ras, rds) {
  df$ra2 <- factor(df$ra, ras, TeX(paste0("$\\rho_A=", ras, "$")))
  df$rd2 <- factor(df$rd, rds, TeX(paste0("$\\rho_D=", rds, "$")))
  df
}

2 Figure 1: Pivot illustration

An increase in salience pivots the attack response function clockwise. The curved lines show three response functions for different salience levels…

sigs <- c(0.05, 0.32, 0.75)

ra <- 0.5
rd <- 0.45
m0 <- rd / (rd + ra)

df_br <- expand_grid(m = seq(0, 1, 0.001), sig = sigs, ra = ra, rd = rd) |>
  mutate(
    x = (-m * ra + (1 - m) * rd) * (1 - sig) / sig,
    m2 = 1 - sapply(x, F),
    sigma = factor(sig)
  ) |>
  bound()

fig_1 <- df_br |>
  mutate(sigma = factor(sigma, sigs, paste0(c("Low ", "Medium ", "High "), "(", sigs, ")"))) |>
  ggplot(aes(m, m2, color = sigma)) +
  geom_abline(intercept = 0, slope = 1, color = "grey") +
  geom_vline(xintercept = m0, color = "grey") +
  geom_hline(yintercept = 1 - F(0), color = "grey") +
  xlab(TeX("$m$")) +
  ylab(TeX("$\\mu(m)$")) +
  labs(color = expression(sigma)) +
  theme_bw() +
  # axis tick customization
  scale_x_continuous(
    limits = c(0, 1),
    breaks = c(0, m0, 1),
    labels = TeX(c("0", "$m_0$", "1")),
    minor_breaks = NULL
  ) +
  scale_y_continuous(
    limits = c(0, 1),
    breaks = c(0, 1 - F(0), 1),
    labels = TeX(c("0", "$m_1$", "1")),
    minor_breaks = NULL
  ) +
  geom_line()

fig_1

Illustration of \(\mu\)

3 Figure 2: Equilibria

Equilibria in a linear-uniform model. Black points show stable equilibria. Dark grey points show unstable equilibria. There are no equilibria in the light-grey-shaded rectangular areas. Each panel varies salience…

ras <- c(0.2, 0.41, 0.8, 1.62)
rds <- c(0.2, 0.41, 0.8, 1.62)

df_eq <- expand_grid(
  m = seq(0, 1, 0.001),
  sig = seq(0.01, 1, 0.0001),
  ra = ras, rd = rds) |>
  mutate(m2 = 1 - (2 / 3) * ((-m * ra + (1 - m) * rd) * (1 - sig) / sig + 1)) |>
  bound() |>
  equilibrium() |>
  tex_labs(ras, rds)

dfp <- expand_grid(ra = ras, rd = rds)

df_polygon <- bind_rows(
  mutate(dfp, sig = 0, m = rd / (ra + rd)),
  mutate(dfp, sig = 1, m = rd / (ra + rd)),
  mutate(dfp, sig = 1, m = 1 / 3),
  mutate(dfp, sig = 0, m = 1 / 3)
) |>
  mutate(equilibrium = NA) |>
  tex_labs(ras, rds)

base_g <- df_eq |>
  ggplot(aes(sig, m, color = equilibrium))

fig_2 <- base_g +
  geom_polygon(data = df_polygon, fill = "lightgrey", color = "white") +
  facet_grid(rd2 ~ ra2, labeller = "label_parsed") +
  ylab("Share attacking") +
  xlab(TeX("$sigma$")) +
  theme_bw() +
  geom_point(size = 0.5)


fig_2

Equilibria in a linear-uniform model.

4 Figure 3: Equilibria given costs

Illustration of (unique) interior equilibria as a function of \(\rho_D \in [0, 1]\) when \(\rho_A = 1\), for six different values of \(\sigma\)…

ra <- 1

df <- expand_grid(
  m = seq(0, 1, 0.001),
  sig = c(0.3, 0.4, 0.495, 0.505, 0.6, 0.7),
  ra = ra, 
  rd = seq(0.0, 1, 0.0001)
) |>
  mutate(m2 = 1 - (2 / 3) * ((-m * ra + (1 - m) * rd) * (1 - sig) / sig + 1)) |>
  bound() |>
  equilibrium() |>
  mutate(stable = equilibrium == "stable") |>
  group_by(sig, ra, rd) |>
  mutate(unique = n() == 1) |>
  ungroup()

fig_3_df <- bind_rows(
  df |>
    filter(unique) |>
    mutate(case = "Unique stable equilibrium"),
  df |>
    filter(!unique & !stable) |>
    mutate(case = "Threat point (unstable equilibrium)") |>
    filter(equilibrium == "unstable")
) |>
  group_by(sig, ra, rd) |>
  # Display pure strategy for larger sigma cases
  filter(!(case == "Unique stable equilibrium" & sig < .5)) |>
  mutate(sig = factor(sig))

fig_3 <- fig_3_df |>
  ggplot(aes(rd, m, color = sig)) +
  ylab("Share attacking") +
  xlab(TeX("$\\rho_D$")) +
  theme_bw() +
  facet_grid(~case) +
  theme(legend.position = "bottom") +
  geom_line() +
  labs(linetype = TeX("$\\sigma$"), escape = FALSE) +
  ylim(0,1)

fig_3

Share attacking given sanctions

5 Figure 4: Many equilibria illustration

Equilibria as a function of \(\sigma\) over the range \([0, 0.6]\) for the same example…

ra <- 0.5
rd <- 0.45
m0 <- rd / (rd + ra)
sigtop <- 0.6

df_polygon <- data.frame(
  sig = c(0, sigtop, sigtop, 0),
  m = c(m0, m0, 1 - F(0), 1 - F(0)),
  equilibrium = NA
)

fig_4_df <-
  expand_grid(
    m = seq(0, 1, 0.0005),
    sig = seq(0.01, sigtop, 0.0001),
    ra = ra,
    rd = rd
  ) |>
  mutate(x = (-m * ra + (1 - m) * rd) * (1 - sig) / sig, m2 = 1 - F(x)) |>
  bound() |>
  equilibrium() 

fig_4 <-
  fig_4_df |>
  ggplot(aes(sig, m, color = equilibrium)) +
  geom_polygon(data = df_polygon, fill = "lightgrey", color = "white", alpha = 0.5) +
  geom_point() +
  ylab("Share attacking") +
  theme_bw() +
  xlab(TeX("$\\sigma$")) #+
  #  scale_color_manual(values = c("stable" = "black", "unstable" = "grey"))

fig_4

Summary of equilibria as a function of \(\sigma\) for the same parameters as in Figure 1.

References

Schweighofer-Kodritsch, Sebastian, Steffen Huck, and Macartan Humphreys. 2025. “Political Salience, Endogenous Bandwagoning, and Regime Resilience.” Games and Economic Behavior.