Week 5

Data Wrangling and Visualization

Author

Prof. Jack Reilly

Published

Fall 2026

Problem Set 5 Solutions

Download answers to Problem Set 5 Here

dwv_ps5_solutions.R
#Title: DWV Assignment 5 Solutions.R
#Author: Jack Reilly
#Purpose: Solve Assignment 5
#Requires: 
#Output: Plots to plot window; nothing to disk

library(tidyverse)
library(haven)

# 1. Use the CES Cumulative File
ces<-read_dta("~/Desktop/working/dwv/datasets/cumulative_2006-2024.dta")

# 2a. Use only 2024 data
ces2024 <- ces |> filter(year== 2024)

# 2b. Recode the 5 category ideology variable to a three category

#Finding data is not always easy in R.  
#Codebooks help!

table(ces2024$ideo5)

#Ugly. A nicer way to look at some tables
library(expss)

cro(ces2024$ideo5)
ces2024$ideo5

attr(ces2024$ideo5, "labels")

# Recoding

ces2024 <- ces2024 |>
  mutate(ideo_r = case_when(
    ideo5 %in% 1:2 ~ 1,
    ideo5 %in% 3 ~ 2,
    ideo5 %in% 4:5 ~ 3,
    ideo5 %in% 6 ~ NA,
  )
  )

#Let's check
cro(ces2024$ideo_r, ces2024$ideo5)

# 3. Recode Presidential Vote

#President vote
table(ces2024$voted_pres_24)
cro(ces2024$voted_pres_24)

ces2024 |>
  count(voted_pres_24, name = "freq") |>
  mutate(pct = freq / sum(freq))

#Recode
ces2024 <- ces2024 |>
  mutate(pres24_trump = case_when(
    voted_pres_24 %in% 1 ~ 0,
    voted_pres_24 %in% 2 ~ 1,
    voted_pres_24 %in% 3:8 ~ NA
  )
  )

#Note here that I labled the dummy variable "trump" to make it easy to remember who is 1 and who is 0
table(ces2024$voted_pres_24, ces2024$pres24_trump)
cro(ces2024$voted_pres_24, ces2024$pres24_trump)

# 5. Recode Home Ownership
# Home own
ces2024$ownhome
table(ces2024$ownhome)
cro(ces2024$ownhome)
attr(ces2024$ownhome, "labels")

ces2024 <- ces2024 |>
  mutate(home_r = case_when(
    ownhome %in% 1 ~ 1,
    ownhome %in% 2 ~ 0,
    ownhome %in% 3 ~ NA
  )
  )

cro(ces2024$ownhome, ces2024$home_r)

# 6. Crosstabs

table(ces2024$pres24_trump, ces2024$home_r)
cro(ces2024$pres24_trump, ces2024$home_r)

# 7. Education

# Education
ces2024$ideo5
table(ces2024$educ)
cro(ces2024$educ)
attr(ces2024$ideo5, "labels")


ces2024 <- ces2024 |>
  mutate(educ_r = case_when(
    educ %in% 1:2 ~ 1,
    educ %in% 3:4 ~ 2,
    educ %in% 5 ~ 3,
    educ %in% 6 ~ 4
  )
  )

table(ces2024$educ, ces2024$educ_r)
cro(ces2024$educ, ces2024$educ_r)

#Now, our cross tabulations
#Simple, unweighted:

cro(ces2024$pres24_trump, ces2024$ideo_r)
cro(ces2024$pres24_trump, ces2024$home_r)
cro(ces2024$pres24_trump, ces2024$educ_r)

Week 5 Workshop

Download the Week 5 workshop here β€” weighted tables with srvyr, then the same tables made presentable with gt.

ImportantThis script needs the solutions run first

The workshop picks up where the Problem Set 5 solutions leave off: it works on the recoded ces2024 object that the solutions script creates, and its first line source()s that script to build it. Before you run it:

  • Download both files into the same folder and set your working directory to it, so that source("dwv_ps5_solutions.R") can find the solutions script. (Or run the solutions script yourself first and skip that line.)
  • The solutions script reads the CES cumulative file from the assignment, cumulative_2006-2024.dta. Point its read_dta() path at your copy.
  • Packages: haven and expss for the solutions, srvyr and gt for the workshop. install.packages() any you don’t have.
dwv_w5_workshop.R
#Title: DWV Week 5 Workshop.R
#Author: Jack Reilly
#Purpose: Illustrate Survey Functions
#Requires: dwv_ps5_solutions.R already run
#Output: Plots to plot window; nothing to disk

#Identify path to dwv_ps5_solutions.R here
source("dwv_ps5_solutions.R")

library(srvyr)
ces2024_weighted<- ces2024 |> as_survey_design(weights=weight)

#First, let's just look at raw trump vote
ces2024_weighted |>
  group_by(pres24_trump) |>
  summarise(freq = survey_total())

ces2024_weighted |>
  group_by(pres24_trump) |>
  summarise(
    freq = survey_total(),
    pct  = survey_mean()
  )

#Now, by ideology
ces2024_weighted |>
  group_by(pres24_trump, ideo_r) |>
  summarise(
    freq = survey_total(),
    pct  = survey_mean()
  )

#dropping NAs
ces2024_weighted |>
  drop_na(pres24_trump, ideo_r) |>
  group_by(pres24_trump, ideo_r) |>
  summarise(
    freq = survey_total(),
    pct  = survey_mean()
  )

#Home ownership
ces2024_weighted |>
  drop_na(pres24_trump, home_r) |>
  group_by(pres24_trump, home_r) |>
  summarise(
    freq = survey_total(),
    pct  = survey_mean()
  )

#Education
ces2024_weighted |>
  drop_na(pres24_trump, educ_r) |>
  group_by(pres24_trump, educ_r) |>
  summarise(
    freq = survey_total(),
    pct  = survey_mean()
  ) 

#What if we wanted to make some pretty tables?
# gt package ("Grammar of Tables")
library(gt)

# Weighted crosstab: pres24_trump Γ— home_r
tab <- ces2024_weighted %>%
  drop_na(pres24_trump, home_r) %>%
  mutate(
    pres24_trump = factor(pres24_trump,
                          levels = c(0, 1),
                          labels = c("Harris", "Trump")),
    home_r = factor(home_r,
                    levels = c(0, 1),
                    labels = c("Rent", "Own"))
  ) %>%
  group_by(pres24_trump, home_r) %>%
  summarise(n = survey_total(vartype = NULL), .groups = "drop") %>%
  group_by(home_r) %>%
  mutate(col_pct = n / sum(n)) %>%
  ungroup()

# Reshape into a crosstab layout
xtab_col <- tab %>%
  select(pres24_trump, home_r, col_pct) %>%
  pivot_wider(names_from = home_r, values_from = col_pct)

# Make it pretty
gt(xtab_col) %>%
  fmt_percent(columns = -pres24_trump, decimals = 1) %>%
  tab_header(title = "2024 Vote Γ— Home Tenure (Weighted Column %)")

gt(xtab_col) %>%
  fmt_percent(columns = -pres24_trump, decimals = 1) %>%
  cols_label(pres24_trump = "2024 Presidential Vote") %>%
  tab_header(title = "2024 Vote Γ— Home Tenure (Weighted Column %)")

gt(xtab_col, rowname_col = "pres24_trump") %>%
  fmt_percent(columns = everything(), decimals = 1) %>%
  tab_stubhead(label = "2024 Vote") %>%
  tab_spanner(label = "Home Tenure", columns = everything()) %>%
  tab_header(title = "2024 Vote Γ— Home Tenure",
             subtitle = "Weighted column percentages")



#Education and Vote
ces2024_weighted |>
  drop_na(pres24_trump, educ_r) |>
  group_by(pres24_trump, educ_r) |>
  summarise(
    freq = survey_total(),
    pct  = survey_mean()
  )  |> pivot_wider(
    names_from = educ_r,
    values_from = pct
  )

# Weighted crosstab: pres24_trump Γ— educ_r
xtab_educ <- ces2024_weighted |>
  drop_na(pres24_trump, educ_r) |>
  mutate(
    pres24_trump = factor(pres24_trump, levels = c(0, 1),
                          labels = c("Harris", "Trump"))
  ) |>
  group_by(educ_r, pres24_trump) |>
  summarise(col_pct = survey_mean(vartype = NULL)) |>
  ungroup() |>
  pivot_wider(names_from = educ_r, values_from = col_pct)

# Make it pretty
gt(xtab_educ, rowname_col = "pres24_trump") |>
  fmt_percent(columns = everything(), decimals = 1) |>
  tab_stubhead(label = "2024 Vote") |>
  tab_spanner(label = "Education", columns = everything()) |>
  tab_header(title = "2024 Vote Γ— Education",
             subtitle = "Weighted column percentages")