Explaining human rights violations

Code 
library(tidyverse)
library(tidybayes)
library(modelsummary)
library(marginaleffects)
library(scales)
library(glue)
library(ggtext)
library(patchwork)
library(ggh4x)
library(tinytable)
library(targets)

tar_config_set(
  store = here::here("_targets"),
  script = here::here("_targets.R")
)

tar_load(c(m_hr, m_tbl_hr))

invisible(list2env(tar_read(graphic_functions), .GlobalEnv))
invisible(list2env(tar_read(diagnostic_functions), .GlobalEnv))
invisible(list2env(tar_read(helper_functions), .GlobalEnv))
invisible(list2env(tar_read(modelsummary_functions), .GlobalEnv))

set_annotation_fonts()

Model details

Formal model specification

\[ \begin{aligned} &\ \mathrlap{\textbf{Model of outcome level $i$ across week $t$}} \\ \text{Outcome}_{it_j} \sim&\ \operatorname{Ordered\ logit}(\phi_{it_j}, \alpha_k) \\[0.75em] &\ \textbf{Distribution parameters} \\ \phi_{it} =&\ \beta_0 + \beta_1\ \text{PanBack (binary)}_{it} + \beta_2\ \text{Derogation in effect}_{it} + \\ &\ \beta_3\ [\text{PanBack (binary)}_{it} \times \text{Derogation in effect}_{it}] + \\ &\ \beta_4\ \text{New cases}_{it}\ + \beta_5\ \text{Cumulative cases}_{it}\ + \\ &\ \beta_6\ \text{New deaths}_{it}\ + \beta_7\ \text{Cumulative deaths}_{it}\ + \\ &\ \beta_8\ \text{Rule of law index}_{it}\ + \beta_9\ \text{Week number}_{it} \\[0.75em] &\ \textbf{Priors} \\ \beta_{0 \dots 9} \sim&\ \operatorname{Student\ t}(\nu = 1, \mu = 0, \sigma = 3) \\ \alpha_k \sim&\ \mathcal{N}(0, 1) \end{aligned} \]

Priors

Code 
ggplot() +
  stat_function(
    geom = "area",
    fun = ~extraDistr::dlst(., df = 1, mu = 0, sigma = 3),
    fill = clrs[2]
  ) +
  xlim(c(-20, 20)) +
  labs(x = "βs") +
  facet_wrap(vars("β: Student t(ν = 1, µ = 0, σ = 3)")) +
  theme_pandem(prior = TRUE)

Density plot of prior distribution for model parameters

Simplified R code

brm(
  bf(outcome ~ derogation_ineffect*panbackdichot +
      new_cases_z + cumulative_cases_z +
      new_deaths_z + cumulative_deaths_z +
      v2x_rule + year_week_num),
  family = cumulative(),
  prior = c(
    prior(student_t(1, 0, 3), class = Intercept),
    prior(student_t(1, 0, 3), class = b)),
  ...
)

Model evaluation

Code 
params_to_show <- c("b_Intercept[1]", "b_derogation_ineffect", "b_panbackdichot", "b_v2x_rule")
params_to_show_logit <- c("b_Intercept", "b_derogation_ineffect", "b_panbackdichot", "b_v2x_rule")
Code 
plot_trace(m_hr$m_hr_discrim, params_to_show)

Code 
plot_trank(m_hr$m_hr_discrim, params_to_show)

Code 
plot_pp(m_hr$m_hr_discrim)

Code 
plot_trace(m_hr$m_hr_ndrights, params_to_show_logit)

Code 
plot_trank(m_hr$m_hr_ndrights, params_to_show_logit)

Code 
plot_pp(m_hr$m_hr_ndrights)

Code 
plot_trace(m_hr$m_hr_abusive, params_to_show)

Code 
plot_trank(m_hr$m_hr_abusive, params_to_show)

Code 
plot_pp(m_hr$m_hr_abusive)

Code 
plot_trace(m_hr$m_hr_nolimit, params_to_show_logit)

Code 
plot_trank(m_hr$m_hr_nolimit, params_to_show_logit)

Code 
plot_pp(m_hr$m_hr_nolimit)

Code 
plot_trace(m_hr$m_hr_media, params_to_show)

Code 
plot_trank(m_hr$m_hr_media, params_to_show)

Code 
plot_pp(m_hr$m_hr_media)

Results

Predictions

Code 
# Discriminatory policy
preds_hr_discrim <- calc_preds(m_hr$m_hr_discrim)
preds_hr_discrim_details <- calc_preds_details(preds_hr_discrim)
diffs_hr_discrim <- calc_preds_diffs(preds_hr_discrim)
diffs_hr_discrim_details <- calc_preds_diffs_details(diffs_hr_discrim)

# Non-derogable rights
preds_hr_ndrights <- calc_preds(m_hr$m_hr_ndrights)
preds_hr_ndrights_plot <- bind_rows(
  preds_hr_ndrights |> mutate(.category = "Major"),
  preds_hr_ndrights |> mutate(.category = "None") |> mutate(.epred = 1 - .epred)
) |>
  mutate(.category = factor(.category, levels = c("None", "Major"), ordered = TRUE))
preds_hr_ndrights_details <- calc_preds_details(preds_hr_ndrights_plot)
diffs_hr_ndrights <- calc_preds_diffs(preds_hr_ndrights_plot)
diffs_hr_ndrights_details <- calc_preds_diffs_details(diffs_hr_ndrights)

# Abusive enforcement
preds_hr_abusive <- calc_preds(m_hr$m_hr_abusive)
preds_hr_abusive_details <- calc_preds_details(preds_hr_abusive)
diffs_hr_abusive <- calc_preds_diffs(preds_hr_abusive)
diffs_hr_abusive_details <- calc_preds_diffs_details(diffs_hr_abusive)

# Time limits
preds_hr_nolimit <- calc_preds(m_hr$m_hr_nolimit)
preds_hr_nolimit_plot <- bind_rows(
  preds_hr_nolimit |> mutate(.category = "Moderate"),
  preds_hr_nolimit |> mutate(.category = "None") |> mutate(.epred = 1 - .epred)
) |>
  mutate(.category = factor(.category, levels = c("None", "Moderate"), ordered = TRUE))
preds_hr_nolimit_details <- calc_preds_details(preds_hr_nolimit_plot)
diffs_hr_nolimit <- calc_preds_diffs(preds_hr_nolimit_plot)
diffs_hr_nolimit_details <- calc_preds_diffs_details(diffs_hr_nolimit)

# Media restrictions
preds_hr_media <- calc_preds(m_hr$m_hr_media)
preds_hr_media_details <- calc_preds_details(preds_hr_media)
diffs_hr_media <- calc_preds_diffs(preds_hr_media)
diffs_hr_media_details <- calc_preds_diffs_details(diffs_hr_media)
Code 
p1 <- ggplot(preds_hr_discrim, aes(x = .draw, y = .epred)) +
  geom_area(aes(fill = .category), position = position_stack()) +
  geom_label(
    data = calc_fuzzy_labs(preds_hr_discrim_details),
    aes(x = x, y = y, label = prob_ci_nice, hjust = hjust),
    fill = scales::alpha("white", 0.4), label.size = 0,
    fontface = "bold", size = 8, size.unit = "pt"
  ) +
  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, 1)]) +
  labs(
    x = NULL, y = "Cumulative\nprobabilities",
    fill = "Discriminatory policy", tag = "A"
  ) +
  facet_nested_wrap(
    vars(panbackdichot, derogation_ineffect),
    strip = nested_settings,
    nrow = 1
  ) +
  theme_pandem() +
  theme_fuzzy_bar

p2 <- ggplot(preds_hr_ndrights_plot, aes(x = .draw, y = .epred)) +
  geom_area(aes(fill = .category), position = position_stack()) +
  geom_label(
    data = calc_fuzzy_labs(preds_hr_ndrights_details),
    aes(x = x, y = y, label = prob_ci_nice, hjust = hjust),
    fill = scales::alpha("white", 0.4), label.size = 0,
    fontface = "bold", size = 8, size.unit = "pt"
  ) +
  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, 1)]) +
  labs(
    x = NULL, y = "Cumulative\nprobabilities",
    fill = "Violation of non-derogable rights", tag = "B"
  ) +
  facet_nested_wrap(
    vars(panbackdichot, derogation_ineffect),
    strip = nested_settings,
    nrow = 1
  ) +
  theme_pandem() +
  theme_fuzzy_bar

p3 <- ggplot(preds_hr_abusive, aes(x = .draw, y = .epred)) +
  geom_area(aes(fill = .category), position = position_stack()) +
  geom_label(
    data = calc_fuzzy_labs(preds_hr_abusive_details),
    aes(x = x, y = y, label = prob_ci_nice, hjust = hjust),
    fill = scales::alpha("white", 0.4), label.size = 0,
    fontface = "bold", size = 8, size.unit = "pt"
  ) +
  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, 1)]) +
  labs(
    x = NULL, y = "Cumulative\nprobabilities",
    fill = "Abusive enforcement", tag = "C"
  ) +
  facet_nested_wrap(
    vars(panbackdichot, derogation_ineffect),
    strip = nested_settings,
    nrow = 1
  ) +
  theme_pandem() +
  theme_fuzzy_bar

p4 <- ggplot(preds_hr_nolimit_plot, aes(x = .draw, y = .epred)) +
  geom_area(aes(fill = .category), position = position_stack()) +
  geom_label(
    data = calc_fuzzy_labs(preds_hr_nolimit_details),
    aes(x = x, y = y, label = prob_ci_nice, hjust = hjust),
    fill = scales::alpha("white", 0.4), label.size = 0,
    fontface = "bold", size = 8, size.unit = "pt"
  ) +
  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, 2)]) +
  labs(
    x = NULL, y = "Cumulative\nprobabilities",
    fill = "No time limited measures", tag = "D"
  ) +
  facet_nested_wrap(
    vars(panbackdichot, derogation_ineffect),
    strip = nested_settings,
    nrow = 1
  ) +
  theme_pandem() +
  theme_fuzzy_bar

p5 <- ggplot(preds_hr_media, aes(x = .draw, y = .epred)) +
  geom_area(aes(fill = .category), position = position_stack()) +
  geom_label(
    data = calc_fuzzy_labs(preds_hr_media_details),
    aes(x = x, y = y, label = prob_ci_nice, hjust = hjust),
    fill = scales::alpha("white", 0.4), label.size = 0,
    fontface = "bold", size = 8, size.unit = "pt"
  ) +
  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, 1)]) +
  labs(
    x = NULL, y = "Cumulative\nprobabilities",
    fill = "Media restrictions", tag = "E"
  ) +
  facet_nested_wrap(
    vars(panbackdichot, derogation_ineffect),
    strip = nested_settings,
    nrow = 1
  ) +
  theme_pandem() +
  theme_fuzzy_bar

layout <- "
AID
FIG
BIE
HI#
CI#
"

p1 + p2 + p3 + p4 + p5 + line_divider + line_divider + line_divider + line_divider_v +
  plot_layout(
    design = layout,
    heights = c(0.31, 0.035, 0.31, 0.035, 0.31),
    widths = c(0.94, 0.02, 0.94)
  ) +
  plot_annotation(
    caption = str_wrap(
      glue(
        "The vertical slices of the bars depict 500 posterior samples;",
        "the fuzziness represents the uncertainty in category boundaries.",
        "95% credible intervals are shown as ranges in each category",
        .sep = " "
      ),
      width = 100
    ),
    theme = theme(
      plot.caption = element_text(
        margin = margin(t = 10), size = rel(0.7),
        family = "Noto Sans", face = "plain"
      )
    )
  )

Predicted probabilities of violating human rights across states with low and high risks of democratic backsliding and derogation status

Predicted probabilities of violating human rights across states with low and high risks of democratic backsliding and derogation status

Complete table of results

Code 
notes <- paste(
  "Note: Estimates are median posterior log odds from logistic and ordered logistic regression models;",
  "95% credible intervals (highest density posterior interval, or HDPI) in brackets."
)

m_tbl_hr |>
  set_names(
    c("Discriminatory policy", "Non-derogable rights",
      "Abusive enforcement", "No time limits", "Media restrictions")) |>
  modelsummary(
    estimate = "{estimate}",
    statistic = "[{conf.low}, {conf.high}]",
    coef_map = coef_map,
    gof_map = gof_map,
    output = "tinytable",
    fmt = fmt_significant(2),
    notes = notes,
    width = c(0.2, rep(0.16, 5))
  ) |>
  style_tt(i = seq(1, 27, 2), j = 1, rowspan = 2, alignv = "t") |>
  style_tt(
    bootstrap_class = "table table-sm"
  )

Complete results from models showing relationship between derogations and human rights violations (H2 and H3)
Discriminatory policy Non-derogable rights Abusive enforcement No time limits Media restrictions
Note: Estimates are median posterior log odds from logistic and ordered logistic regression models; 95% credible intervals (highest density posterior interval, or HDPI) in brackets.
Derogation in effect -0.44 -4.1 1.09 -1.6 -1.5
[-0.84, -0.10] [-11.2, -1.4] [0.89, 1.27] [-2.0, -1.2] [-1.7, -1.2]
Pandemic backsliding (PanBack), dichotomous 2.2 2.9 2.7 0.30 1.8
[2.0, 2.4] [2.7, 3.1] [2.6, 2.9] [0.12, 0.46] [1.6, 2.1]
Derogation in effect × Pandemic backsliding -8.3 3.94 -1.9 1.07 6.62
[-49.9, -2.0] [0.96, 11.05] [-2.4, -1.4] [0.22, 1.83] [0.48, 51.15]
New cases (standardized) 0.0919 -0.059 0.012 -0.117 0.19
[0.0056, 0.1975] [-0.371, 0.240] [-0.065, 0.091] [-0.283, 0.032] [0.10, 0.29]
New deaths (standardized) -0.23 -0.333 -0.010 0.1130 -0.152
[-0.36, -0.11] [-0.651, -0.033] [-0.099, 0.079] [-0.0012, 0.2293] [-0.241, -0.063]
Cumulative cases (standardized) 0.36 -0.022 0.122 -0.51 0.139
[0.21, 0.53] [-0.418, 0.325] [-0.003, 0.240] [-0.71, -0.32] [0.014, 0.250]
Cumulative deaths (standardized) -0.28 -0.022 -0.029 0.39 -0.079
[-0.48, -0.11] [-0.390, 0.356] [-0.164, 0.093] [0.23, 0.54] [-0.192, 0.037]
Rule of law index 0.69 -0.64 -1.11 -0.34 -5.2
[0.47, 0.90] [-0.96, -0.33] [-1.27, -0.95] [-0.50, -0.18] [-5.4, -5.0]
Year-week number -0.0092 -0.0014 -0.024 0.0042 -0.016
[-0.0124, -0.0059] [-0.0055, 0.0033] [-0.026, -0.021] [0.0019, 0.0067] [-0.018, -0.013]
Intercept -2.8 -1.08
[-3.0, -2.5] [-1.21, -0.95]
Cut 1 2.2 -0.183 -4.3
[2.0, 2.4] [-0.310, -0.055] [-4.5, -4.1]
Cut 2 2.9 0.91 -4.0
[2.7, 3.1] [0.78, 1.04] [-4.1, -3.8]
Cut 3 3.1 2.5 -3.7
[2.9, 3.3] [2.3, 2.6] [-3.9, -3.5]
N 9591 9591 9591 9496 9591
\(R^2\) 0.12 0.16 0.23 0.02 0.42

Contrasts

Code 
p1 <- diffs_hr_discrim |>
  ggplot(aes(x = .epred, y = fct_rev(.category), color = .category)) +
  geom_vline(xintercept = 0, linewidth = 0.25, linetype = "21") +
  stat_pointinterval() +
  facet_nested_wrap(vars(panbackdichot, derogation_ineffect), strip = nested_settings_diffs) +
  scale_x_continuous(labels = label_pp) +
  scale_color_manual(values = clrs[c(7, 4, 2, 1)], guide = "none") +
  labs(
    x = NULL, y = NULL,
    title = "Discriminatory policy", tag = "A"
  ) +
  theme_pandem() +
  theme_diffs

p2 <- diffs_hr_ndrights |>
  ggplot(aes(x = .epred, y = fct_rev(.category), color = .category)) +
  geom_vline(xintercept = 0, linewidth = 0.25, linetype = "21") +
  stat_pointinterval() +
  facet_nested_wrap(vars(panbackdichot, derogation_ineffect), strip = nested_settings_diffs) +
  scale_x_continuous(labels = label_pp) +
  scale_color_manual(values = clrs[c(7, 1)], guide = "none") +
  labs(
    x = NULL, y = NULL,
    title = "Non-derogable rights", tag = "B"
  ) +
  theme_pandem() +
  theme_diffs

p3 <- diffs_hr_abusive |>
  ggplot(aes(x = .epred, y = fct_rev(.category), color = .category)) +
  geom_vline(xintercept = 0, linewidth = 0.25, linetype = "21") +
  stat_pointinterval() +
  facet_nested_wrap(vars(panbackdichot, derogation_ineffect), strip = nested_settings_diffs) +
  scale_x_continuous(labels = label_pp) +
  scale_color_manual(values = clrs[c(7, 4, 2, 1)], guide = "none") +
  labs(
    x = NULL, y = NULL,
    title = "Abusive enforcement", tag = "C"
  ) +
  theme_pandem() +
  theme_diffs

p4 <- diffs_hr_nolimit |>
  ggplot(aes(x = .epred, y = fct_rev(.category), color = .category)) +
  geom_vline(xintercept = 0, linewidth = 0.25, linetype = "21") +
  stat_pointinterval() +
  facet_nested_wrap(vars(panbackdichot, derogation_ineffect), strip = nested_settings_diffs) +
  scale_x_continuous(labels = label_pp) +
  scale_color_manual(values = clrs[c(7, 2)], guide = "none") +
  labs(
    x = NULL, y = NULL,
    title = "No time limited measures", tag = "D"
  ) +
  theme_pandem() +
  theme_diffs

p5 <- diffs_hr_media |>
  ggplot(aes(x = .epred, y = fct_rev(.category), color = .category)) +
  geom_vline(xintercept = 0, linewidth = 0.25, linetype = "21") +
  stat_pointinterval() +
  facet_nested_wrap(vars(panbackdichot, derogation_ineffect), strip = nested_settings_diffs) +
  scale_x_continuous(labels = label_pp) +
  scale_color_manual(values = clrs[c(7, 4, 2, 1)], guide = "none") +
  labs(
    x = NULL, y = NULL,
    title = "Media restrictions", tag = "E"
  ) +
  theme_pandem() +
  theme_diffs

(p1 + p2 + p3 + p4 + p5 + line_divider + line_divider + line_divider + line_divider_v) +
  plot_layout(
    design = layout,
    heights = c(0.31, 0.035, 0.31, 0.035, 0.31),
    widths = c(0.94, 0.02, 0.94)
  ) +
  plot_annotation(
    caption = str_wrap(
      glue(
        "Point shows posterior median;", "
        thick lines show 80% credible interval;",
        "thin black lines show 95% credible interval",
        .sep = " "
      ),
      width = 150
    ),
    theme = theme(
      plot.caption = element_text(
        margin = margin(t = 10), size = rel(0.7),
        family = "Noto Sans", face = "plain"
      )
    )
  )

Contrasts in predicted probabilities of implementing COVID restrictions across states with low and high risks of democratic backsliding and derogation status

Contrasts in predicted probabilities of implementing COVID restrictions across states with low and high risks of democratic backsliding and derogation status
Code 
make_diffs_tbl(diffs_hr_discrim)
Severity Median ∆ p(∆ > 0)
None 3.3 [1.1, 5.5] 0.99
Minor −1.1 [−2.2, 0.0] 0.01
Moderate 0.0 [0.0, 0.0] 0.01
Major −1.1 [−2.2, 0.0] 0.01
None 50.6 [46.2, 55.0] 1.00
Minor −16.5 [−18.7, −15.4] 0.00
Moderate −4.4 [−4.4, −3.3] 0.00
Major −29.7 [−33.0, −26.4] 0.00
None 6.6 [3.3, 8.8] 1.00
Minor −3.3 [−4.4, −2.2] 0.00
Moderate −1.1 [−1.1, 0.0] 0.00
Major −2.2 [−4.4, −1.1] 0.00
None −40.7 [−45.1, −37.4] 0.00
Minor 12.1 [11.0, 13.2] 1.00
Moderate 3.3 [2.2, 4.4] 1.00
Major 25.3 [22.0, 28.6] 1.00
Code 
make_diffs_tbl(diffs_hr_ndrights)
Severity Median ∆ p(∆ > 0)
None 4.4 [3.3, 4.4] 1.00
Major −4.4 [−4.4, −3.3] 0.00
None 4.4 [−11.0, 17.6] 0.75
Major −4.4 [−17.6, 11.0] 0.25
None −38.5 [−51.7, −24.2] 0.00
Major 38.5 [24.2, 51.7] 1.00
None −38.5 [−42.9, −35.2] 0.00
Major 38.5 [35.2, 42.9] 1.00
Code 
make_diffs_tbl(diffs_hr_abusive)
Severity Median ∆ p(∆ > 0)
None −23.1 [−27.5, −18.7] 0.00
Minor 9.9 [8.8, 12.1] 1.00
Moderate 9.9 [7.7, 12.1] 1.00
Major 3.3 [3.3, 4.4] 1.00
None 15.4 [4.4, 26.4] 1.00
Minor 4.4 [2.2, 6.6] 1.00
Moderate −8.8 [−15.4, −2.2] 0.00
Major −11.0 [−16.5, −4.4] 0.00
None −19.8 [−30.8, −9.9] 0.00
Minor 2.2 [1.1, 4.4] 0.98
Moderate 11.0 [5.5, 17.6] 1.00
Major 6.6 [1.1, 11.0] 1.00
None −59.4 [−61.6, −56.1] 0.00
Minor 8.8 [6.6, 9.9] 1.00
Moderate 29.7 [27.5, 31.9] 1.00
Major 20.9 [18.7, 24.2] 1.00
Code 
make_diffs_tbl(diffs_hr_nolimit)
Severity Median ∆ p(∆ > 0)
None 18.7 [15.4, 20.9] 1.00
Moderate −18.7 [−20.9, −15.4] 0.00
None 9.9 [−3.3, 18.7] 0.94
Moderate −9.9 [−18.7, 3.3] 0.06
None −14.3 [−25.3, −4.4] 0.00
Moderate 14.3 [4.4, 25.3] 1.00
None −5.5 [−9.9, −3.3] 0.00
Moderate 5.5 [3.3, 9.9] 1.00
Code 
make_diffs_tbl(diffs_hr_media)
Severity Median ∆ p(∆ > 0)
None 35.2 [29.7, 40.7] 1.00
Minor 0.0 [0.0, 1.1] 0.67
Moderate −1.1 [−2.2, −1.1] 0.00
Major −34.1 [−38.5, −29.7] 0.00
None −5.5 [−7.7, −3.3] 0.00
Minor −2.2 [−2.2, −1.1] 0.00
Moderate −2.2 [−3.3, −1.1] 0.00
Major 9.9 [5.5, 13.2] 1.00
None −62.7 [−68.2, −57.2] 0.00
Minor −6.6 [−7.7, −5.5] 0.00
Moderate −5.5 [−5.5, −4.4] 0.00
Major 74.8 [70.4, 80.3] 1.00
None −22.0 [−24.2, −20.9] 0.00
Minor −4.4 [−5.5, −4.4] 0.00
Moderate −4.4 [−4.4, −3.3] 0.00
Major 30.8 [28.6, 34.1] 1.00