---
title: "Issue area"
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(fig.align = "center", fig.retina = 3,
fig.width = 6, fig.height = (6 * 0.618),
out.width = "80%", collapse = TRUE,
dev = "png", dev.args = list(type = "cairo-png"))
options(digits = 3, width = 120,
dplyr.summarise.inform = FALSE,
knitr.kable.NA = "")
```
```{r load-libraries, warning=FALSE, message=FALSE}
library(tidyverse)
library(targets)
library(brms)
library(marginaleffects)
library(tidybayes)
library(ggdist)
library(patchwork)
library(scales)
# Generated via random.org
set.seed(196491)
# Load targets
tar_load(ongo)
tar_load(c(m_full_ordbeta, preds_issue, epreds_issue, issue_indicator_lookup))
invisible(list2env(tar_read(graphic_functions), .GlobalEnv))
set_annotation_fonts()
```
```{r plot-epred-issue}
epreds_issue |>
left_join(issue_indicator_lookup, by = join_by(issue_area)) |>
mutate(issue_area_nice = fct_reorder(issue_area_nice, .epred)) |>
ggplot(aes(x = .epred, y = issue_area_nice)) +
stat_halfeye(fill = clrs[5]) +
scale_x_continuous(labels = label_percent(),
sec.axis = sec_axis(trans = ~ prop_to_provinces(.),
name = "Expected provinces",
breaks = seq(8, 32, 4))) +
guides(fill = "none") +
labs(x = "Expected proportion of provinces", y = NULL) +
theme_ongo() +
theme(axis.ticks.x.top = element_line(linewidth = 0.25, color = "grey50"))
```
```{r plot-pred-discrete-continuous-local-bars, fig.width=8, fig.height=3, out.width="100%"}
preds_issue_plot <- preds_issue |>
left_join(issue_indicator_lookup, by = join_by(issue_area)) |>
mutate(outcome = case_when(
.prediction == 0 ~ "Only 1 province",
.prediction > 0 & .prediction < 1 ~ "Between 1–32 provinces",
.prediction == 1 ~ "All 32 provinces",
.ptype = factor(
levels = c("Only 1 province", "Between 1–32 provinces", "All 32 provinces"),
ordered = TRUE)
)) |>
group_by(outcome, issue_area_nice, draw) |>
summarize(count = n()) |>
group_by(issue_area_nice, draw) |>
mutate(prop = count / sum(count))
preds_issue_plot_order <- preds_issue_plot |>
filter(outcome == "All 32 provinces") |>
group_by(issue_area_nice) |>
summarize(median_prop = median(prop)) |>
arrange(median_prop) |>
mutate(issue_area_nice_labels = str_wrap(issue_area_nice, 15)) |>
mutate(issue_area_nice = fct_inorder(issue_area_nice))
preds_issue_text <- preds_issue_plot |>
group_by(outcome, issue_area_nice) |>
summarize(median_prop = median_qi(prop)) |>
unnest(median_prop) |>
group_by(issue_area_nice) |>
mutate(y_plot = (y / 2) + lag(cumsum(y), default = 0)) |>
mutate(y_plot = 1 - y_plot) |>
mutate(prop_nice = label_percent(accuracy = 1)(y)) |>
mutate(prop_ci_nice = glue::glue(
"{ymin}–{ymax}",
ymin = label_number(accuracy = 1, scale = 100)(ymin),
ymax = label_percent(accuracy = 1)(ymax)
)) |>
mutate(issue_area_nice = factor(
issue_area_nice,
levels = preds_issue_plot_order$issue_area_nice,
labels = preds_issue_plot_order$issue_area_nice_labels
))
preds_issue_plot |>
mutate(issue_area_nice = factor(
issue_area_nice,
levels = preds_issue_plot_order$issue_area_nice,
labels = preds_issue_plot_order$issue_area_nice_labels
)) |>
ggplot(aes(x = draw, y = prop)) +
geom_area(aes(fill = outcome), position = position_stack()) +
geom_text(
data = preds_issue_text,
aes(x = 250, y = y_plot, label = prop_ci_nice),
size = 3, fontface = "bold", color = "white"
) +
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(3, 5, 7)]) +
facet_wrap(vars(issue_area_nice), strip.position = "bottom", nrow = 1) +
labs(x = NULL, y = "Proportion of predictions", fill = NULL) +
theme_ongo() +
theme(
panel.grid.major = element_blank(),
panel.border = element_blank(),
panel.spacing = unit(5, "pt"),
strip.text = element_text(vjust = 1, hjust = 0.5, size = rel(0.8), face = "plain")
)
```
