collect.Rmd

---
title: "Contribution In and Out of the Classroom: Harvard Faculty Political Spending"
author: "Andy Wang"
date: "4/25/2020"
output: html_document
---

```{r setup, include=FALSE}

# bringing in required libraries

knitr::opts_chunk$set(echo = FALSE)
library(stringr)
library(janitor)
library(ggplot2)
library(usmap)
library(lubridate)
library(ggthemes)
library(broom)
library(tidyverse)
library(gt)
library(DT)
```

```{r importdata, errors = F, warning=F}

# importing the data from the faculty, as well as reading in the correct column
# types.

faculty <- read_csv("harvard-political-spending/raw-data/faculty.csv", 
                    col_types = "ccffcc") %>%
  clean_names()

# reading in the FEC data (using a bulk search on the term "harvard", filtering
# for years from 2017 - 2020, including the correct column types)

fec <- read_csv("harvard-political-spending/raw-data/fec1720.csv",
  col_types = "ccicdccicffcccccccccccccciccccccccTddcccccccccccccccccccccccfcccccccccdcccccccc"
)

# cleaning up the faculty data: I first split the names into a full name, which
# I then split into a last name and a first name. I also did a bunch of error
# checking, since some people did in fact go by both names, or some people used
# their middle names instead of their first names. I then selected out the
# information that wasn't necessary. From there, I simplified to only use the
# first first name given, since I can do that with the FEC data too to make sure
# that no one is left out.

faculty <- faculty %>%
  mutate(
    full_name = map(
      name, ~ unlist(strsplit(., ","))
    ),
    last_name = as.character(map(
      full_name, ~ .[1]
    )),
    full_first_name = map(
      full_name, ~ .[2]
    ),
    first_split = map(
      full_first_name, ~ unlist(
        strsplit(., "\ ")
      )
    ),
    first_name = as.character(
      map(
        first_split, ~ .[2]
      )
    )
  ) %>%
  select(last_name, first_name, title, gender, race, school, department)

# used for error checking on last names to see if anyone has two last names

# mutate(last_split = map(last_name, ~ unlist(strsplit(., "\ ")))) %>%
# mutate(last2 = map(last_split, ~ .[2])) %>%
# filter(!is.na(last2))

# Now cleaning up the FEC data to put the information that we most need to the
# front, as well as adding consistent column names so that merging is easier
# later. Changed names' case from all-caps to title, so that it matches our
# Harvard dataset.

fec <- fec %>%
  mutate(
    first_split = map(
      contributor_first_name, ~ unlist(strsplit(., "\ "))
    ),
    first_name = str_to_title(map(
      first_split, ~ .[1]
    )),
    last_name = str_to_title(contributor_last_name)
  ) %>%
  select(last_name, first_name, everything())
```

```{r committeesdata, error=F, message=F}
# importing FEC committees data, cleaning up names and changing up column names
# to be consistent with other data set for easy join later.

committees <- read_delim("harvard-political-spending/raw-data/committees1920.txt",
  "|",
  escape_double = FALSE, col_names = TRUE,
  trim_ws = TRUE
) %>%
  clean_names() %>%
  mutate(committee_id = cmte_id)
```

```{r joining, error=F, message=F}
# created the master of all tables with this data, merging on first and last.
# Also using coalesce function to replace all NA amounts in contributions to 0
# (to make for accurate averages later).

faculty_fec <- left_join(faculty, fec,
  by = c("first_name", "last_name")
) %>%
  mutate(contribution_receipt_amount = coalesce(contribution_receipt_amount, 0))
```

# Faculty and their FEC Donations

This is the result after I have joined together the faculty information and the FEC donations data.

```{r displayfaculty_fec, include = T}
# using head and skim to give an overview of the data.

head(faculty_fec)
skimr::skim(faculty_fec)
```


```{r topspenders}
# Creating a table of the top spenders. Creating a new column called name, based
# on the paste function, and then summarizing on name (keeping title, school,
# and department for table readability). Arranging for spending in decreasing
# sums, then looking for distinct names (we are losing a little bit of context
# of having all titles of a professor, but this is an okay cost to weigh against
# dozens of duplicated entries.)


spending_by_individual <- faculty_fec %>%
  mutate(name = paste(last_name, ", ", first_name, sep = "")) %>%
  group_by(name, title, school, department) %>%
  summarize(spending_sum = sum(contribution_receipt_amount)) %>%
  ungroup() %>%
  arrange(desc(spending_sum)) %>%
  distinct(name, .keep_all = T)

# finding the mean donation of all faculty members, regardless of if they
# donated

mean_spending_all <- mean(spending_by_individual$spending_sum)

# filtering to only have those who actually donated

spending_by_individual <- spending_by_individual %>%
  filter(spending_sum != 0)

# now grabbing mean of only those who donated.

mean_spending_spenders <- mean(spending_by_individual$spending_sum)
```

# Individual Spending

This is the display of all spending data from individuals
```{r displayspenders, include = T}
head(spending_by_individual)
skimr::skim(spending_by_individual)
```

```{r recipientscommittees}

# first, filtering by name and transaction number to ensure that we don't double
# count people who are in two departments. Then, summarizing based on receiving
# committee name and arranging based on descending values of spending.

spending_recipients <- faculty_fec %>%
  mutate(name = paste(last_name, ", ", first_name, sep = "")) %>%
  distinct(name, pdf_url, .keep_all = T) %>%
  filter(contribution_receipt_amount != 0) %>%
  group_by(committee_name, committee_id) %>%
  summarize(spending_sum = sum(contribution_receipt_amount)) %>%
  arrange(desc(spending_sum)) %>%
  ungroup()


# joining with committee table

spending_committees <- left_join(spending_recipients,
  committees,
  by = "committee_id"
)
```

# Recipient Overview

After summarizing based on committee names and joining with committee, we have a nice overview of spending to each committee.

```{r viewrecipientsoverview, include = T}
head(spending_committees)
skimr::skim(spending_committees)
```

```{r parties, include = T}
# making a summary based on party affiliation

parties <- spending_committees %>%
  rename(party = cmte_pty_affiliation) %>%
  group_by(party) %>%
  summarize(total_spending = sum(spending_sum)) %>%
  filter(!is.na(party)) %>%
  arrange(desc(total_spending))

ggplot(parties, aes(x = party, y = total_spending)) +
  geom_col(fill = "lightblue") +
  theme_classic() +
  scale_y_continuous(labels = scales::dollar_format()) +
  labs(
    title = "Faculty Spendings to Each Party",
    x = "Party",
    y = "Sum of Spendings"
  )
```
```{r individual_donations_party, include = T}

# joining tables of individual donations with committee information, to be able
# to sort by party. group together by party, name, title, etc, and then
# summarize.

individual_donations_party <- faculty_fec %>%
  filter(contribution_receipt_amount != 0) %>%
  left_join(committees, by = "committee_id") %>%
  mutate(
    name = paste(last_name, ", ", first_name, sep = ""),
    party = cmte_pty_affiliation
  ) %>%
  group_by(name, title, school, department, party) %>%
  summarize(spending_sum = sum(contribution_receipt_amount)) %>%
  ungroup() %>%
  arrange(desc(spending_sum)) %>%
  filter(!is.na(party)) %>%
  distinct(name, party, .keep_all = T)

head(individual_donations_party)
skimr::skim(individual_donations_party)
```

# Geographic Distibution of Spending

```{r heatmap}
# summarizing by states

states <- spending_committees %>%
  mutate(state = cmte_st) %>%
  group_by(state) %>%
  summarize(total_spending = sum(spending_sum)) %>%
  arrange(desc(total_spending))

# making a heatmap using plot_usmap

plot_usmap(data = states, values = "total_spending") +
  scale_fill_continuous(
    low = "white", high = "blue",
    name = "Dollars Donated Spent", label = scales::dollar
  ) +
  theme(legend.position = "right") +
  labs(
    title = "States Recieving Harvard Political Spending",
    subtitle = "Using FEC Data from 2017-2020"
  )
```

# Spending Over Time

```{r overtime}

# filtering for unique name / donation id (again to discount people in two
# departments), then mutating to create a month variable. From there,
# summarizing per month

spending_over_time <- faculty_fec %>%
  mutate(name = paste(last_name, ", ", first_name, sep = "")) %>%
  distinct(name, pdf_url, .keep_all = T) %>%
  mutate(month = floor_date(contribution_receipt_date, "month")) %>%
  filter(!is.na(contribution_receipt_amount)) %>%
  group_by(month) %>%
  summarize(spending = sum(contribution_receipt_amount)) %>%
  mutate(cycle = case_when(
    month <= "2018-11-01" ~ 2018,
    month > "2018-11-01" ~ 2020,
  )) %>%
  filter(!is.na(cycle))

# plotting donations over time with ggplot

ggplot(spending_over_time, aes(x = month, 
                               y = spending, 
                               color = as.factor(cycle))) +
  geom_line() +
  labs(
    x = "Date",
    y = "Total Spending",
    title = "Total Harvard Political Spending Per Month",
    color = "Election Cycle"
  ) +
  theme_classic() +
  scale_y_continuous(label = scales::dollar) +
  geom_smooth(method = "glm", se = FALSE)
```

# University-Wide Demographics

```{r demographics}
# creating data frame to do demographics data exploration

race_gender_data <- faculty_fec %>%
  mutate(name = paste(last_name, ", ", first_name, sep = "")) %>%
  group_by(name, title, gender, race) %>%
  summarize(spending_sum = sum(contribution_receipt_amount)) %>%
  ungroup() %>%
  arrange(desc(spending_sum)) %>%
  distinct(name, .keep_all = T) 

# checking to see variable differences

uni_gender_breakdown <- race_gender_data %>%
  group_by(gender) %>%
  summarize(mean_spending = mean(spending_sum))

uni_race_breakdown <- race_gender_data %>%
  group_by(race) %>%
  summarize(mean_spending = mean(spending_sum))

# checking to see if race and gender interact

race_gender_breakdown <- race_gender_data %>%
  group_by(race, gender) %>%
  summarize(mean_donation = mean(spending_sum)) %>%
  arrange(desc(mean_donation))

```
```{r demographicsprint, include = T}
# printing major breakdown tables

uni_gender_breakdown
uni_race_breakdown
race_gender_breakdown

# graphing some major variables against each other

ggplot(race_gender_data, aes(
  x = race, y = spending_sum, color = gender
)) +
  geom_jitter(width = .25, height = .1) +
  scale_y_continuous(labels = scales::dollar)

ggplot(race_gender_data, aes(
  x = gender, y = spending_sum, color = race
)) +
  geom_jitter(width = .25, height = .1) +
  scale_y_continuous(labels = scales::dollar)
```
```{r histogram, include = T}
race_gender_data_hist <- race_gender_data %>%
  mutate(demographic = paste(paste(gender, race))) %>%
  filter(spending_sum != 0) %>%
  filter(spending_sum < 10000)

ggplot(race_gender_data_hist, aes(x = spending_sum, fill = demographic)) +
  geom_histogram(bins = 100) 

```

# University-Wide Schools Model

```{r GRSmodel, include = T}

# creating a dataframe for us to work with as we explore gender, race, school

gender_race_school_data <- faculty_fec %>%
  mutate(name = paste(last_name, ", ", first_name, sep = "")) %>%
  group_by(name, title, school, gender, race) %>%
  summarize(spending_sum = sum(contribution_receipt_amount)) %>%
  ungroup() %>%
  arrange(desc(spending_sum)) %>%
  distinct(name, school, .keep_all = T)

# creating breakdowns for each of our 3 variables

uni_school_breakdown <- gender_race_school_data %>%
  group_by(school) %>%
  summarize(mean_spending = mean(spending_sum)) %>%
  arrange(desc(mean_spending))

uni_school_breakdown
```

```{r unimodelvis, include = T}
# visualization of these differences

ggplot(gender_race_school_data, aes(
  x = school, y = spending_sum, color = gender
)) +
  geom_jitter(width = .25, height = .1) +
  scale_y_continuous(labels = scales::dollar) +
  theme_classic() 

ggplot(gender_race_school_data, aes(
  x = school, y = spending_sum, color = race
)) +
  geom_jitter(width = .25, height = .1) +
  scale_y_continuous(labels = scales::dollar) +
  theme_classic() 
```

```{r unimodel}
# creating a linear model for gender, race, and school, with one interaction
# term

gender_race_school_model <- lm(
  spending_sum ~ gender * race + school,
  gender_race_school_data
) 

# creating data for our model

school_model_data <- data.frame(gender = "M", school = "HLS", race = "White")

# using the output 

school_model_output <- predict(
  gender_race_school_model, 
  school_model_data, 
  se.fit = TRUE)
```

# Cross-Subject Models (Within FAS)

```{r subjects, include = T}

# creating "subjects" field within FAS & SEAS.

gender_race_subject_data <- faculty_fec %>%
  mutate(name = paste(last_name, ", ", first_name, sep = "")) %>%
  filter(school %in% c("FAS", "SEAS")) %>%
  group_by(name, title, school, gender, race, department) %>%
  summarize(spending_sum = sum(contribution_receipt_amount)) %>%
  ungroup() %>%
  arrange(desc(spending_sum)) %>%
  mutate(field = case_when(
    school == "SEAS" ~ "Engineering",
    department %in% c(
      "AAAS",
      "ANTHRO",
      "ECON", 
      "GOV", 
      "HIST", 
      "PSCH", 
      "SOCSTUD", 
      "SOCIO", 
      "WGS"
    ) ~ "Social Sciences",
    department %in% c(
      "ASTRO",
      "CHEM",
      "EPS", 
      "HISTSCI", 
      "HEBIO", 
      "MATH", 
      "MCBIO",
      "OEBIO", 
      "PHY", 
      "STAT",
      "STRBIO", 
      "ESPP"
    ) ~ "Math/Science",
    department %in% c(
      "CELTIC",
      "CLASSICS",
      "COMPLIT",
      "EALC", 
      "ENG", 
      "FOLKMYTH", 
      "GERM", 
      "HISTLIT", 
      "HAA", 
      "LING", 
      "MUSIC", 
      "NELC", 
      "PHIL", 
      "RELI", 
      "ROMANCE", 
      "SLAV", 
      "SAS"
    ) ~ "Humanities",
    department == "ADMIN" ~ "Admin"
  )) %>%
  distinct(name, field, .keep_all = T)

# GG plot to show where spending is per subject

ggplot(gender_race_subject_data, aes(x = field, 
                                     y = spending_sum, 
                                     color = gender)) +
  geom_jitter(width = .1, height = .25) +
  coord_flip() +
  scale_y_log10(labels = scales::dollar)

# table to see the average spending per subject

spending_by_subject <- gender_race_subject_data %>%
  group_by(field) %>%
  summarize(mean_spending = mean(spending_sum)) %>%
  arrange(desc(mean_spending))

spending_by_subject

# getting model

subject_race_gender_model <- lm(
  spending_sum ~ gender * race + field,
  gender_race_subject_data
) %>%
  tidy(conf.int = T)
```


```{r spendingbydepartment, include = T}
ggplot(gender_race_subject_data, aes(x = department, 
                                     y = spending_sum, 
                                     color = gender)) +
  geom_jitter(width = .1, height = .25) +
  coord_flip() +
  scale_y_log10(labels = scales::dollar)

```

```{r diversity, include = F}

# I compiled some statistics about the diversity of Harvard faculty, just for
# fun. This did not make it into the final project.

diverse_faculty <- faculty_fec %>%
  mutate(name = paste(last_name, ", ", first_name, sep = "")) %>%
  mutate(white_man = case_when(
    gender == "M" & race == "White" ~ TRUE,
    gender != "M" ~ FALSE,
    race != "White" ~ FALSE
  )) %>%
  mutate(white = case_when(
    race == "White" ~ TRUE,
    race != "White" ~ FALSE
  )) %>%
  select(white_man, everything())

# Working on University level
diversity_donations_uni <- diverse_faculty %>%
  group_by(name, title, school, white_man, white, race, gender) %>%
  summarize(donations_sum = sum(contribution_receipt_amount)) %>%
  ungroup() %>%
  arrange(desc(donations_sum)) %>%
  distinct(name, school, .keep_all = T)

donations_diversity_per_school <- diversity_donations_uni %>%
  arrange(school) %>%
  group_by(school) %>%
  nest() %>%
  mutate(
    white_man = map(data, ~ sum(.$white_man)),
    white = map(data, ~ sum(.$white)),
    n = map_dbl(data, nrow),
    non_white_man_percent = 100 * (1 - (as.numeric(white_man) / n)),
    non_white_percent = 100 * (1 - (as.numeric(white) / n)),
    mean_donation = as.numeric(map(data, ~ mean(.$donations_sum)))
  ) %>%
  select(school, non_white_man_percent, non_white_percent, mean_donation, data)

ggplot(donations_diversity_per_school, aes(x = non_white_percent, y = mean_donation)) +
  geom_point() +
  geom_smooth(method = "glm", se = F)
ggplot(donations_diversity_per_school, aes(x = non_white_man_percent, y = mean_donation)) +
  geom_point() +
  geom_smooth(method = "glm", se = F)

cor(donations_diversity_per_school$non_white_percent, donations_diversity_per_school$mean_donation)

demographics_school <- diversity_donations_uni %>%
  mutate(
    asian_man = case_when(
      race == "Asian" & gender == "M" ~ TRUE,
      race != "Asian" | gender != "M" ~ FALSE
    ),
    asian_woman = case_when(
      race == "Asian" & gender == "F" ~ TRUE,
      race != "Asian" | gender != "F" ~ FALSE
    ),
    black_woman = case_when(
      race == "African American" & gender == "F" ~ TRUE,
      race != "African American" | gender != "F" ~ FALSE
    ),
    black_man = case_when(
      race == "African American" & gender == "M" ~ TRUE,
      race != "African American" | gender != "M" ~ FALSE
    ),
    white_woman = case_when(
      race == "White" & gender == "F" ~ TRUE,
      race != "White" | gender != "F" ~ FALSE
    )
  ) %>%
  group_by(school) %>%
  nest() %>%
  mutate(
    n = map_dbl(data, nrow),
    white_man = as.numeric(map(data, ~ sum(.$white_man))) / n,
    white_woman = as.numeric(map(data, ~ sum(.$white_woman))) / n,
    asian_man = as.numeric(map(data, ~ sum(.$asian_man))) / n,
    asian_woman = as.numeric(map(data, ~ sum(.$asian_woman))) / n,
    black_man = as.numeric(map(data, ~ sum(.$black_man))) / n,
    black_woman = as.numeric(map(data, ~ sum(.$black_woman))) / n,
    mean_donation = as.numeric(map(data, ~ mean(.$donations_sum)))
  )

# Now on FAS Level
diversity_donations_fas <- diverse_faculty %>%
  filter(school %in% c("FAS", "SEAS")) %>%
  group_by(name, title, school, gender, race, department, white_man, white) %>%
  summarize(donations_sum = sum(contribution_receipt_amount)) %>%
  ungroup() %>%
  arrange(desc(donations_sum)) %>%
  mutate(field = case_when(
    school == "SEAS" ~ "Engineering",
    department %in% c("AAAS", "ANTHRO", "ECON", "GOV", "HIST", "PSCH", "SOCSTUD", "SOCIO", "WGS") ~ "Social Sciences",
    department %in% c("ASTRO", "CHEM", "EPS", "HISTSCI", "HEBIO", "MATH", "MCBIO", "OEBIO", "PHY", "STAT", "STRBIO", "ESPP") ~ "Math/Science",
    department %in% c("CELTIC", "CLASSICS", "COMPLIT", "EALC", "ENG", "FOLKMYTH", "GERM", "HISTLIT", "HAA", "LING", "MUSIC", "NELC", "PHIL", "RELI", "ROMANCE", "SLAV", "SAS") ~ "Humanities",
    department == "ADMIN" ~ "Admin"
  ))

donations_diversity_per_field <- diversity_donations_fas %>%
  distinct(name, field, .keep_all = T) %>%
  arrange(field) %>%
  group_by(field) %>%
  nest() %>%
  mutate(
    white_man = map(data, ~ sum(.$white_man)),
    white = map(data, ~ sum(.$white)),
    n = map_dbl(data, nrow),
    non_white_man_percent = 100 * (1 - (as.numeric(white_man) / n)),
    non_white_percent = 100 * (1 - (as.numeric(white) / n)),
    mean_donation = as.numeric(map(data, ~ mean(.$donations_sum)))
  ) %>%
  select(field, non_white_man_percent, non_white_percent, mean_donation, data)

demographics_fas <- diversity_donations_fas %>%
  mutate(
    asian_man = case_when(
      race == "Asian" & gender == "M" ~ TRUE,
      race != "Asian" | gender != "M" ~ FALSE
    ),
    asian_woman = case_when(
      race == "Asian" & gender == "F" ~ TRUE,
      race != "Asian" | gender != "F" ~ FALSE
    ),
    black_woman = case_when(
      race == "African American" & gender == "F" ~ TRUE,
      race != "African American" | gender != "F" ~ FALSE
    ),
    black_man = case_when(
      race == "African American" & gender == "M" ~ TRUE,
      race != "African American" | gender != "M" ~ FALSE
    ),
    white_woman = case_when(
      race == "White" & gender == "F" ~ TRUE,
      race != "White" | gender != "F" ~ FALSE
    )
  ) %>%
  group_by(field) %>%
  nest() %>%
  mutate(
    n = map_dbl(data, nrow),
    white_man = as.numeric(map(data, ~ sum(.$white_man))) / n,
    white_woman = as.numeric(map(data, ~ sum(.$white_woman))) / n,
    asian_man = as.numeric(map(data, ~ sum(.$asian_man))) / n,
    asian_woman = as.numeric(map(data, ~ sum(.$asian_woman))) / n,
    black_man = as.numeric(map(data, ~ sum(.$black_man))) / n,
    black_woman = as.numeric(map(data, ~ sum(.$black_woman))) / n,
    mean_donation = as.numeric(map(data, ~ mean(.$donations_sum)))
  )

## Now on individual subject level
donations_diversity_per_subject <- diversity_donations_fas %>%
  distinct(name, department, .keep_all = T) %>%
  arrange(department) %>%
  group_by(department) %>%
  nest() %>%
  mutate(
    white_man = map(data, ~ sum(.$white_man)),
    white = map(data, ~ sum(.$white)),
    n = map_dbl(data, nrow),
    non_white_man_percent = 100 * (1 - (as.numeric(white_man) / n)),
    non_white_percent = 100 * (1 - (as.numeric(white) / n)),
    mean_donation = as.numeric(map(data, ~ mean(.$donations_sum)))
  ) %>%
  select(department, non_white_man_percent, non_white_percent, mean_donation, data)
ggplot(donations_diversity_per_subject, aes(x = non_white_percent, y = mean_donation)) +
  geom_point() +
  geom_smooth(method = "glm", se = F)
ggplot(donations_diversity_per_subject, aes(x = non_white_man_percent, y = mean_donation)) +
  geom_point() +
  geom_smooth(method = "glm", se = F)



demographics_departments <- diversity_donations_fas %>%
  mutate(
    asian_man = case_when(
      race == "Asian" & gender == "M" ~ TRUE,
      race != "Asian" | gender != "M" ~ FALSE
    ),
    asian_woman = case_when(
      race == "Asian" & gender == "F" ~ TRUE,
      race != "Asian" | gender != "F" ~ FALSE
    ),
    black_woman = case_when(
      race == "African American" & gender == "F" ~ TRUE,
      race != "African American" | gender != "F" ~ FALSE
    ),
    black_man = case_when(
      race == "African American" & gender == "M" ~ TRUE,
      race != "African American" | gender != "M" ~ FALSE
    ),
    white_woman = case_when(
      race == "White" & gender == "F" ~ TRUE,
      race != "White" | gender != "F" ~ FALSE
    )
  ) %>%
  group_by(department) %>%
  nest() %>%
  mutate(
    n = map_dbl(data, nrow),
    white_man = as.numeric(map(data, ~ sum(.$white_man))) / n,
    white_woman = as.numeric(map(data, ~ sum(.$white_woman))) / n,
    asian_man = as.numeric(map(data, ~ sum(.$asian_man))) / n,
    asian_woman = as.numeric(map(data, ~ sum(.$asian_woman))) / n,
    black_man = as.numeric(map(data, ~ sum(.$black_man))) / n,
    black_woman = as.numeric(map(data, ~ sum(.$black_woman))) / n,
    mean_donation = as.numeric(map(data, ~ mean(.$donations_sum)))
  )
```