Federal Spending and Congressional Representation

1. Mapping Agency Codes

A first step in preparing the contract data for analysis is to map the 4-digit codes onto agency names. These names include both the long agency names from the source files and shorter, more convenient names created with the following function.

Short.Agency.Names <- function(code){

    if(code == 1200) return('Agriculture')
    else if(code == 1300) return('Commerce')
    else if(code == 1400) return('Interior')
    else if(code == 1500) return('Justice')
    else if(code == 1600) return('Labor')
    else if(code == 1900) return('State')
    else if(code == 2000) return('Treasury')
    else if(code == 2400) return('Personnel Management')
    else if(code == 2800) return('Social Security')
    else if(code == 3100) return('Nuclear Reg Comm')
    else if(code == 3600) return('Veterans Affairs')
    else if(code == 4700) return('GSA')
    else if(code == 4900) return('NSF')
    else if(code == 6800) return('EPA')
    else if(code == 6900) return('Transportation')
    else if(code == 7000) return('Homeland Security')
    else if(code == 7200) return('USAID')
    else if(code == 7300) return('Small Business Admin')
    else if(code == 7500) return('HHS')
    else if(code == 8000) return('NASA')
    else if(code == 8600) return('HUD')
    else if(code == 8900) return('Energy')
    else if(code == 9100) return('Education')
    else if(code == 9700) return('Defense')
}

The following code creates the actual mapping.

cstest <- readRDS("contracts_raw.rds")

# Create a mapping between agency codes and agency names, as implied by the contract data
# Each name appears twice in the raw files, so we pick the version that includes lowercase letters
agency_codes <- unique(cstest$V3)
lower <- agency_codes[str_detect(agency_codes,'[:lower:]+')]
lower <- array(lower)
agency_codes <- data.frame(id = str_sub(lower,1,4), Agency = str_sub(lower,7))

for(code in agency_codes$id){
  agency_codes$ShortName[agency_codes$id==code] <- Short.Agency.Names(code)
}
agency_codes$id <- as.character(agency_codes$id)
saveRDS(agency_codes,"agency_codes.rds")
rm(lower, agency_codes, code, Short.Agency.Names)

2. Cleaning contract data

Cleaning the contract data entails isolating agency codes into a separate field, adding field names (when putting data into a single file they have to be deleted), and eliminating obviously incorrect districts.

# Various cleaning tasks for contract data

# Create new field containing agency code
cstest <- mutate(cstest, Agency.Code = str_sub(V3,1,4)) 
# Add field names that were omitted during storage
colnames(cstest) <- c('ID', 'Dollars.Obligated', 'oldagnc', 'country','State', 
                      'Congress.District', 'pop_cd','pop_zip','Agency.Code')

# Filter out non-state juridictions, non-existent district codes
cstest <- filter(cstest, !(str_sub(pop_cd,1,2) %in% c('PR','VI','GU','DC','AS','MP'))) %>%
          filter(., !(pop_cd == 'CA00' | pop_cd == 'WV00')) 

# Select fields needed downstream, and shorten zip to 5 digits (as used in county mapping)
cstest <-select(cstest, ID, Agency.Code, Dollars.Obligated, State, pop_cd, pop_zip)
cstest$Agency.Code <- as.character(cstest$Agency.Code )
cstest$pop_zip <- sapply(cstest$pop_zip, function(x) str_sub(x,1,5))
saveRDS(cstest,"contracts.rds")

rm(cstest)

3. Parsing data on members of congress

The next processing task is to parse the data on committee membership. A key task was producing codes for congressional districts that match those used in the contract data. Additionally, extracting members’ names will be crucial for joining the two data sources later.

# Get last name (required later for merge)
get.last.name <- function(member_string){
  temp <- str_split(member_string, ",")
  return(temp[[1]][1]) 
}

# Get first name (required later for merge)
get.first.name <- function(member_string){
  temp <- str_split(member_string, ",")
  temp <- temp[[1]][2]
  temp <- str_split(str_sub(temp, start = 2)," ")
  return(temp[[1]][1])
  return(temp)
}

# Get state abbreviation
get.state <- function(member_string){
  temp <- str_split(member_string, " ")
  return(temp[[1]][length(temp[[1]])])
}

# Get district number (0 if from a single-district state such as Delaware)
get.district <- function(member_string){
  temp <- str_split(member_string, " ")
  text <- temp[[1]][length(temp[[1]])-1]
  if(str_detect(text,'[:digit:]+')){
    return(str_extract(text,'[:digit:]+'))
  }else{
    return('0')
  }
}

# Combine state and district number into a 4-character code, e.g. NJ11
get.code <- function(state, district){
  if(str_length(district) == 1)
    return(str_c(state,'0',district))
  else
    return(str_c(state,district))
}

RepData$FirstName <- sapply(RepData$Member, get.first.name)
RepData$LastName <- sapply(RepData$Member, get.last.name)
RepData$State <- sapply(RepData$Member, get.state)
RepData$District <- sapply(RepData$Member, get.district)
RepData$DistrictCode <- mapply(get.code, RepData$State, RepData$District) %>%
                        as.character(.)

RepData <- filter(RepData, !(State %in% c('PR','VI','GU','DC','AS','MP'))) #Filter out non-voting members

The seniority data requires different functions. Note that there are no district numbers in this table.

get.state.senior <- function(ps){
  temp <- str_split(ps,",")
  return(str_sub(temp[[1]][2],2,3))
}

get.last.name.senior <- function(memb){
  temp <- str_split(memb," ")[[1]][-1]
  temp <- ifelse(str_detect(temp,'\\*'),str_sub(temp,1,-2),temp)
  return(temp[[1]])
}

get.first.name.senior <- function(memb){
  temp <- str_split(memb," ")[[1]][1]
  temp <- ifelse(str_detect(temp,'\\*'),str_sub(temp,1,-2),temp)
  return(temp[[1]])
}

SeniorData$FirstName = sapply(SeniorData$Member,get.first.name.senior)
SeniorData$LastName = sapply(SeniorData$Member,get.last.name.senior)
SeniorData$State = sapply(SeniorData$PartyAndState,get.state.senior)

SeniorData <- select(SeniorData, FirstName, LastName, State, Terms)

4. Merging committee data and seniority data

Having parsed committee membership data, the next challenge is to merge committee data with seniority data. Since there's no district data in the seniority table, we need instead to merge by first name, last name, and state.

LeftData <- left_join(RepData, SeniorData, by = c('State','FirstName','LastName'))

Due to features like diacritical marks, abbreviations, and nicknames, the first name/last name/state merge didn't succeed in every case. Since most of the problems seem to be with first names and since matching last names within a state are not common, a good tactic is to take rows that failed to match on the first attempt, attempt a join operation via last name and state, and populate the “Terms” field in the “LeftData” data frame with successful matches.

MissingLeft <- filter(LeftData,is.na(Terms))
FixerByLast <- left_join(MissingLeft,SeniorData, by = c('State','LastName')) %>%
               select(.,DistrictCode,Terms.y) %>%
               filter(.,!is.na(Terms.y))
for(d in FixerByLast$DistrictCode){
  LeftData$Terms[LeftData$DistrictCode == d] <- FixerByLast$Terms.y[FixerByLast$DistrictCode == d]
}

The same process can be tweaked for the 17 remaining unmatched rows, this time joining on first name and state. (The additional manual correction below is necessary because there are two representatives from NJ named “Donald.”)

MissingLeft <- filter(LeftData,is.na(Terms))
FixerByFirst <- left_join(MissingLeft,SeniorData, by = c('State','FirstName')) %>%
  select(.,DistrictCode,Terms.y) %>%
  filter(.,!is.na(Terms.y)) %>%
  filter(., !(DistrictCode=='NJ10' & Terms.y !=3))
for(d in FixerByFirst$DistrictCode){
  LeftData$Terms[LeftData$DistrictCode == d] <- FixerByFirst$Terms.y[FixerByFirst$DistrictCode == d]
}

Having populated “Terms” for the final two unmatched rows manually, all “Terms” can be converted to integers.

LeftData$Terms[LeftData$DistrictCode == 'MO01'] <- 8
LeftData$Terms[LeftData$DistrictCode == 'WA03'] <- 3
LeftData$Terms <- as.integer(LeftData$Terms)

The seniority data in LeftData can now be merged with RepData. We'll additionally want to add a categorical field based on terms. Because of the timing discrepancy noted in the "Processing Data" section earlier, first-term Representatives should get their own category. The remaining categories are to be as close in size to each other as possible.

RepData <- inner_join(RepData, LeftData, by = "DistrictCode") %>%
           select(., ends_with('x'), DistrictCode, Terms) %>%
           select(., Member = Member.x, Committees = Committees.x, State = State.x, DistrictCode, Terms)
RepData$Seniority <- cut(RepData$Terms,
                         c(0,1,3,7,30),
                         c('1st Term', '2 to 3 Terms', '4 to 7 Terms', '8 or More Term'),
                         include.lowest = FALSE)

rm(SeniorData, FixerByFirst, FixerByLast, LeftData, MissingLeft, d, url)
rm(get.code, get.district, 
   get.first.name, get.first.name.senior, 
   get.last.name, get.last.name.senior,
   get.state,
   get.state.senior)

5. Coding committee membership

A useful last preparatory step is to add flags for committees and members with leadership positions.

RepData <- mutate(RepData, Agriculture = str_detect(Committees,'Agriculture')) %>%
           mutate(., Appropriations = str_detect(Committees,'Appropriations')) %>%
           mutate(., ArmedServices = str_detect(Committees,'Armed Services')) %>%
           mutate(., Education = str_detect(Committees,'Education')) %>%
           mutate(., EnergyCommerce = str_detect(Committees,'Energy and')) %>%
           mutate(., HomelandSecurity = str_detect(Committees,'Homeland')) %>%
           mutate(., NaturalResources = str_detect(Committees,'Natural')) %>%
           mutate(., ScienceSpaceTechnology = str_detect(Committees,'Science')) %>%
           mutate(., SmallBusiness = str_detect(Committees,'Small Business')) %>%
           mutate(., Transportation = str_detect(Committees,'Transportation')) %>%
           mutate(., VeteransAffairs = str_detect(Committees,'Veterans')) %>%
           mutate(., Leadership = str_detect(Member,'Boehner.|Pelosi.|McCarthy.|Hoyer.|Clyburn.|Scalise.')) 

write.table(RepData, "CongressData.csv", row.names = FALSE, sep = ',')
saveRDS(RepData,"CongressData.rds")

rm(RepData)

Set up

First, let's load the data stored during processing, as well as any libraries we'll need.

library(stringr)
library(XML)
library(dplyr,warn.conflicts=FALSE)
library(ggplot2)
library(scales)

contracts <- readRDS("contracts.rds") %>% tbl_df()
agencies <- readRDS("agency_codes.rds") %>% tbl_df()
congress <- readRDS("CongressData.rds") %>% tbl_df()

Analysis 1. Relative impact of agencies

To warm-up, let's display a bar chart showing the largest agencies by contract value. As is widely known, the Defense Department dominates.

library(stringr)
library(dplyr,warn.conflicts=FALSE)
library(ggplot2)
library(scales)

by_agency.plot.data <- inner_join(contracts,agencies, by = c("Agency.Code" = "id")) %>%
                       group_by(.,ShortName) %>%
                       summarise(., Total = sum(Dollars.Obligated)/1e9) %>%
                       filter(., Total > 5)

agency.plot <- ggplot(aes(x=reorder(ShortName,Total), y=Total), data = 
                        by_agency.plot.data) +
               geom_bar(stat = "identity")  +
               scale_x_discrete(name = "") +
               scale_y_continuous(name = "Total Contracts (billions)",
                                  labels = dollar) +
               ggtitle("Largest Agencies by Total Contract Value") +
               theme_bw()

agency.plot

Analysis 2. Distribution of contract spending across districts

Let's try plotting some histograms featuring congressional districts as data points, bucketing the data according to the total value of contacts in each district.

library(ggplot2)
library(dplyr)
library(scales)

by_district <- group_by(contracts, pop_cd) %>%
               summarise(., Total = sum(Dollars.Obligated)/1e6) %>%
               rename(., DistrictCode = pop_cd) %>%
               semi_join(.,congress, by = "DistrictCode")
by_district$Total <- sapply(by_district$Total, function(x) ifelse(x<1,1,x))

district.plot <- ggplot(aes(x=Total), data = by_district) +
                 geom_histogram() +
                 scale_x_continuous(name = "Total Contracts (millions)",
                     labels = dollar) +
                 ggtitle('Counts of Congressional Districts by Total Contract Values') +
                 ylab('') +
                 theme_bw()

district.plot

One takeaway from the above plot is that the distribution is highly skewed. We'll therefore have to use log scales in some of our plots. Further statistical analysis might have to employ non-parametric methods.

We can plot similar histograms for specific departments, starting with Defense.

by_district_agency <- inner_join(contracts,agencies, by = c("Agency.Code" = "id")) %>%
                      group_by(., pop_cd, ShortName) %>%
                      summarise(., Total = sum(Dollars.Obligated)/1e6) %>%
                      rename(., DistrictCode = pop_cd) %>%
                      semi_join(.,congress, by = 'DistrictCode')
by_district_agency$Total <- sapply(by_district_agency$Total,  function(x) ifelse(x<1,1,x))

defense.plot <- ggplot(data=filter(by_district_agency,ShortName=='Defense'),
                       aes(x=Total)) +
                geom_histogram(binwidth = 100) +
                scale_x_continuous(name = "Total Contracts (millions)",
                     labels = dollar) +
                ggtitle('Counts of Congressional Districts by Total Defense Contract Values') +
                ylab('') +
                theme_bw()

defense.plot

To check whether the skew in total spending results purely from the skew in Defense spending, we can make similar plots for other selected departments and agencies.

by_district_agency_other <- filter(by_district_agency, 
                                   ShortName %in% c('NASA', 'Veterans Affairs',
                                                    'HHS', 'Energy'))

other.plot <- ggplot(data = by_district_agency_other, aes(x = Total)) +
              facet_grid(ShortName~.) +
              geom_histogram(binwidth = 10) +
              scale_x_continuous(name = "Total Contracts (millions)",
                                 labels = dollar) +
              ggtitle('Counts of Congressional Districts by Total Contract Values') +
              ylab('') +
              coord_cartesian(xlim = c(0,250)) +
              theme_bw()

other.plot

It seems the skew in total spending does not result purely from the skew in Defense spending, as skewness is present at multiple scales.

Analysis 3. Spending in districts versus committee membership

Next, let's try plotting some graphs to show the distribution of contract values across congressional districts, according to committee memberships of those Congressperson representing contracted districts. We'll do so by department, showing in each graph the distribution of committees responsible for the given department, as well as the Appropriations committee (responsible for all departments) and all other members of congress.

In order to plot these graphs, we first create a data frame that joins contract data to congressional data, and then a function to explicitly insure uniform-looking plots.

library(ggplot2)
library(dplyr)
library(scales)
by_distr_agc_comm <- inner_join(by_district_agency, congress, by = "DistrictCode") %>%
                     select(., DistrictCode, Seniority, ShortName, Total, 9:20) 


make.plot <- function(DeptName,CommName){
  plot.data <- filter(by_distr_agc_comm, ShortName == DeptName) 
  comm.bool <- select(plot.data,matches(CommName))[[2]]
  plot.data$Committee <- mapply(function(x,y) if(x) CommName 
                                   else if(y) 'Appropriations'
                                   else 'Other',
                                   comm.bool, 
                                   plot.data$Appropriations)
  plot.data$Committee <- factor(plot.data$Committee, 
                                   levels = c(CommName,'Appropriations', 'Leadership','Other'))
  
  return.plot <- ggplot(data = plot.data, 
                        aes(x = Committee, y = Total, color = Committee), guide = TRUE) +
                 geom_jitter(position = position_jitter(height = 0.2, width = 0.25), 
                             size = 2) +
                 coord_trans(y = 'log10') +
                 scale_size_discrete(range = c(2,4)) +
                 scale_y_continuous(name = "Total Contracts (millions)",
                                    labels = dollar) +
                 ggtitle(str_c('Department: ', DeptName)) +
                 scale_x_discrete(labels = '') +
                 geom_hline(yintercept = median(plot.data$Total),
                            color = 'black', linetype = 'solid', width = 2) +
                 xlab('') +
                 theme_bw()
}

Below are the plots for various departments and agencies. The black line represents the median for the set of all 435 districts for the given agency.

Think of these plots as visual contingency tables. For each committee, we can easily check whether more than half the members are above the median line. This is relevant because in a random sample of Representatives we would expect the points in the sample to be split more or less evenly on the two sides of this line.

Likewise, we can visually check whether a given committee is overrepresented among the districts with the most contract spending. (Keep in mind that each committee comprises 10-15% of Congress.)

Analysis 4. Plots by seniority

Since a Representative’s seniority is a potential contributing factor to spending in his or her district, let's look at plots broken up by seniority buckets. We can also display the size of each bucket for reference.

## 
##       1st Term   2 to 3 Terms   4 to 7 Terms 8 or More Term 
##             59            147            114            115

Something to keep in mind when looking at the plots below is that the leftmost panel displays data for first-term members. These are members who were not involved in the spending decisions. In each case shown, however, more than have the first-term members of the supervising committee are from districts where contract spending is above the overall median.

The pattern we see among the first-term Representatives raises the possibility that the association we observed earlier between contract spending and committee representation results from Representatives being assigned to committees based on the contracts that are already in place in their districts.