1 Linear illustration

1.1 $\mu$ mapping

expand_grid(m = seq(0, 1, .01), sig = c(.2, .4, .6), ra = .5, rd = c(0, .1, .2)) %>%
  mutate(m2 = 1 - (2/3)*((-m*ra +(1-m)*rd)/sig+1)) |> 
  bound() |> 
  ggplot(aes(m, m2)) + geom_line() + 
  facet_grid(sig~rd, labeller = label_both) + 
  ylim(0:1) + xlab("m: this many are") + 
  ylab("mu: this many will")+ xlim(0:1) + 
  geom_abline(aes(intercept = 0, slope = 1), color = "#F8766D") + 
  theme_bw()

$\label{mu} Illustration of $\mu$$

Illustration of $\mu$

1.2 equilibria

ras <- c(.2, .41, .8, 1.62) 
rds <- c(.2, .41, .8, 1.62)


df <- expand_grid(m = seq(0, 1, .001), sig = seq(.01, 1, .0005), 
                  ra = ras, rd = rds) %>%
  data.frame() %>%
  mutate(m2 = 1 - (2/3)*((-m*ra +(1-m)*rd)*(1-sig)/sig+1)) |> 
  bound()

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

df_eq <- equilibrium(df)
  
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)

df_eq$ra2 <- factor(df_eq$ra, ras, TeX(paste0("$\\rho_A=",ras, "$")))
df_eq$rd2 <- factor(df_eq$rd, rds, TeX(paste0("$\\rho_D=",rds, "$")))

df_polygon$ra2 <- factor(df_polygon$ra, ras, TeX(paste0("$\\rho_A=",ras, "$")))
df_polygon$rd2 <- factor(df_polygon$rd, rds, TeX(paste0("$\\rho_D=",rds, "$")))

main_plot <-
  df_eq %>% 
  ggplot(aes(sig, m, color = equilibrium)) + 
  facet_grid(rd2 ~ra2, labeller = "label_parsed")  + 
  ylab("Share attacking") + 
  xlab( TeX("$sigma$")) + 
  theme_bw() + theme(legend.position = "none") + 
  geom_polygon(data = df_polygon, fill  = "lightgrey", color = "white", alpha = .5) + 
  geom_point() 

main_plot

$\label{eq} Equilibria in a linear/uniform model (pink = stable). No equilibria in grey areas. In upper right panels, the pure coordination equilibrium is lower than the expressive equlibrium. In the lower left panels, the pure coordination equilibrium is higher than the expressive equlibrium.$

Equilibria in a linear/uniform model (pink = stable). No equilibria in grey areas. In upper right panels, the pure coordination equilibrium is lower than the expressive equlibrium. In the lower left panels, the pure coordination equilibrium is higher than the expressive equlibrium.

pdf("graphs_files/main.pdf", width = 10, height = 5)
main_plot
dev.off()

## png 
##   2

1.3 Equilibria given costs

df <- 
  expand_grid(m = seq(0, 1, .001), sig = .55, ra = 1.2, rd = seq(.0, 1, .005)) %>%
  data.frame() %>%
  mutate(m2 = 1 - (2/3)*((-m*ra +(1-m)*rd)*(1-sig)/sig+1)) |> 
  bound() 

costs_plot <-
  equilibrium(df) %>% 
  ggplot(aes(rd, m, color = equilibrium)) + 
  ylab("Share attacking") + 
  xlab( TeX("$rho_D$")) + 
  theme_bw() + theme(legend.position = "none") + 
  geom_line() 
  
costs_plot

Equilibria given costs in a linear/uniform model (pink = stable). No equilibria in grey areas. In upper right panels, the pure coordination equilibrium is lower than the expressive equlibrium. In the lower left panels, the pure coordination equilibrium is higher than the expressive equlibrium.

pdf("graphs_files/main_cists.pdf", width = 8, height = 3)
costs_plot
dev.off()

## png 
##   2

2 Many equilibria illustration

2.1 $\mu$ mapping

n <- 500
X <- expand_grid(x = seq(-2,1, length = n), d = seq(-1.1,1,length = n)) %>% filter(d < sin((x+2)*8))
F <- function(x) mean(X$x <= x)

X |> ggplot(aes(x, d)) + geom_point() + theme_bw()

Multimodal preference distribution

sigs = c(.05, .1, .16, .18, .3, .95)

df_br <- 

    expand_grid(m = seq(0, 1, .001), sig = sigs, ra = .4, rd = c(.2)) %>%
  mutate(
    x = (-m*ra +(1-m)*rd)*(1-sig)/sig,
    m2 = 1 - sapply(x, F),
    sigma = factor(sig)) |> 
  bound() 



df_br$sig2 <- factor(df_br$sig, sigs, TeX(paste0("$sigma=", sigs, "$")))

many_equilibria <- 
  
  df_br |>
  
  ggplot(aes(m, m2)) + geom_line() + ylim(0:1) + 
    xlab("m: this many are attacking") + ylab(TeX("$mu$: this many will attack"))+ xlim(0:1) + 
  geom_abline(aes(intercept = 0, slope = 1), color = "black") + theme_bw() + 
  facet_grid(~sig2, labeller = "label_parsed")

many_equilibria

$When $\sigma$ is small there are generically three equilibria generated by a symmetric coordination game. One of these is the interior, unstable, '**pure coordination**' equilibrium. When $\sigma$ is large there is a unique '**pure expression**' equilibrium, which is stable. At intermediate levels there can be many equilibria.$

When $\sigma$ is small there are generically three equilibria generated by a symmetric coordination game. One of these is the interior, unstable, ‘pure coordination’ equilibrium. When $\sigma$ is large there is a unique ‘pure expression’ equilibrium, which is stable. At intermediate levels there can be many equilibria.

pdf("graphs_files/many.pdf", width = 12, height = 2.5)
many_equilibria
dev.off()

## png 
##   2

2.2 Equilibria

sigtop = .3


if(run)
  expand_grid(m = seq(0, 1, .0005), sig = seq(.01, sigtop, .003), ra = .4, rd = .2) %>%
  mutate(
    x = (-m*ra +(1-m)*rd)*(1-sig)/sig,
    m2 = 1 - sapply(x, F)) |> 
  bound() |>
  equilibrium() |>
  write_rds("df.rds")

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

read_rds("df.rds") %>%
  ggplot(aes(sig, m, color = equilibrium)) +  geom_point() + 
  ylab("Share attacking") + xlab("sigma") + theme_bw() + theme(legend.position = "none") + 
  geom_polygon(data = df_polygon, fill  = "lightgrey", color = "white", alpha = .5) + geom_point()

$\label{many2} Summary of equilibria as a function of $\sigma$ for the same parameters as in Figure @ ef(many).$

Summary of equilibria as a function of $\sigma$ for the same parameters as in Figure @ ef(many).

3 Beta distributed preferences

3.1 Beta distribution

x = seq(-1, 1, .05)
plot(x, dbeta((x+1)/2, 4, 6), xlab = "Pro autocracy", ylab = "density", type = "l")

$Illustration of Beta density (about 25\% antidemocratic)$

Illustration of Beta density (about 25% antidemocratic)

3.2 Best responses

sigs = c(.2, .4, .6)
rds <- c(.1, .3, .5)

df_br <- 
  
  expand_grid(m = seq(0, 1, .01), sig = sigs, ra = .4, rd = rds) %>%
  data.frame() %>%
  mutate(m2 = 1 - pbeta(((-m^2*ra + (1-m^2)*rd)/sig + 1)/2, 4, 6)) |> 
  bound()  
  
df_br$sig2 <- factor(df_br$sig, sigs, TeX(paste0("$sigma=", sigs, "$")))
df_br$rd2 <- factor(df_br$rd, rds, TeX(paste0("$\\rho_D=",rds, "$")))

df_br |>
  ggplot(aes(m, m2)) + geom_line() + 
    facet_grid(sig2~rd2, labeller = "label_parsed") + 
    ylim(0:1) + xlab("m: this many are attacking") + 
    ylab( TeX("$mu$: This many will attack")) + 
xlim(0:1) + geom_abline(aes(intercept = 0, slope = 1), color = "#F8766D") + theme_bw()

$\label{mu} Illustration of $\mu$ for Beta density and quadratic success probabilities$

Illustration of $\mu$ for Beta density and quadratic success probabilities

3.3 Equilibria 1

df <- expand_grid(m = seq(0, 1, .002),
                  sig = seq(.1, 2, .001), 
                  ra = c(0, .2, .6, 1.2), 
                  rd = c(0, .2, .41, .8)) %>%
  mutate(m2 = 1 - pbeta(((-m^2*ra + (1-m^2)*rd)*(1-sig)/sig + 1)/2, 4, 6)) |> 
  bound() |> 
  equilibrium() |> 
  ggplot(aes(sig, m, color = equilibrium)) + 
  facet_grid(rd ~ra, labeller = "label_both") + geom_point() + 
  ylab("Share attacking") + xlab("sigma") + theme_bw() + 
  theme(legend.position = "none")

3.4 Equilibria 2

rds <- ras <- c(.2, 1, 5.5, 25) 

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

df_polygon <- bind_rows(
  mutate(dfp, sig = 0, m = (rd/(ra+rd))^(2/3)),
  mutate(dfp, sig = 1, m = (rd/(ra+rd))^(2/3)),
  mutate(dfp, sig = 1, m = 1/3),
  mutate(dfp, sig = 0, m = 1/3)) %>% 
  
  mutate(equilibrium = NA)

# Plot
expand_grid(m = seq(0, 1, .001),
            sig = seq(.1, 1, .0002),
            ra = ras, rd = rds) %>%
  mutate(m2 = 1 - pbeta(((-m^1.5*ra + (1-m^1.5)*rd)*(1-sig)/sig + 1)/2, 5.53, 7))  |> 
  equilibrium() |>
  ggplot(aes(sig, m, color = equilibrium)) + 
    facet_grid(rd ~ra, labeller = "label_both")  + ylab("Share attacking") + xlab("sigma") + theme_bw() +
    theme(legend.position = "none") +
    geom_polygon(data = df_polygon, fill  = "lightgrey", color = "white", alpha = .5) +
    geom_point(size = .3)

$\label{eq} Equilibria in a quadratic/Beta model (pink = stable). No equilibria in grey areas. In upper right panels, the pure coordination equilibrium is lower than the expressive equlibrium. In the lower left panels, the pure coordination equilibrium is higher than the expressive equlibrium.$

Equilibria in a quadratic/Beta model (pink = stable). No equilibria in grey areas. In upper right panels, the pure coordination equilibrium is lower than the expressive equlibrium. In the lower left panels, the pure coordination equilibrium is higher than the expressive equlibrium.

Political salience and regime resilience: Replication materials

5 Dec 2022