presidential-births-by-year.R

library(tidyverse)
library(scales)
library(patchwork)

births_1994_1999 <- read_csv("https://raw.githubusercontent.com/fivethirtyeight/data/master/births/US_births_1994-2003_CDC_NCHS.csv") %>% 
  # Ignore anything after 2000
  filter(year < 2000)

births_2000_2014 <- read_csv("https://raw.githubusercontent.com/fivethirtyeight/data/master/births/US_births_2000-2014_SSA.csv")

births_combined <- bind_rows(births_1994_1999, births_2000_2014)

month_names <- c("January", "February", "March", "April", "May", "June", "July",
                 "August", "September", "October", "November", "December")

day_names <- c("Monday", "Tuesday", "Wednesday", 
               "Thursday", "Friday", "Saturday", "Sunday")

births <- births_combined %>% 
  # Make month an ordered factor, using the month_name list as labels
  mutate(month = factor(month, labels = month_names, ordered = TRUE)) %>% 
  mutate(day_of_week = factor(day_of_week, labels = day_names, ordered = TRUE),
         date_of_month_categorical = factor(date_of_month)) %>% 
  # Add a column indicating if the day is on a weekend
  mutate(weekend = ifelse(day_of_week %in% c("Saturday", "Sunday"), TRUE, FALSE))


avg_births_month_day_elections <- births %>% 
  filter(year %in% c(1996, 2000, 2004, 2008, 2012)) %>% 
  group_by(year, month, date_of_month_categorical) %>% 
  summarize(avg_births = mean(births)) %>% 
  mutate(election_day = case_when(
    year == 1996 & month == "November" & date_of_month_categorical == 5 ~ TRUE,
    year == 2000 & month == "November" & date_of_month_categorical == 7 ~ TRUE,
    year == 2004 & month == "November" & date_of_month_categorical == 2 ~ TRUE,
    year == 2008 & month == "November" & date_of_month_categorical == 4 ~ TRUE,
    year == 2012 & month == "November" & date_of_month_categorical == 6 ~ TRUE,
    TRUE ~ FALSE
  ))

ggplot(avg_births_month_day_elections,
       # By default, the y-axis will have December at the top, so use fct_rev() to reverse it
       aes(x = date_of_month_categorical, y = fct_rev(month), fill = avg_births)) +
  geom_tile(aes(color = election_day, size = election_day)) +
  scale_fill_viridis_c(option = "inferno", labels = comma) + 
  scale_color_manual(values = c("white", "#2ECC40")) +
  scale_size_manual(values = c(0, 1)) +
  guides(color = FALSE, size = FALSE) +
  labs(x = "Day of the month", y = NULL,
       title = "Average births per day",
       subtitle = "Only years 1996, 2000, 2004, 2008, 2012",
       fill = "Average births") +
  # Force all the tiles to have equal widths and heights
  coord_equal() +
  theme_minimal() +
  facet_wrap(vars(year), ncol = 1)

ggsave("~/Desktop/lotsa-plots.png", width = 8, height = 11, type = "cairo", dpi = 300)
ggsave("~/Desktop/lotsa-plots.pdf", width = 8, height = 11, device = cairo_pdf)