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.

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

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