Dimensionality reduction of UN voting patterns

Application exercise

Modified

April 25, 2024

library(tidyverse)
library(tidymodels)
library(unvotes)
library(themis)
library(discrim)
library(tidytext)
library(embed)

theme_set(theme_minimal())

set.seed(123)

How do various countries vote in the United Nations General Assembly? Can we use roll call votes to locate countries along meaningful dimensions? Can we use those dimensions to predict future voting behavior?

In this application exercise we will use unsupervised learning and dimension reduction techniques to explore the voting patterns of countries in the United Nations General Assembly. We will use the un_votes dataset from the unvotes package,¹ which contains information on roll call votes in the United Nations General Assembly from 1946 to 2016. We will use principal components analysis (PCA) to reduce the dimensionality of the data and explore the voting patterns of countries. Then we will attempt to fit a supervised classification model to predict future roll call votes using first few principal components.

# load data frames from unvotes package
data("un_votes")
data("un_roll_call_issues")

# convert to tibbles
unvotes <- un_votes |>
  as_tibble()

issues <- un_roll_call_issues |>
  as_tibble()

# restructure roll-call votes as one column for each vote
unvotes_df <- unvotes |>
  select(country, rcid, vote) |>
  mutate(
    vote = factor(vote, levels = c("no", "abstain", "yes")),
    vote = as.numeric(vote),
    rcid = paste0("rcid_", rcid)
  ) |>
  pivot_wider(names_from = "rcid", values_from = "vote", values_fill = 2)
unvotes_df

Each “rcid” is a different vote in the General Assembly
Countries can vote either Yes (3), Abstain (2), or No (1)

Principal components analysis

Define feature engineering recipe

Demo: Create a feature engineering recipe to normalize the votes and convert them to principal components.

pca_rec <- recipe(TODO, data = unvotes_df) |>
  # ignore the country column
  update_role(country, new_role = "id") |>
  # normalize the votes
  TODO(all_predictors()) |>
  # convert to principal components
  TODO(all_predictors(), num_comp = 5)
pca_rec

Prep and bake the recipe

Demo: In order to use the recipe to transform the data, we need to prep() and bake() it. Notice this does not use the usual tidymodels workflow since there is no outcome to predict.

prep(recipe, training) fits the recipe to the training set
bake(recipe, new_data) applies the recipe operations to new_data

Tip

Manually prepping and baking the recipe can be helpful when troubleshooting supervised learning models if you are unsure exactly how the recipe is transforming the training data.

pca_prep <- prep(pca_rec)
pca_prep

bake(pca_prep, new_data = NULL)

Examine first two principal components

Your turn: Use the baked recipe to transform the data and visualize the first two principal components using a scatterplot. Label the countries as best you can. What patterns do you see?

bake(pca_prep, new_data = NULL) |>
  TODO

Add response here.

Which issues contribute to each principal component?

Demo: We can use the results from PCA to determine which specific votes load most strongly on to the first two dimensions.

# extract component scores for each roll call vote
pca_comps <- tidy(pca_prep, number = 2, type = "coef") |>
  # keep only the first 4 components
  filter(component %in% str_c("PC", 1:4)) |>
  # join to get issue names
  left_join(issues |>
              mutate(terms = str_c("rcid_", rcid))) |>
  filter(!is.na(issue))

# keep the top 8 roll call votes per component
pca_comps |>
  slice_max(order_by = abs(value), n = 8, by = component) |>
  # visualize absolute values
  mutate(value = abs(value),
         terms = fct_reorder(.f = terms, .x = value)) |>
  ggplot(mapping = aes(x = value, y = terms, fill = issue)) +
  geom_col(position = "dodge") +
  facet_wrap(facets = vars(component), scales = "free_y") +
  labs(
    x = "Absolute value of contribution",
    y = NULL, fill = NULL,
    title = "What issues are most important in UN voting country differences?",
    subtitle = "Human rights and economic development votes account for the most variation"
  )

Your turn: Visualize each roll call vote on the first vs. second principal components, faceting for each issue. What patterns, if any, emerge? Do the first two principal components seem to capture the issue-related variation in the data?

pca_comps |>
  # convert component scores to wide format - one column per principal component
  pivot_wider(
    names_from = component,
    values_from = value
  ) |>
  # pc1 vs. pc2
  ggplot(mapping = aes(x = PC1, y = PC2, color = issue)) +
  geom_point(alpha = 0.3) +
  scale_color_viridis_d(end = 0.8, guide = "none") +
  facet_wrap(facets = vars(issue))

Add response here.

Variance explained

Demo: We can also visualize the percent variance explained by each principal component.

tidy(pca_prep, number = 2, type = "variance") |>
  filter(terms == "percent variance") |>
  ggplot(mapping = aes(x = component, y = value)) +
  geom_line() +
  scale_y_continuous(labels = label_percent(scale = 1)) +
  labs(
    x = "Principal component",
    y = "Percent variance"
  )

tidy(pca_prep, number = 2, type = "variance") |>
  filter(terms == "cumulative percent variance") |>
  ggplot(mapping = aes(x = component, y = value)) +
  geom_line() +
  scale_y_continuous(labels = label_percent(scale = 1)) +
  labs(
    x = "Principal component",
    y = "Cumulative variance"
  )

UMAP

Your turn: Instead of PCA, use UMAP to project the roll-call votes on to a non-linear, low-dimensional representation. What patterns do you see?

# recipe to generate umap dimensions
umap_rec <- recipe(~., data = unvotes_df) |>
  update_role(country, new_role = "id") |>
  step_normalize(all_predictors()) |>
  TODO(all_predictors())

# prep the recipe
umap_prep <- prep(umap_rec)

# visualize the umap dimensions by country
bake(umap_prep, new_data = NULL) |>
  ggplot(mapping = aes(x = UMAP1, y = UMAP2, label = country)) +
  geom_point(alpha = 0.3, size = 2) +
  geom_text(check_overlap = TRUE, hjust = "inward")

Add response here.

Use PCA for predictive modeling

Combine UN vote data frames

# combine all relevant data frames
unvotes_mod_df <- unvotes |>
  left_join(y = un_roll_calls) |>
  left_join(y = un_roll_call_issues, relationship = "many-to-many") |>
  drop_na(issue) |>
  # eliminate duplicate observations
  distinct(country, rcid, vote, .keep_all = TRUE) |>
  select(rcid:vote, date, importantvote, issue)
unvotes_mod_df

Split into training/test sets

unvotes_train <- unvotes_mod_df |>
  filter(year(date) < 2018)
unvotes_test <- unvotes_mod_df |>
  filter(year(date) >= 2018)

Generate PCA components using the training set

# convert to wide format, one column for each vote
unvotes_train_wide <- unvotes_train |>
  select(country, rcid, vote) |>
  mutate(
    vote = factor(vote, levels = c("no", "abstain", "yes")),
    vote = as.numeric(vote),
    rcid = str_c("rcid_", rcid)
  ) |>
  pivot_wider(names_from = "rcid", values_from = "vote", values_fill = 2)

# generate PCA scores and extract to data frame
pca_vals <- recipe(~ ., data = unvotes_train_wide) |>
  update_role(country, new_role = "id") |>
  step_normalize(all_predictors()) |>
  step_pca(all_predictors(), num_comp = 5) |>
  prep() |>
  bake(new_data = NULL)

Combine PCA components with vote-level training set

# define PCA recipe
unvotes_train <- unvotes_mod_df |>
  filter(year(date) < 2018) |>
  left_join(y = pca_vals)

# split training set into cross-validation folds
unvotes_folds <- vfold_cv(unvotes_train, v = 10)

Train a model

# feature engineering recipe
unvotes_rec <- recipe(vote ~., data = unvotes_train) |>
  # exclude id columns
  update_role(rcid, country, country_code, date, new_role = "id") |>
  # impute missing values
  step_impute_median(all_numeric_predictors()) |>
  step_impute_mode(all_nominal_predictors()) |>
  # strong class imbalance - use downsampling to correct
  step_downsample(vote)

# define model
tree_mod <- decision_tree() |>
  set_engine("rpart") |>
  set_mode("classification")

# define workflow
tree_wf <- workflow() |>
  add_recipe(unvotes_rec) |>
  add_model(tree_mod)

# fit model
tree_fit_rs <- tree_wf |>
  fit_resamples(
    resamples = unvotes_folds,
    control = control_resamples(save_pred = TRUE, verbose = TRUE)
  )

# review performance
collect_metrics(tree_fit_rs)
conf_mat_resampled(tree_fit_rs, tidy = FALSE) |>
  autoplot(type = "heatmap")

Acknowledgments

Dataset and some modeling steps derived from Dimensionality reduction of #TidyTuesday United Nations voting patterns by Julia Silge and licensed under a Creative Commons Attribution-ShareAlike 4.0 International (CC BY-SA) License.

Footnotes

Note this is an updated version which includes General Assembly votes through early 2023.↩︎