fuzzy-stacked-bars-ologit.R

library(tidyverse)
library(brms)
library(marginaleffects)
library(tidybayes)
library(ggh4x)
library(scales)

# Ordered logit model
ologit_priors <- c(
  prior(student_t(1, 0, 3), class = Intercept),
  prior(student_t(1, 0, 3), class = b)
)

model3_bayes <- brm(
  bf(c7_internal_movement ~ derogation_ineffect*panbackdichot + 
      new_cases_z + new_deaths_z + cumulative_cases_z + cumulative_deaths_z + v2x_rule),
  data = derog,
  family = "cumulative",
  prior = ologit_priors,
  chains = 4, seed = 1234,
  threads = threading(2)
)

# Basic normal way with pointranges
plot_predictions(model3_bayes, condition = c("derogation_ineffect", "panbackdichot")) +
  facet_wrap(vars(factor(group, levels = levels(derog$c7_internal_movement)))) +
  theme_pandem() +
  theme(legend.position = "bottom")

preds_model3 <- model3_bayes |> 
  epred_draws(
    datagrid(model = model3_bayes, derogation_ineffect = unique, panbackdichot = unique), 
    ndraws = 500, seed = 1234) |> 
  ungroup() |> 
  mutate(
    derogation_ineffect = factor(derogation_ineffect, labels = c("No derogation", "Derogation"), ordered = TRUE),
    panbackdichot = factor(panbackdichot, labels = c("No backsliding", "Backsliding"), ordered = TRUE)
  )

# Fancy way with fuzzy stacked bars
ggplot(preds_model3, aes(x = .draw, y = .epred)) +
  geom_area(aes(fill = .category), position = position_stack()) +
  scale_x_continuous(breaks = NULL, expand = c(0, 0)) +
  scale_y_continuous(labels = label_percent(), expand = c(0, 0)) +
  scale_fill_manual(values = clrs[c(7, 4, 2)]) +
  labs(
    x = NULL, y = "Cumulative outcome probabilities",
    fill = "Internal movement measures") +
  facet_nested_wrap(
    vars(panbackdichot, derogation_ineffect),
    strip = strip_nested(background_x = list(element_rect(fill = "grey92"), NULL), by_layer_x = TRUE),
    nrow = 1
  ) +
  theme_pandem() +
  theme(legend.title.position = "left", legend.position = "top")