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()
Illustration of \(\mu\)
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
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
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
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