ex-3-code-along.Rmd

---
title: "Wrangling, tidying, and visualizing data with the Tidyverse"
date: "`r Sys.Date()`"
author: "___"
output: 
  html_document:
    toc: true
---

## Intro 

Today we're looking at data from the General Assembly of the United Nations.

The data is provided by the [TidyTuesday community](https://github.com/rfordatascience/tidytuesday/blob/master/data/2021/2021-03-23/readme.md) and comprises three tables:

- `unvotes` contains the voting decision (yes/no/abstain) of each country for every issue/resolution
- `roll_calls` contains information on each resolution, e.g., the voting date, the session number and a description
- `issues` contains the issue code and a descriptive topic name 

I placed the three tables in a `.sqlite` database to show you how to work with large data frames using dplyr.

Working with data frames stored in databases is useful if:

- Your data is already in a database
- Your data volume is that high that it does not all fit in memory at once

See also the [dbplyr vignette](https://cran.r-project.org/web/packages/dbplyr/vignettes/dbplyr.html)

## Research questions

- RQ 1: Which topics were voted on most frequently?
- RQ 2: How did the number of roll calls change over time?
- RQ 3: How did the importance of issues change over time?
- RQ 4: Are there subgroups of countries with different voting behavior?  

## Loading the data

Here, we could copy the tables of the DB into memory, because they aren't that large.
But I want to show some of the functionalities in case you run into a real database where the tables don't fit into memory.

```{r setup}
library(tidyverse)

theme_set(theme_minimal(base_size = 18))

knitr::opts_chunk$set(
  fig.width = 28 / 2.54,
  fig.height = 14 / 2.54
)
```

```{r}

con <- RSQLite::dbConnect(RSQLite::SQLite(), "unvotes.sqlite")
dbWriteTable(con, "iris", iris)
RSQLite::dbListTables(con)
tbl(con, "iris")
```


```{r connect-to-database}
library(RSQLite)
# Connect to database
con <- dbConnect(RSQLite::SQLite(), "unvotes.sqlite")
# List all tables
RSQLite::dbListTables(con)

# We can use tbl() to take a reference to a table in the database:
unvotes_db <- tbl(con, "unvotes")
# When printing, the table mostly looks like a regular tibble.
# The main difference is that it's a remote source in a SQLite database.
unvotes_db
# Close the connection:
# dbDisconnect(con)
```

See also the [RStudio website for working with databases](https://db.rstudio.com).

## Writing SQL code

We can write actual SQL code:

```{r wow-i-can-run-sql-code-from-r}
dbGetQuery(con, 'SELECT * FROM unvotes WHERE country_code = "US" LIMIT 5')
```

We can even add SQL code chunks to an R Markdown document:

```{sql connection=con}
SELECT * FROM unvotes WHERE country_code = "US" LIMIT 5
```


The most important difference between _ordinary data frames_ and _remote database_ queries is that your R code is translated into SQL and executed in the database, not in R. 
When working with databases, dplyr tries to be as lazy as possible:

- It never pulls data into R unless you explicitly ask for it.
- It delays doing any work until the last possible moment: it collects together everything you want to do and then sends it to the database in one step.

See also RStudio's guide on [`dbplyr`](https://dbplyr.tidyverse.org/articles/dbplyr.html).


_Do you see a difference in the output of the remote data frame in the following code chunk compared to an in-memory data frame?_

```{r seemless-dplyr-with-database-tables}
unvotes_db %>%
  filter(country_code == "US") %>%
  head(5)
```

Let's do something more useful with the data.

## Calculate the percentage of 'yes' votes per country

```{r}

```



```{r}
# iris %>%
#   group_by(Species) %>%
#   summarize(., avg_sepal_length = mean(Sepal.Length))
# 
# x <- group_by(iris, Species)
# summarize(x, avg_sepal_length = mean(Sepal.Length))
```


```{r perc-of-yes-per-country}
unvotes_db %>%
  group_by(country) %>% #1
  summarize(perc_yes = 100 * sum(vote == "yes") / n()) #2
```

## Load all tables into memory

```{r load-all-tables-into-memory}
library(RSQLite)
dbDisconnect(con) #close potentially open connections
con <- dbConnect(RSQLite::SQLite(), "unvotes.sqlite")
unvotes <- collect(tbl(con, "unvotes"))
issues <- collect(tbl(con, "issues"))
roll_calls <- collect(tbl(con, "roll_calls"))
dbDisconnect(con)
```

## RQ 1: Which topics were voted on most frequently?

We visualize the number of votings per issue category.

forcats

```{r most-pressing-topics}
issues %>% 
  # "count" the number of observations for each issue
  count(issue) %>% #1
  # put the count variable on the x-axis, put `issue` on the y-axis
  ggplot(aes(x = n, y = fct_reorder(issue, n))) + #2
  # geom_bar() vs. geom_col()?
  geom_col() + #3
  labs(
    title = "Resolutions per topic in UN GA votings",
    x = "Number of resolutions",
    y = NULL
  )
```

The output should look as follows:

```{r}
knitr::include_graphics("ex-3-code-along-most-pressing-topics.png")
```

## RQ 2: How did the number of roll calls change over time?

We want to show the number of votings per year over time.
Therefore, we need to extract the year of the voting. 
First, we need to convert the date column from `double` to `Date` (`lubridate::as_date`).

```{r votings-per-year}
library(lubridate)
roll_calls %>%
  # convert from double (number of days before 01-01-1970 (Unix epoch)) to `date`
  mutate(date_clean = as_date(date)) %>%
  # extract year component from date
  mutate(year = year(date_clean)) %>%
  # make a bar plot showing the year on the x-axis and the number of votings on the y-axis
  ggplot(aes(x = year)) + #1
  geom_bar() + #2
  labs(
    x = "Year",
    y = "Number of votings",
    title = "UN GA votings by year"
  )
```

## RQ 3: How did the importance of issues change over time?

stringr

```{r issue-proportion-over-time-data}
df <- roll_calls %>%
  select(rcid, date) %>%
  mutate(date_clean = lubridate::as_date(date)) %>%
  mutate(year = lubridate::year(date_clean)) %>%
  # create bins of 5 years
  mutate(year_disc = cut(
    year, 
    breaks = c(seq(1945,2020, 5)),
    labels = paste0(c(1945, seq(1951, 2016, 5)), "-", seq(1950,2020,5))
    )) %>%
  # prettify factor levels
  mutate(year_disc = str_replace(year_disc, "\\d{2}(\\d{2})-\\d{2}(\\d{2})", "\\1-\n\\2")) %>%
  # order the factor levels by year
  mutate(year_disc = fct_reorder(year_disc, year)) %>%
  select(rcid, year_disc)

# Join `df` with `issues`; keep all votings from `df`
df_plot <- left_join(df, issues, by = "rcid") %>% #1
  # some roll calls are not assigned to an issue category
  # make NA values of `issue` explicit, i.e., convert them to an additional factor level
  mutate(issue = fct_explicit_na(issue, na_level = "Uncategorized"))
df_plot

label_pos <- df_plot %>%
  # filter last year in the data
  filter(year_disc == levels(year_disc)[nlevels(year_disc)]) %>% #1
  # count the number of votings per issue
  count(issue) %>% #2
  # compute relative count of votings
  mutate(perc = n / sum(n)) %>% #3
  # sort rows by factor order 
  arrange(desc(issue)) %>%
  # position of the label equals the sum of proportions of the issues below plus half of an issue's own proportion
  mutate(pos = cumsum(lag(perc, default = 0)) + 0.5 * perc)
label_pos
```

```{r issue-proportion-over-time-plot}
# year bins on x-axis, fill bars by issue
ggplot(df_plot, aes(x = year_disc, #1 
                         fill = issue)) + #2
  geom_bar(position = "fill") +
  colorblindr::scale_fill_OkabeIto() +
  theme(panel.grid = element_blank()) +
  theme(axis.ticks = element_line()) +
  labs(x = "Year", y = NULL,
       title = "Issue distribution of United Nations votings") +
  geom_text(
    data = label_pos,
    aes(x = nlevels(df_plot$year_disc) + 0.75,
        y = pos,
        label = str_wrap(issue, 20)),
    size = 16 / .pt,
    hjust = 0, lineheight = 0.85, fontface = "italic"
  ) +
  guides(fill = FALSE) +
  scale_x_discrete(expand = c(0,0,0.5,0)) +
  scale_y_continuous(labels = scales::percent)
```

The output should look as follows:

```{r}
knitr::include_graphics("ex-3-code-along-issue-distribution-over-time.png")
```

## RQ 4: Are there subgroups of countries with different voting behavior? 

Cluster and visualize countries based on voting similarity.

Here, we combine the popular kmeans clustering and UMAP dimensionality reduction algorithm to discover and visualize subgroups of countries based on their voting behavior in UN GA votings?

Procedure:

1. Count the number of votes per country in recent years, i.e., after 2009. 
To do so, we need to combine `unvotes` (containing `country`) with `roll_calls` (which contains `date`). 
Calculate quantiles and identify a good threshold for the minimum number of votes a country must have cast.
2. Filter countries that voted "sufficiently" often. (Let's say 900 is the threshold ;-) )
3. Convert `vote` to numeric: no = no, abstain = 0.5, yes = 1
4. Use `complete()` to replace NA with 0.5
5. Reshape data so that we can apply clustering: `pivot_wider()`
6. Apply k-means
7. How to visualize clustering in a 926 dim-space? -> UMAP
8. ggrepel to highlight representative countries.

```{r voting-quantiles}
# Task 1: 
unvotes %>%
  left_join(roll_calls %>% select(rcid, date)) %>%
  mutate(date = lubridate::as_date(date)) %>%
  filter(lubridate::year(date) >= 2010) %>%
  count(country) %>% 
  summarize(quant = seq(0,1,0.1), value = quantile(n, seq(0,1,0.1)))
```

```{r country-subgroups-based-on-voting-behavior}
df <- unvotes %>%
  # join with roll_calls for date column
  _____(roll_calls %>% select(rcid, date)) %>%
  # convert date from double to date class
  mutate(date = _____(date)) %>%
  # filter votings from 2010 or later
  filter(_____ >= 2010) %>%
  # add number of observations per country as column
  add_count(country) %>%
  # filter countries with at least 900 votings
  filter(_____ >= 900) %>%
  select(rcid, country, vote) %>%
  # if a country didn't vote on a particular roll call, add an observation with `vote == "abstain"`
  complete(rcid, country, fill = list(vote = "abstain")) %>%
  # kmeans requires numeric columns so we convert the answers to numeric
  mutate(vote = case_when(
    vote == "yes" ~ 1,
    vote == "no" ~ 0,
    TRUE ~ 0.5 # abstain
  )) %>%
  # reshape the data such that rows represent countries, columns represent votings, and cells represent how a country voted in a particular voting 
  pivot_wider(names_from = _____, values_from = _____)
```

The data frame should look as follows: 

```{r}
knitr::include_graphics("country-subgroups-based-on-voting-behavior.png")
```


```{r clustering-dimred-plot}
# apply kmeans without country column
clustering <- kmeans(df %>% select(-country), 2)
str(clustering)

# apply UMAP
set.seed(123)
projection <- umap::umap(df %>% select(-country))
plot_data <- as_tibble(projection$layout) %>%
  mutate(cluster_id = clustering$cluster) %>%
  mutate(country = df$country)

# Visualize projection in two-dimensional scatterplot
# Map cluster membership to point color
ggplot(plot_data, aes(x = V1, y = V2, color = as.factor(cluster_id))) +
  geom_point() +
  ggrepel::geom_text_repel(
    data = plot_data %>% slice_sample(n = 35),
    aes(label = country), seed = 7, size = 14/.pt
    ) +
  guides(color = FALSE) +
  theme_void() +
  scale_x_continuous(expand = c(0.5,0)) +
  scale_y_continuous(expand = c(0.3,0))
```