Objective

This document provides an example of a table inspired by the 1980 U.S. Decennial Census using data from that census. These tables are unique because of complex headers and subtotals. These data are an interesting example of historical Census data and origin classification.

Repository

Full code and data are available here:

https://github.com/robkempOFM/rstudio_table_competition

Data

Data for this table come from the IPUMS NHGIS project table NT12A and NT13A from the 1980 Decennial Census. These data represent Age totals and those of Spanish Origin (Munson et al. 2021).

# Read in data
nhgis <- read_csv("data/nhgis0009_ds104_1980_state.csv")

# Grab only total population age columns
age_total <- nhgis %>%
    select(STATE, `Under 5 years` = C7B001, `5-17 years` = C7B002, `18-64 years` = C7B003,
        `65 years old and over` = C7B004)
# Grab only spanish origin age columns
age_spanish <- nhgis %>%
    select(STATE, `Under 5 years` = C7D001, `5-17 years` = C7D002, `18-64 years` = C7D003,
        `65 years old and over` = C7D004)

# Join data and remove District Of Columbia
data <- age_total %>%
    inner_join(age_spanish, by = c(STATE = "STATE")) %>%
    filter(STATE != "District Of Columbia") %>%
    mutate(seq = 2:length(age_total$STATE), Total = `Under 5 years.x` + `5-17 years.x` +
        `18-64 years.x` + `65 years old and over.x`) %>%
    select(STATE, Total, `Under 5 years.x`, `5-17 years.x`, `18-64 years.x`, `65 years old and over.x`,
        `Under 5 years.y`, `5-17 years.y`, `18-64 years.y`, `65 years old and over.y`)

# Create Totals Row
totals <- data %>%
    summarize(Total = sum(Total), `Under 5 years.x` = sum(`Under 5 years.x`), `5-17 years.x` = sum(`5-17 years.x`),
        `18-64 years.x` = sum(`18-64 years.x`), `65 years old and over.x` = sum(`65 years old and over.x`),
        `Under 5 years.y` = sum(`Under 5 years.y`), `5-17 years.y` = sum(`5-17 years.y`),
        `18-64 years.y` = sum(`18-64 years.y`), `65 years old and over.y` = sum(`65 years old and over.y`)) %>%
    mutate(STATE = "Total", seq = 1) %>%
    select(STATE, Total, `Under 5 years.x`, `5-17 years.x`, `18-64 years.x`, `65 years old and over.x`,
        `Under 5 years.y`, `5-17 years.y`, `18-64 years.y`, `65 years old and over.y`,
        seq)

# Bind totals to state data and drop seq var
data <- bind_rows(totals, data) %>%
    select(-seq)

# Create column names with spaces after to sub in to make final table show only
# the age categories.
names = c("State", "Total", "Under 5 years", "5-17 years", "18-64 years", "65 years old and over",
    "Under 5 years ", "5-17 years ", "18-64 years ", "65 years old and over ")
colnames(data) <- names

Age by Spanish Origin by State

# Create table
table <- data %>%
    flextable() %>%
    add_header_row(colwidths = c(1, 1, 4, 4), values = c("", "The State", "Non-Spanish",
        "Spanish")) %>%
    add_header_row(colwidths = c(2, 8), values = c("", "Origin")) %>%
    theme_vanilla() %>%
    vline(j = c("State", "`Total`", "`65 years old and over`", "`65 years old and over `"),
        border = fp_border_default(), part = "all") %>%
    bold(j = 2) %>%
    bold(i = 1) %>%
    add_footer_row(values = "Data: IPUMS NHGIS (Munson et al. 2021)", colwidths = 10) %>%
    font(part = "all", fontname = "Calibri")
table

References

Steven Manson, Jonathan Schroeder, David Van Riper, Tracy Kugler, and Steven Ruggles. IPUMS National Historical Geographic Information System: Version 16.0 [dataset]. Minneapolis, MN: IPUMS. 2021. http://doi.org/10.18128/D050.V16.0