Skip to content

Instantly share code, notes, and snippets.

@fedickinson

fedickinson/partyMisalignment_global

Last active June 17, 2018 20:47
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save fedickinson/14edcf052d85e5a822c909368b21bec5 to your computer and use it in GitHub Desktop.
Save fedickinson/14edcf052d85e5a822c909368b21bec5 to your computer and use it in GitHub Desktop.
Download ZIP
R Shiny App - Using Census API and Congressional District voting to investigate demographic breakdown of 2016 election - https://franklindickinson.shinyapps.io/election_analyzer_2016/
Raw
partyMisalignment_global
# Load Base Packages ####
# install.packages("shiny")
# install.packages("tidyverse")
#install.packages("googleVis")
library(shiny)
library(tidyverse)
library(googleVis)
library(data.table)
# Load downloaded datasets ####
# 1) MIT Election Lab dataset on Congressional Election Results
# See source 'US House 1976-2016': https://electionlab.mit.edu/data
MIT = read.csv('MIT_House.csv', stringsAsFactors = FALSE)
# 2) DailyKos dataset on 2008, 2012, & 2016 Presidential Election Results
# See source https://www.dailykos.com/stories/2012/11/19/1163009/-Daily-Kos-Elections-presidential-results-by-congressional-district-for-the-2012-2008-elections
DK = read.csv('DK_Pres_2016.csv', stringsAsFactors = FALSE, skip=1)
colnames(DK)[6] <- 'Obama.2012'
colnames(DK)[8] <- 'Obama.2008'
# Download Census API data ####
# install.packages("censusapi")
# See source https://github.com/hrecht/censusapi
library(censusapi)
# 1) Select variables for further download
# Specifically analyzing the 2016 American Community Survey (ACS)
#variables - https://api.census.gov/data/2016/acs/acs1/profile/variables.html
variables_education = c('DP02_0059PE','DP02_0060PE','DP02_0061PE','DP02_0062PE','DP02_0063PE','DP02_0064PE','DP02_0065PE')
variables_income = c('DP03_0052PE','DP03_0053PE','DP03_0054PE','DP03_0055PE','DP03_0056PE','DP03_0057PE','DP03_0058PE','DP03_0059PE','DP03_0060PE','DP03_0061PE','DP03_0063E')
variables_race = c('DP05_0059PE','DP05_0060PE','DP05_0061PE','DP05_0062PE','DP05_0063PE','DP05_0066PE')
variables_occupation = c('DP03_0027PE','DP03_0028PE','DP03_0029PE','DP03_0030PE','DP03_0031PE')
# Removing variables_industry for final output
# variables_industry = c('DP03_0033PE','DP03_0034PE','DP03_0035PE','DP03_0036PE','DP03_0037PE','DP03_0038PE','DP03_0039PE','DP03_0040PE','DP03_0041PE','DP03_0042PE','DP03_0043PE','DP03_0044PE','DP03_0045PE')
variables_selected = c(variables_education,variables_income,variables_race,variables_occupation) #<- variables industry removed
# 2) Download selected variables from API
key = 'cc4151c170141a6c1f7b3f63803719fd74c78357'
acs_variables <- getCensus(name = 'acs/acs1/profile', vintage = 2016,
vars = c("NAME",variables_selected),
region = "congressional district:*",
key = key)
# Clean Datasets ####
# Merge will be based on one row for each congressional district.
# Formats of Congressional Districts standardized to DailyKos format ('NY-04','DE-AL')
# MIT Congressional Votes Dataset
# get state and state abbreviation pairs
MIT_state_list <- MIT %>% select(.,state, state_po) %>%
unique(.)
# Clean data
# Party data for Wyoming not filled in... need to fill in republican and democrat manually
MIT <- MIT %>% mutate(party=replace(party, candidate=='Liz Cheney', 'republican'))
MIT <- MIT %>% mutate(party=replace(party, candidate=='Ryan Greene', 'democrat'))
# 'FL-24' had no general election, want to represent via giving 100 votes
MIT <- MIT %>% mutate(candidatevotes=replace(candidatevotes, candidate=='Frederica S. Wilson', 100))
MIT <- MIT %>% mutate(totalvotes=replace(totalvotes, candidate=='Frederica S. Wilson', 100))
# Filter out candidates who weren't republican or democratic
MIT <- MIT %>% filter(party %in% c('republican','democrat'))
# Filter out candidates who got very low votes
MIT <- MIT %>% mutate(percent_total = candidatevotes/totalvotes)
MIT <- MIT %>% filter(percent_total >.1)
# Drop unusable columns
MIT_drop = c('stage','special','version','writein')
MIT <- MIT %>% select(-one_of(MIT_drop))
# Filter for each of the 2012, 2014, and 2016 election data
MIT_2012 <- MIT %>% filter(year==2012)
candidates_to_remove <- c(42,65,131,75,89,130,77,92)
MIT_2012 <- MIT_2012[-candidates_to_remove,]
MIT_2012 <- MIT_2012 %>%
unite(.,'candidate_w_votes',candidate,candidatevotes,percent_total,sep="~%~") %>%
spread(., party, candidate_w_votes) %>%
separate(., democrat, c('democrat_candidate','democrat_vote', 'democrat_vote_pot'),sep='~%~',remove=TRUE,extra='warn',fill='warn') %>%
separate(., republican, c('republican_candidate','republican_vote', 'republican_vote_pot'),sep='~%~',remove=TRUE,extra='warn',fill='warn')
MIT_2012$CD <- formatC(as.numeric(MIT_2012$district), width = 2, flag='0')
MIT_2012$CD <- paste(MIT_2012$state_po,MIT_2012$CD,sep='-')
MIT_2012$CD <- gsub('00','AL',MIT_2012$CD,fixed=TRUE)
MIT_2012$CD <- gsub('98','AL',MIT_2012$CD,fixed=TRUE)
MIT_2014 <- MIT %>% filter(year==2014)
candidates_to_remove <- c(103,131,115,93,106,334,129,331,330)
MIT_2014 <- MIT_2014[-candidates_to_remove,]
MIT_2014 <- MIT_2014 %>%
unite(.,'candidate_w_votes',candidate,candidatevotes,percent_total,sep="~%~") %>%
spread(., party, candidate_w_votes) %>%
separate(., democrat, c('democrat_candidate','democrat_vote', 'democrat_vote_pot'),sep='~%~',remove=TRUE,extra='warn',fill='warn') %>%
separate(., republican, c('republican_candidate','republican_vote', 'republican_vote_pot'),sep='~%~',remove=TRUE,extra='warn',fill='warn')
MIT_2014$CD <- formatC(as.numeric(MIT_2014$district), width = 2, flag='0')
MIT_2014$CD <- paste(MIT_2014$state_po,MIT_2014$CD,sep='-')
MIT_2014$CD <- gsub('00','AL',MIT_2014$CD,fixed=TRUE)
MIT_2014$CD <- gsub('98','AL',MIT_2014$CD,fixed=TRUE)
MIT_2014_merge <- MIT_2014[,c('CD','democrat_candidate','democrat_vote','democrat_vote_pot','republican_candidate','republican_vote','republican_vote_pot')]
colnames(MIT_2014_merge) <- c('CD','democrat_candidate_2014','democrat_vote_2014','democrat_vote_pot_2014','republican_candidate_2014','republican_vote_2014','republican_vote_pot_2014')
MIT_2016 <- MIT %>% filter(year==2016)
MIT_2016[59,'candidate'] <- 'Tony Cardenas'
MIT_2016[45,'candidate'] <- 'Nanette Barragan'
# Clean up candidates where mutliple candidates of same party are in general election.
# Occurs for states with a 'top-two' primary system
candidates_to_remove <- c(62, 122, 95, 119, 101, 76, 331, 339, 788, 330, 327, 335, 324, 328)
MIT_2016 <- MIT_2016[-candidates_to_remove,]
# Utilize the tidyr package to unite, spread, and separate data into one row per district format
MIT_2016 <- MIT_2016 %>%
unite(.,'candidate_w_votes',candidate,candidatevotes,percent_total,sep="~%~") %>%
spread(., party, candidate_w_votes) %>%
separate(., democrat, c('democrat_candidate','democrat_vote', 'democrat_vote_pot'),sep='~%~',remove=TRUE,extra='warn',fill='warn') %>%
separate(., republican, c('republican_candidate','republican_vote', 'republican_vote_pot'),sep='~%~',remove=TRUE,extra='warn',fill='warn')
#Create CD format to match DailyKos for merge
MIT_2016$CD <- formatC(as.numeric(MIT_2016$district), width = 2, flag='0')
MIT_2016$CD <- paste(MIT_2016$state_po,MIT_2016$CD,sep='-')
MIT_2016$CD <- gsub('00','AL',MIT_2016$CD,fixed=TRUE)
MIT_2016$CD <- gsub('98','AL',MIT_2016$CD,fixed=TRUE)
# Fix missing data
MIT_2016$democrat_candidate[MIT_2016$CD == 'AZ-08'] <- "Hiral Tipirneni"
MIT_2016$democrat_vote[MIT_2016$CD == 'AZ-08'] <- 82318
MIT_2016$democrat_vote_pot[MIT_2016$CD == 'AZ-08'] <- .4739
MIT_2016$republican_vote_pot[MIT_2016$CD == 'AZ-08'] <- .5261
MIT_2016$Party[MIT_2016$CD == 'PA-17'] <- '(D)'
#Merge MIT_2016 with MIT_2014_merge
MIT_2016 <- merge(MIT_2016,MIT_2014_merge, by='CD',all=TRUE)
#Ensure vote columns are set to numeric
MIT_cols_to_numeric <- c("democrat_vote","democrat_vote_pot","republican_vote","republican_vote_pot","democrat_vote_2014","democrat_vote_pot_2014","republican_vote_2014","republican_vote_pot_2014")
MIT_2016[,MIT_cols_to_numeric] = apply(MIT_2016[,MIT_cols_to_numeric], 2, function(x) as.numeric(x))
# ACS Census Data
census <- acs_variables
# Match states with districts and change format to match DailyKos
district_list = census[,'NAME']
district_numeric_vector = str_extract(district_list, "\\d+|(at Large)")
district_state_vector = str_extract(district_list, ", \\w+ ?\\w+ ?\\w+") %>%
substring(.,3)
census <- census %>% mutate(state_name = district_state_vector)
state_name_factor <- as.factor(census$state_name)
census$state_abrev <- c(state.abb, 'DC')[match(state_name_factor, c(state.name, 'District of Columbia'))]
census$CD <- paste0(census$state_abrev,'-',census$congressional_district)
census$CD <- gsub("00","AL",census$CD, fixed=TRUE)
# Remove Puerto Rico
census <- census[1:436,]
# Merge Datasets ####
# Before merging, check datasets against each other to make sure CD there for all
filter(MIT_2016, !(CD %in% census$CD))
filter(census, !(CD %in% MIT_2016$CD))
# DC is not in MIT_2016 data... going to remove
filter(MIT_2016, !(CD %in% DK$CD))
filter(DK, !(CD %in% MIT_2016$CD))
filter(DK, !(CD %in% census$CD))
filter(census, !(CD %in% DK$CD))
# Perform merge
CD_data <- merge(DK,MIT_2016,by='CD',all=FALSE) %>%
merge(.,census, by='CD',all=FALSE)
!complete.cases(CD_data$CD)
# Clean final dataset of unecessary columns
CD_columns_remove <- c('office','year','state_cen','state_ic','state.y',
'state_po')
CD_data <- CD_data[ , -which(colnames(CD_data) %in% CD_columns_remove)]
rownames(CD_data) <- NULL
CD_data$democrat_vote_2014[is.na(CD_data$democrat_vote_2014)] <- 0
CD_data$republican_vote_2014[is.na(CD_data$republican_vote_2014)] <- 0
CD_data$democrat_vote_pot_2014[is.na(CD_data$democrat_vote_pot_2014)] <- 0
CD_data$republican_vote_pot_2014[is.na(CD_data$republican_vote_pot_2014)] <- 0
# Now all datasets merged, and app now ready to build
# Tab 1: Map ####
# Create axis columns
# X-axis: Congressional Candidate Margin: Republican - Democrat
CD_data$margin_Trump <- CD_data$Trump - CD_data$Clinton
CD_data$margin_republican <- (CD_data$republican_vote_pot - CD_data$democrat_vote_pot) * 100
CD_data$margin_republican_2014 <- (CD_data$republican_vote_pot_2014 - CD_data$democrat_vote_pot_2014) * 100
CD_data$color[CD_data$Party.x == '(R)' & CD_data$margin_Trump > 0] <- 'House: R; Pres: Trump'
CD_data$color[CD_data$Party.x == '(R)' & CD_data$margin_Trump < 0] <- 'House: R; Pres: Clinton'
CD_data$color[CD_data$Party.x == '(D)' & CD_data$margin_Trump > 0] <- 'House: D; Pres: Trump'
CD_data$color[CD_data$Party.x == '(D)' & CD_data$margin_Trump < 0] <- 'House: D; Pres: Clinton'
# Map US Congressional Districts
# install.packages("USAboundariesData", repos = "http://packages.ropensci.org", type = "source")
#
# library(USAboundaries)
#
# cont_48 <- state.name[state.name != c('Hawaii','Alaska')]
#
# plot_states_data <- us_congressional(resolution = 'low',states=cont_48)
# dummy <- sample(1:30, nrow(plot_states_data), replace=T)
#
#
# plot_states_data$CD <- paste0(plot_states_data$state_abbr,"-",plot_states_data$cd115fp)
# plot_states_data$CD <- gsub("00","AL",plot_states_data$CD, fixed=TRUE)
#
#
# CD_scatter_map <- CD_data[ ,c('CD','Party.x','margin_Trump','Party.x','color')]
#
# # Check for incomplete cases
#
# CD_scatter_map[!complete.cases(CD_scatter_map),]
#
# #merge datasets
# CD_scatter_map_merged <- merge(plot_states_data, CD_scatter_map, by='CD',all=FALSE) %>%
# st_transform("+proj=lcc +lat_1=33 +lat_2=45 +lat_0=39 +lon_0=-96 +x_0=0 +y_0=0 +datum=NAD83 +units=m +no_defs") %>%
# st_simplify(TRUE, dTolerance = 10000)
#
# CD_scatter_map_merged$"2016 result breakdown" <- CD_scatter_map_merged$color
#
# CD_scatter_ggplot <- ggplot(data = CD_scatter_map_merged) +
# geom_sf(aes(fill=CD_scatter_map_merged$"2016 result breakdown")) +
# scale_fill_manual(values=c("blue2", "#E69F00",'purple4','red2')) +
# ggtitle("Breakdown Map of Congressional versus Presidential Winner in 2016 election") +
# theme_bw() + theme(panel.border = element_blank(), panel.grid.major = element_blank(),
# panel.grid.minor = element_blank(), axis.line = element_line(colour = "white"),
# legend.position = "top", legend.direction = "horizontal") + labs(fill = "Presidential/Congressional Winner Breakdown")
# Tab 2: Scatter & Sankey ####
CD_data <- CD_data[rowSums(is.na(CD_data))!=ncol(CD_data),]
test <- CD_data[CD_data$color == 'House: R; Pres: Clinton',]
d2014_rc2016 <- CD_data[CD_data$color == 'House: R; Pres: Clinton' & CD_data$margin_republican_2014 < 0,]
r2014_rc2016 <- CD_data[CD_data$color == 'House: R; Pres: Clinton' & CD_data$margin_republican_2014 > 0,]
d2014_dt2016 <- CD_data[CD_data$color == 'House: D; Pres: Trump' & CD_data$margin_republican_2014 < 0,]
r2014_dt2016 <- CD_data[CD_data$color == 'House: D; Pres: Trump' & CD_data$margin_republican_2014 > 0,]
d2014_rt2016 <- CD_data[CD_data$color == 'House: R; Pres: Trump' & CD_data$margin_republican_2014 < 0,]
r2014_rt2016 <- CD_data[CD_data$color == 'House: R; Pres: Trump' & CD_data$margin_republican_2014 > 0,]
d2014_dc2016 <- CD_data[CD_data$color == 'House: D; Pres: Clinton' & CD_data$margin_republican_2014 < 0,]
r2014_dc2016 <- CD_data[CD_data$color == 'House: D; Pres: Clinton' & CD_data$margin_republican_2014 > 0,]
CD_scatter <- CD_data[,c('margin_republican','margin_Trump')]
CD_scatter$repTrump <- ifelse(CD_scatter$margin_republican > 0 & CD_scatter$margin_Trump > 0, CD_scatter$margin_Trump, NA)
CD_scatter$repClinton <- ifelse(CD_scatter$margin_republican > 0 & CD_scatter$margin_Trump < 0, CD_scatter$margin_Trump, NA)
CD_scatter$demTrump <- ifelse(CD_scatter$margin_republican < 0 & CD_scatter$margin_Trump > 0, CD_scatter$margin_Trump, NA)
CD_scatter$demClinton <- ifelse(CD_scatter$margin_republican < 0 & CD_scatter$margin_Trump < 0, CD_scatter$margin_Trump, NA)
CD_scatter$margin_Trump <- NULL
CD_scatter$CD1.tooltip <- CD_data$CD
CD_scatter$CD2.tooltip <- CD_data$CD
CD_scatter$CD3.tooltip <- CD_data$CD
CD_scatter$CD4.tooltip <- CD_data$CD
CD_scatter <- CD_scatter[,c("margin_republican","repTrump","CD1.tooltip","repClinton","CD2.tooltip","demTrump","CD3.tooltip","demClinton","CD4.tooltip")]
# Create plot for GoogleVis
scatter_margin <- gvisScatterChart(CD_scatter,
options = list(
legend='right',
pointSize= 1.75,
title="House versus Presidential Margins in 2016 Election",
colors= "['red','purple','orange','blue']",
vAxis="{title: 'Presidential vote margin in favor of Trump'}",
hAxis="{title: 'House vote margin in favor of Republican'}",
width = 600,
height = 500
))
# Sankey
CD_Sankey <- data.frame(
From = c(rep('2014 House: R',4),rep('2014 House: D',4)),
To = c(rep(c('2016 House: R; Pres: Trump','2016 House: R; Pres: Clinton','2016 House: D; Pres: Trump','2016 House: D; Pres: Clinton'),2)),
Weight = c(nrow(r2014_rt2016),nrow(r2014_rc2016),nrow(r2014_dt2016),nrow(r2014_dc2016),nrow(d2014_rt2016),nrow(d2014_rc2016),nrow(d2014_dt2016),nrow(d2014_dc2016)))
# Tab 3: Income ####
# Name Columns
CD_data$'Under 10k' <- CD_data$DP03_0052PE
CD_data$'10 to 15k' <- CD_data$DP03_0053PE
CD_data$'15 to 25k' <- CD_data$DP03_0054PE
CD_data$'25 to 35k' <- CD_data$DP03_0055PE
CD_data$'35 to 50k' <- CD_data$DP03_0056PE
CD_data$'50 to 75k' <- CD_data$DP03_0057PE
CD_data$'75 to 100k' <- CD_data$DP03_0058PE
CD_data$'100 to 150k' <- CD_data$DP03_0059PE
CD_data$'150 to 200k' <- CD_data$DP03_0060PE
CD_data$'Over 200k' <- CD_data$DP03_0061PE
CD_data$income_median <- CD_data$DP03_0063E
# Side-by-side Bar Chart
# House: R; Pres: Trump
CD_income_R_T = CD_data %>%
select(c("CD","Trump","Under 10k","10 to 15k","15 to 25k","25 to 35k","35 to 50k","50 to 75k","75 to 100k","100 to 150k","150 to 200k","Over 200k")) %>%
filter(CD_data$color == "House: R; Pres: Trump") %>%
gather("income_level","income_percent_of_pop",3:12) %>%
mutate(
income_level = factor(income_level, levels = c("Under 10k","10 to 15k","15 to 25k","25 to 35k","35 to 50k","50 to 75k","75 to 100k","100 to 150k","150 to 200k","Over 200k")))
CD_income_R_T_mean <- CD_income_R_T %>% group_by(income_level) %>%
summarise(R_T_mean_percent_of_pop = mean(income_percent_of_pop))
# House: R; Pres: Clinton
CD_income_R_C = CD_data %>%
select(c("CD","Trump","Under 10k","10 to 15k","15 to 25k","25 to 35k","35 to 50k","50 to 75k","75 to 100k","100 to 150k","150 to 200k","Over 200k")) %>%
filter(CD_data$color == "House: R; Pres: Clinton") %>%
gather("income_level","income_percent_of_pop",3:12) %>%
mutate(
income_level = factor(income_level, levels = c("Under 10k","10 to 15k","15 to 25k","25 to 35k","35 to 50k","50 to 75k","75 to 100k","100 to 150k","150 to 200k","Over 200k")))
CD_income_R_C_mean <- CD_income_R_C %>% group_by(income_level) %>%
summarise(R_C_mean_percent_of_pop = mean(income_percent_of_pop))
# House: D; Pres: Trump
CD_income_D_T = CD_data %>%
select(c("CD","Trump","Under 10k","10 to 15k","15 to 25k","25 to 35k","35 to 50k","50 to 75k","75 to 100k","100 to 150k","150 to 200k","Over 200k")) %>%
filter(CD_data$color == "House: D; Pres: Trump") %>%
gather("income_level","income_percent_of_pop",3:12) %>%
mutate(
income_level = factor(income_level, levels = c("Under 10k","10 to 15k","15 to 25k","25 to 35k","35 to 50k","50 to 75k","75 to 100k","100 to 150k","150 to 200k","Over 200k")))
CD_income_D_T_mean <- CD_income_D_T %>% group_by(income_level) %>%
summarise(D_T_mean_percent_of_pop = mean(income_percent_of_pop))
# House: D; Pres: Clinton
CD_income_D_C = CD_data %>%
select(c("CD","Trump","Under 10k","10 to 15k","15 to 25k","25 to 35k","35 to 50k","50 to 75k","75 to 100k","100 to 150k","150 to 200k","Over 200k")) %>%
filter(CD_data$color == "House: D; Pres: Clinton") %>%
gather("income_level","income_percent_of_pop",3:12) %>%
mutate(
income_level = factor(income_level, levels = c("Under 10k","10 to 15k","15 to 25k","25 to 35k","35 to 50k","50 to 75k","75 to 100k","100 to 150k","150 to 200k","Over 200k")))
CD_income_D_C_mean <- CD_income_D_C %>% group_by(income_level) %>%
summarise(D_C_mean_percent_of_pop = mean(income_percent_of_pop))
# Stack bar charts side by side
income_mean <- merge(CD_income_R_T_mean,CD_income_R_C_mean,by='income_level') %>%
merge(.,CD_income_D_T_mean, by= 'income_level') %>%
merge(.,CD_income_D_C_mean, by= "income_level") %>%
mutate(
income_level = factor(income_level, levels = c("Under 10k","10 to 15k","15 to 25k","25 to 35k","35 to 50k","50 to 75k","75 to 100k","100 to 150k","150 to 200k","Over 200k")))
colnames(income_mean) <- c('income_level',' "House: R; Trump"',' "House: R; Clinton"',' "House: D; Trump"',' "House: D; Clinton"')
income_mean <- income_mean[c(10,2,4,5,6,7,8,1,3,9),]
rownames(income_mean) <- NULL
# Mean Income scatterplot
CD_income_scatter <- CD_data[,c('income_median','margin_republican','margin_Trump')]
CD_income_scatter$repTrump <- ifelse(CD_income_scatter$margin_republican > 0 & CD_income_scatter$margin_Trump > 0, CD_income_scatter$margin_Trump, NA)
CD_income_scatter$repClinton <- ifelse(CD_income_scatter$margin_republican > 0 & CD_income_scatter$margin_Trump < 0, CD_income_scatter$margin_Trump, NA)
CD_income_scatter$demTrump <- ifelse(CD_income_scatter$margin_republican < 0 & CD_income_scatter$margin_Trump > 0, CD_income_scatter$margin_Trump, NA)
CD_income_scatter$demClinton <- ifelse(CD_income_scatter$margin_republican < 0 & CD_income_scatter$margin_Trump < 0, CD_income_scatter$margin_Trump, NA)
CD_income_scatter$margin_Trump <- NULL
CD_income_scatter$CD1.tooltip <- CD_data$CD
CD_income_scatter$CD2.tooltip <- CD_data$CD
CD_income_scatter$CD3.tooltip <- CD_data$CD
CD_income_scatter$CD4.tooltip <- CD_data$CD
CD_income_scatter$margin_republican <- NULL
CD_income_scatter <- CD_income_scatter[,c("income_median","repTrump","CD1.tooltip","repClinton","CD2.tooltip","demTrump","CD3.tooltip","demClinton","CD4.tooltip")]
# Tab 4: Education ####
# Name Columns
CD_data$'No Degree' <- CD_data$DP02_0059PE + CD_data$DP02_0060PE
CD_data$'High School' <- CD_data$DP02_0061PE + CD_data$DP02_0062PE
CD_data$'Bachelors/Associates' <- CD_data$DP02_0063PE + CD_data$DP02_0064PE
CD_data$'Professional' <- CD_data$DP02_0065PE
# Side by Side Bar Chart
# House: R; Pres: Trump
CD_education_R_T = CD_data %>%
select(c('CD','Trump','No Degree','High School','Bachelors/Associates','Professional')) %>%
filter(CD_data$color == "House: R; Pres: Trump") %>%
gather('education_level','education_percent_of_pop', 3:6) %>%
mutate(
education_level = factor(education_level, levels = c('No Degree','High School','Bachelors/Associates','Professional')))
CD_education_R_T_mean <- CD_education_R_T %>% group_by(education_level) %>%
summarise(mean_percent_of_pop = mean(education_percent_of_pop))
# House: R; Pres: Clinton
CD_education_R_C = CD_data %>%
select(c('CD','Trump','No Degree','High School','Bachelors/Associates','Professional')) %>%
filter(CD_data$color == "House: R; Pres: Clinton") %>%
gather('education_level','education_percent_of_pop', 3:6) %>%
mutate(
education_level = factor(education_level, levels = c('No Degree','High School','Bachelors/Associates','Professional')))
CD_education_R_C_mean <- CD_education_R_C %>% group_by(education_level) %>%
summarise(mean_percent_of_pop = mean(education_percent_of_pop))
# House: D; Pres: Trump
CD_education_D_T = CD_data %>%
select(c('CD','Trump','No Degree','High School','Bachelors/Associates','Professional')) %>%
filter(CD_data$color == "House: D; Pres: Trump") %>%
gather('education_level','education_percent_of_pop', 3:6) %>%
mutate(
education_level = factor(education_level, levels = c('No Degree','High School','Bachelors/Associates','Professional')))
CD_education_D_T_mean <- CD_education_D_T %>% group_by(education_level) %>%
summarise(mean_percent_of_pop = mean(education_percent_of_pop))
# House: D; Pres: Clinton
CD_education_D_C = CD_data %>%
select(c('CD','Trump','No Degree','High School','Bachelors/Associates','Professional')) %>%
filter(CD_data$color == "House: D; Pres: Clinton") %>%
gather('education_level','education_percent_of_pop', 3:6) %>%
mutate(
education_level = factor(education_level, levels = c('No Degree','High School','Bachelors/Associates','Professional')))
# Stack bar charts side by side
CD_education_D_C_mean <- CD_education_D_C %>% group_by(education_level) %>%
summarise(mean_percent_of_pop = mean(education_percent_of_pop))
# Tab 5: Race ####
# Name Columns
CD_data$White <- CD_data$DP05_0059PE
CD_data$Black <- CD_data$DP05_0060PE
CD_data$Native <- CD_data$DP05_0061PE
CD_data$Asian <- CD_data$DP05_0062PE
CD_data$Latino <- CD_data$DP05_0066PE
# Side-by-side bar charts
# House: R; Pres: Trump
CD_race_R_T = CD_data %>%
select(c('CD','Trump','White','Black','Native','Asian','Latino')) %>%
filter(CD_data$color == "House: R; Pres: Trump") %>%
gather('race_group','race_percent_of_pop', 3:7)
CD_race_R_T_mean <- CD_race_R_T %>% group_by(race_group) %>%
summarise(mean_percent_of_pop = mean(race_percent_of_pop))
# House: R; Pres: Clinton
CD_race_R_C = CD_data %>%
select(c('CD','Trump','White','Black','Native','Asian','Latino')) %>%
filter(CD_data$color == "House: R; Pres: Clinton") %>%
gather('race_group','race_percent_of_pop', 3:7)
CD_race_R_C_mean <- CD_race_R_C %>% group_by(race_group) %>%
summarise(mean_percent_of_pop = mean(race_percent_of_pop))
# House: D; Pres: Trump
CD_race_D_T = CD_data %>%
select(c('CD','Trump','White','Black','Native','Asian','Latino')) %>%
filter(CD_data$color == "House: D; Pres: Trump") %>%
gather('race_group','race_percent_of_pop', 3:7)
CD_race_D_T_mean <- CD_race_D_T %>% group_by(race_group) %>%
summarise(mean_percent_of_pop = mean(race_percent_of_pop))
# House: D; Pres: Clinton
CD_race_D_C = CD_data %>%
select(c('CD','Trump','White','Black','Native','Asian','Latino')) %>%
filter(CD_data$color == "House: D; Pres: Clinton") %>%
gather('race_group','race_percent_of_pop', 3:7)
# Stack bar charts side by side
CD_race_D_C_mean <- CD_race_D_C %>% group_by(race_group) %>%
summarise(mean_percent_of_pop = mean(race_percent_of_pop))
Raw
partyMisalignment_server
library(shiny)
shinyServer(function(input, output, session) {
# Tab 1: Map ####
output$text_tabIntro1a <- renderText({paste("<h4>","So who did you vote for?: ","</h4>")})
output$text_tabIntro1b <- renderText({paste("<b>","An examination of congressional and national party misalignment in the 2016 election.","</b>")})
output$text_tabIntro1c <- renderText({paste("by Franklin. E. Dickinson")})
output$text_tabIntro2 <- renderText({paste("Within the United States 2-Party system, a range of political identities exist within both the Republican and Democrat parties, each competing in the primaries to represent the party in the general election. Meanwhile, since the candidate at the Congressional level represents the localized party-identification of the district's population.")})
output$text_tabIntro4 <- renderText({paste("At the Presidential level, this divide can sometimes be so large that the other party's candidate better represents a certain group's view.")})
output$text_tabIntro5 <- renderText({paste("Therefore, Presidential elections where the majority Congressional and Presidential vote winners of a districts come from opposing party signify changing dominance in national party identity.")})
output$text_tabIntro6 <- renderText({paste("in the 2016 election, party misalignment occured in 35 of the 435 districts, and the following analysis compares the demographic features of these districts compared to their non-misaligned counterparts.")})
output$text_tabIntro7 <- renderText({paste("Demographic data comes via the U.S. Census Bureau's 2016 American Community Survey.")})
output$text_tabIntro8 <- renderText({paste('<i>',"I use",'<b>','color',"</b>"," to distinguish the four outcomes:",'</i>')})
output$text_tabIntro9 <- renderText({paste("In the following midterm elections, these districts are marked for close contest, and whether the incumbent can hold on makes clear whether these changes have been concretized.")})
output$text_tabIntroRed <- renderText({paste('<font color=\"#FF0000\"><b>','Red','</b></font>',' for districts won by a ','<font color=\"#FF0000\"><b>',"Republican Congressman and Donald Trump.",'</b></font>')})
output$text_tabIntroOrange <- renderText({paste('<font color=\"#FF8C00\"><b>','Orange','</b></font>',' for districts won by a ','<font color=\"#FF8C00\"><b>',"Democratic Congressman and Donald Trump.",'</b></font>')})
output$text_tabIntroPurple <- renderText({paste('<font color=\"#7913C1\"><b>','Purple','</b></font>',' for districts won by a ','<font color=\"#7913C1\"><b>',"Republican Congressman and Hilary Clinton.","</b></font>")})
output$text_tabIntroBlue <- renderText({paste('<font color=\"#0034E2\"><b>','Blue','</b></font>',' for districts won by a ','<font color=\"#0034E2\"><b>',"Democratic Congressman and Hilary Clinton.",'</b></font>')})
# Tab 2: Scatterplot & Sankey ####
output$text_tabScatter1 <- renderText({paste('This scatterplot reformulates the map, demonstrate the Congressional versus Presidential vote margin in the 2016 election for each Congressional District.')})
output$text_tabScatter4 <- renderText({paste('The Sankey plot below shows the 2016 results in relation to the previous 2014 Congress:')})
output$text_tabScatter5 <- renderText({paste('While Republicans mantained their district majority following the 2016 election, they lost more districts to Democrats than vice versa.')})
output$scatter <- renderGvis(scatter_margin)
output$CD_Sankey_plot <- renderGvis(gvisSankey(CD_Sankey, from='From',to='To',weight='Weight',
options = list(
sankey= "{node: { colors: ['red', 'red', 'purple', 'orange', 'blue', 'blue']}}" )))
# Tab 3: Income ####
output$text_tabIncome1 <- renderText({paste("The side-by-side bar chart below presents the average district population percent falling within each income bracket.")})
output$gvis_income_mean <- renderGvis({gvisColumnChart(data=income_mean,
options = list(
colors= "['red','purple','orange','blue']",
legend="{ position: 'top', maxLines: 2 }",
bar.groupWidth = '100%',
vAxis="{title: 'Percent of Vote'}",
hAxis="{title: 'Income Bracket (USD$)'}",
height=300
))})
output$gvis_scatter_income <- renderGvis({gvisScatterChart(data=CD_income_scatter,
options = list(
legend = 'top',
pointSize = 1.5,
colors= "['red','purple','orange','blue']",
vAxis="{title: 'Pres. Vote margin in favor of Trump'}",
hAxis="{title: 'Mean household income (USD$)'}",
height = 400
))})
# Tab 4: Education ####
output$text_tabEducation1 <- renderText({paste("The pie charts below present the average district population breakdown among various education levels.")})
output$gvisCD_education_R_T_mean <- renderGvis({gvisPieChart(data=CD_education_R_T_mean,
options = list(
title= 'House: Republican; Pres: Trump',
colors= "['ffd4d4','ff7c7c','d41b1b','a10808']"
))})
output$gvisCD_education_R_C_mean <- renderGvis({gvisPieChart(data=CD_education_R_C_mean,
options = list(
title= 'House: Republican; Pres: Clinton',
colors= "['f3d9fd','df85ff','9a33bf','6a2a81']"
))})
output$gvisCD_education_D_T_mean <- renderGvis({gvisPieChart(data=CD_education_D_T_mean,
options = list(
title= 'House: Democrat; Pres: Trump',
colors= "['ffdeab','ffbb53','fb9800','b26c00']"
))})
output$gvisCD_education_D_C_mean <- renderGvis({gvisPieChart(data=CD_education_D_C_mean,
options = list(
title= 'House: Democrat; Pres: Clinton',
colors= "['c5d7ff','77a0fd','135cff','003aba']"
))})
scatter_education_data <- reactive(CD_data %>%
select(.,input$scatter_education) %>%
mutate(.,repTrump = ifelse(CD_data$margin_republican > 0 & CD_data$margin_Trump > 0, CD_data$margin_Trump, NA)) %>%
mutate(.,repClinton = ifelse(CD_data$margin_republican > 0 & CD_data$margin_Trump < 0, CD_data$margin_Trump, NA)) %>%
mutate(.,demTrump = ifelse(CD_data$margin_republican < 0 & CD_data$margin_Trump > 0, CD_data$margin_Trump, NA)) %>%
mutate(.,demClinton = ifelse(CD_data$margin_republican < 0 & CD_data$margin_Trump < 0, CD_data$margin_Trump, NA)) %>%
mutate(.,CD1.tooltip = CD_data$CD) %>%
mutate(.,CD2.tooltip = CD_data$CD) %>%
mutate(.,CD3.tooltip = CD_data$CD) %>%
mutate(.,CD4.tooltip = CD_data$CD) %>%
select(input$scatter_education, repTrump, CD1.tooltip, repClinton, CD2.tooltip, demTrump, CD3.tooltip, demClinton, CD4.tooltip))
output$scatter_education_plot <- renderGvis(gvisScatterChart(scatter_education_data(),
options = list(
legend='top',
pointSize= 1.25,
title="Distribution of Support for Trump by Selected Education Level",
colors= "['red','purple','orange','blue']",
vAxis="{title: 'Presidential vote margin in favor of Trump'}",
hAxis="{title: '% of District achieving selected degree'}")))
# Tab 5: Race ####
output$text_tabRace1 <- renderText({paste("The pie charts below present the average district population breakdown among racial/ethnic identification.")})
output$gvisCD_race_R_T_mean <- renderGvis({gvisPieChart(data=CD_race_R_T_mean,
options = list(
title= 'House: Republican; Pres: Trump',
colors= "['ffd4d4','760202','fd8484','a10808','d41b1b']",
legend.position = 'bottom'
))})
output$gvisCD_race_R_C_mean <- renderGvis({gvisPieChart(data=CD_race_R_C_mean,
options = list(
title= 'House: Republican; Pres: Clinton',
colors= "['f3d9fd','3f0b5c','bd71ff','6a2a81','9a33bf']",
legend.position = 'bottom'
))})
output$gvisCD_race_D_T_mean <- renderGvis({gvisPieChart(data=CD_race_D_T_mean,
options = list(
title= 'House: Democrat; Pres: Trump',
colors= "['ffdeab','923b01','ffc071','b26c00','fb9800']",
legend.position = 'bottom'
))})
output$gvisCD_race_D_C_mean <- renderGvis({gvisPieChart(data=CD_race_D_C_mean,
options = list(
title= 'House: Democrat; Pres: Clinton',
colors= "['c5d7ff','121c6b','719eff','003aba','135cff']"
))})
scatter_race_data <- reactive(CD_data %>%
select(.,input$scatter_race) %>%
mutate(.,repTrump = ifelse(CD_data$margin_republican > 0 & CD_data$margin_Trump > 0, CD_data$margin_Trump, NA)) %>%
mutate(.,repClinton = ifelse(CD_data$margin_republican > 0 & CD_data$margin_Trump < 0, CD_data$margin_Trump, NA)) %>%
mutate(.,demTrump = ifelse(CD_data$margin_republican < 0 & CD_data$margin_Trump > 0, CD_data$margin_Trump, NA)) %>%
mutate(.,demClinton = ifelse(CD_data$margin_republican < 0 & CD_data$margin_Trump < 0, CD_data$margin_Trump, NA)) %>%
mutate(.,CD1.tooltip = CD_data$CD) %>%
mutate(.,CD2.tooltip = CD_data$CD) %>%
mutate(.,CD3.tooltip = CD_data$CD) %>%
mutate(.,CD4.tooltip = CD_data$CD) %>%
select(input$scatter_race, repTrump, CD1.tooltip, repClinton, CD2.tooltip, demTrump, CD3.tooltip, demClinton, CD4.tooltip))
output$scatter_race_plot <- renderGvis(gvisScatterChart(scatter_race_data(),
options = list(
legend='top',
pointSize= 1.25,
title="Distribution of Support for Trump by Selected Racial/Ethnic Group",
colors= "['red','purple','orange','blue']",
vAxis="{title: 'Presidential vote margin in favor of Trump'}",
hAxis="{title: '% of District identifying as Race/Ethnicity'}")))
})
Raw
partyMisalignment_ui
library(shiny)
shinyUI(navbarPage("2016 Election Matrix",
# Tab 1: Map ####
tabPanel("Map",
htmlOutput('text_tabIntro1a'),
htmlOutput('text_tabIntro1b'),
htmlOutput('text_tabIntro1c'),
br(),
fluidRow(column(width=6,offset=2,img(src = "map.png", align = "center"))),
br(),
textOutput('text_tabIntro2'),
br(),
htmlOutput('text_tabIntro4'),
br(),
htmlOutput('text_tabIntro5'),
br(),
htmlOutput('text_tabIntro6'),
htmlOutput('text_tabIntro7'),
br(),
htmlOutput('text_tabIntro8'),
fluidRow(column(width=8,offset=1,htmlOutput('text_tabIntroRed'))),
br(),
fluidRow(column(width=8,offset=1,htmlOutput('text_tabIntroOrange'))),
br(),
fluidRow(column(width=8,offset=1,htmlOutput('text_tabIntroPurple'))),
br(),
fluidRow(column(width=8,offset=1,htmlOutput('text_tabIntroBlue'))),
br(),
htmlOutput('text_tabIntro9'),
br()
),
# Tab 2: Scatterplot & Sankey ####
tabPanel("Scatter",
br(),
textOutput('text_tabScatter1'),
br(),
fluidRow(column(width=6,offset=2, htmlOutput('scatter'))),
br(),
textOutput('text_tabScatter4'),
br(),
fluidRow(column(width=6,offset=3,htmlOutput('CD_Sankey_plot'))),
br(),
textOutput('text_tabScatter5'),
br()
),
# Tab 3: Income ####
tabPanel('Income',
textOutput('text_tabIncome1'),
br(),
htmlOutput('gvis_income_mean'),
br(),
htmlOutput('gvis_scatter_income')),
# Tab 4: Education ####
tabPanel('Education',
textOutput('text_tabEducation1'),
fluidRow(
column(6,htmlOutput('gvisCD_education_D_T_mean')),
column(6,htmlOutput('gvisCD_education_R_T_mean'))),
fluidRow(
column(6,htmlOutput('gvisCD_education_D_C_mean')),
column(6,htmlOutput('gvisCD_education_R_C_mean'))),
br(),
selectizeInput(
inputId = 'scatter_education',
label = 'View distribution of selected education level:',
choices = c('No Degree','High School','Bachelors/Associates','Professional')),
br(),
htmlOutput('scatter_education_plot')
),
# Tab 5: Race ####
tabPanel('Race',
textOutput('text_tabRace1'),
fluidRow(
column(6,htmlOutput('gvisCD_race_D_T_mean')),
column(6,htmlOutput('gvisCD_race_R_T_mean'))),
fluidRow(
column(6,htmlOutput('gvisCD_race_D_C_mean')),
column(6,htmlOutput('gvisCD_race_R_C_mean'))),
br(),
selectizeInput(
inputId = 'scatter_race',
label = 'View distribution of selected race/ethnic group:',
choices = c('White','Black','Native','Asian','Latino')),
br(),
htmlOutput('scatter_race_plot')
)
))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment