Data for Progress 2018 First Cut Analysis

dfp_vote_pid.R

library(socsci)
library(car)

dfp <- read_csv("D://dfp/data.csv")

## PID Change Graph ####

dd18 <- dfp %>% 
  filter(race ==1) %>% 
  filter(religpew ==1) %>% 
  filter(pew_bornagain ==1) %>% 
  filter(pid7 <= 7) %>% 
  mutate(att = recode(pew_churatd, "1=6; 2=5; 3=4; 4=3; 5=2; 6=1; else = NA")) %>% 
  group_by(att) %>% 
  mean_ci(pid7, wt = weight_DFP, ci = .84) %>% 
  mutate(att = frcode(att == 1 ~ "Never",
                      att == 2 ~ "Seldom",
                      att == 3 ~ "Yearly", 
                      att == 4 ~ "Monthly", 
                      att == 5 ~ "Weekly", 
                      att == 6 ~ "Weekly+",
                      att == 7 ~ "Don`t Know",
                      TRUE ~ "REMOVE")) %>% 
  mutate(year = 2018)
  
dd16 <- cces16 %>% 
  filter(race ==1) %>% 
  filter(religpew ==1) %>% 
  filter(pew_bornagain ==1) %>% 
  filter(pid7 <= 7) %>% 
  mutate(att = recode(pew_churatd, "1=6; 2=5; 3=4; 4=3; 5=2; 6=1; else = NA")) %>% 
  group_by(att) %>% 
  mean_ci(pid7, wt = commonweight_vv, ci = .84) %>% 
  mutate(att = frcode(att == 1 ~ "Never",
                      att == 2 ~ "Seldom",
                      att == 3 ~ "Yearly", 
                      att == 4 ~ "Monthly", 
                      att == 5 ~ "Weekly", 
                      att == 6 ~ "Weekly+",
                      att == 7 ~ "Don`t Know",
                      TRUE ~ "REMOVE")) %>% 
  mutate(year = 2016)

dd14 <- cces14 %>% 
  filter(race ==1) %>% 
  filter(religpew ==1) %>% 
  filter(pew_bornagain ==1) %>% 
  filter(pid7 <= 7) %>% 
  mutate(att = recode(pew_churatd, "1=6; 2=5; 3=4; 4=3; 5=2; 6=1; else = NA")) %>% 
  group_by(att) %>% 
  mean_ci(pid7, wt = weight, ci = .84) %>% 
  mutate(att = frcode(att == 1 ~ "Never",
                      att == 2 ~ "Seldom",
                      att == 3 ~ "Yearly", 
                      att == 4 ~ "Monthly", 
                      att == 5 ~ "Weekly", 
                      att == 6 ~ "Weekly+",
                      att == 7 ~ "Don`t Know",
                      TRUE ~ "REMOVE")) %>% 
  mutate(year = 2014)


dd12 <- cces12 %>% 
  filter(race ==1) %>% 
  filter(religpew ==1) %>% 
  filter(pew_bornagain ==1) %>% 
  filter(pid7 <= 7) %>% 
  mutate(att = recode(pew_churatd, "1=6; 2=5; 3=4; 4=3; 5=2; 6=1; else = NA")) %>% 
  group_by(att) %>% 
  mean_ci(pid7, wt = weight_vv, ci = .84) %>% 
  mutate(att = frcode(att == 1 ~ "Never",
                      att == 2 ~ "Seldom",
                      att == 3 ~ "Yearly", 
                      att == 4 ~ "Monthly", 
                      att == 5 ~ "Weekly", 
                      att == 6 ~ "Weekly+",
                      att == 7 ~ "Don`t Know",
                      TRUE ~ "REMOVE")) %>% 
  mutate(year = 2012)


graph <- bind_df("dd") %>% 
  filter(att != "REMOVE") %>% 
  mutate(year = as.factor(year))


graph %>% 
  ggplot(., aes(x= att, y = mean, group = year, color = year)) +
  geom_point() + 
  geom_line(size = 1) +
  theme_gg("Abel") +
  geom_ribbon(aes(ymin=lower, ymax=upper, color = year, fill = year), alpha = .05, show.legend = FALSE) +
  scale_color_manual(values=c("darkorchid", "azure4", "forestgreen", "firebrick1")) +
  scale_fill_manual(values=c("darkorchid", "azure4", "forestgreen", "firebrick1")) +
  scale_y_continuous(limits = c(3,7), breaks = c(1,2,3,4,5,6,7), labels = c("Strong Democrat", "Not Strong Democrat", "Lean Democrat", "Independent", "Lean Republican", "Moderate Republican", "Strong Republican"))  +  
  labs(x ="Church Attendance", y = "Mean Party Identification", subtitle = "Among White Born-Again Protestants", title = "The Change in Party ID At Each Attendance Level", caption = "Data: CCES (2012-2016) and Data for Progress (2018)") +
  theme(legend.position = c(0.8, 0.3)) +
  theme(legend.title=element_blank()) +
  ggsave("D://dfp/pid_ribbons.png") 


## Vote Graph ####

graph1 <- dfp %>% 
  filter(race ==1) %>% 
  filter(religpew ==1) %>% 
  filter(pew_bornagain ==1) %>% 
  filter(pid7 <= 7) %>% 
  mutate(att = recode(pew_churatd, "1=6; 2=5; 3=4; 4=3; 5=2; 6=1; else = NA")) %>% 
  mutate(rep_vote = recode(housevote18_full, "3=1; 1:2=0; else = NA")) %>% 
  group_by(att) %>% 
  mean_ci(rep_vote, ci = .84, wt = weight_DFP) %>% 
  ungroup(att) %>%  mutate(att = frcode(att == 1 ~ "Never",
                                        att == 2 ~ "Seldom",
                                        att == 3 ~ "Yearly", 
                                        att == 4 ~ "Monthly", 
                                        att == 5 ~ "Weekly", 
                                        att == 6 ~ "Weekly+",
                                        att == 7 ~ "Don`t Know",
                                        TRUE ~ "REMOVE")) %>% 
  mutate(year = "  2018  ")


graph2 <- cces16 %>% 
  filter(race ==1) %>% 
  filter(religpew ==1) %>% 
  filter(pew_bornagain ==1) %>% 
  filter(pid7 <= 7) %>% 
  mutate(att = recode(pew_churatd, "1=6; 2=5; 3=4; 4=3; 5=2; 6=1; else = NA")) %>% 
  mutate(vote16 = recode(CC16_410a, "1=1; 2=0; else = NA")) %>% 
  group_by(att) %>% 
  mean_ci(vote16, ci = .84, wt = commonweight_vv_post) %>% 
  mutate(att = frcode(att == 1 ~ "Never",
                      att == 2 ~ "Seldom",
                      att == 3 ~ "Yearly", 
                      att == 4 ~ "Monthly", 
                      att == 5 ~ "Weekly", 
                      att == 6 ~ "Weekly+",
                      att == 7 ~ "Don`t Know",
                      TRUE ~ "REMOVE")) %>% 
  mutate(year = "  2016  ")



graph3 <- cces12 %>% 
  filter(race ==1) %>% 
  filter(religpew ==1) %>% 
  filter(pew_bornagain ==1) %>% 
  filter(pid7 <= 7) %>% 
  mutate(att = recode(pew_churatd, "1=6; 2=5; 3=4; 4=3; 5=2; 6=1; else = NA")) %>% 
  mutate(vote12 = recode(CC410a, "2=1; 1=0; else = NA")) %>% 
  group_by(att) %>% 
  mean_ci(vote12, wt= weight_vv, ci = .84 ) %>% 
  mutate(att = frcode(att == 1 ~ "Never",
                      att == 2 ~ "Seldom",
                      att == 3 ~ "Yearly", 
                      att == 4 ~ "Monthly", 
                      att == 5 ~ "Weekly", 
                      att == 6 ~ "Weekly+",
                      att == 7 ~ "Don`t Know",
                      TRUE ~ "REMOVE")) %>% 
  mutate(year = "  2012  ")




graph <- bind_rows(graph1, graph2, graph3)


graph %>% 
  filter(att != "REMOVE") %>% 
  mutate(mean = round(mean, 3)) %>% 
  ggplot(., aes(x=att, y = mean, fill = factor(year))) +
  geom_col(color = "black", position = "dodge") +
  theme_gg("Abel") +
  scale_y_continuous(labels = percent) +
  geom_errorbar(aes(ymin=lower, ymax=upper), width=.2, position=position_dodge(.9)) +
  scale_fill_manual(values = c("#d5e0f3", "#656371", "#ff7369")) +
  geom_text(aes(y = .08 , label = paste0(mean*100, '%')), position = position_dodge(width = .9), size = 4, family = "font") +
  labs(x  = "", y = "Share of Two Party Vote for Republicans", title = "White Evangelicals Vote Choice", subtitle = "Share for 2018 is based on House vote - 84% CIs", caption = "Data: CCES (2012-2016) and Data for Progress (2018)") +
  theme(legend.position = "bottom") +
  ggsave("D://dfp/vote.png", width = 10)


## PID Shift Graph ####

graph <- dfp %>% 
  # filter(race ==1) %>% 
  filter(religpew ==1) %>% 
  filter(pew_bornagain ==1) %>% 
  mutate(age = recode(age5, "1:3 = '  Under 50  '; 3:5= '  Over 50  '")) %>% 
  group_by(age) %>% 
  ct(suprpty, wt = weight_DFP) %>% 
  mutate(suprpty = frcode(suprpty == 1 ~ "Always Dem.", 
                          suprpty == 2 ~ "Was GOP, Now Dem.",
                          suprpty == 3 ~ "Was Dem., Now GOP", 
                          suprpty == 4 ~ "Always GOP", 
                          suprpty == 5 ~ "Not Sure")) 


graph %>% 
  ggplot(., aes(x=suprpty, y = pct, fill = fct_rev(age))) +
  geom_col(color = "black", position = "dodge") +
  theme_gg("Abel") +
  scale_y_continuous(labels = percent) +
  # geom_errorbar(aes(ymin=lower, ymax=upper), width=.2, position=position_dodge(.9)) +
  scale_fill_manual(values = c("#d5e0f3", "#656371", "#ff7369")) +
  geom_text(aes(y = .06 , label = paste0(pct*100, '%')), position = position_dodge(width = .9), size = 4, family = "font") +
  labs(x  = "", y = "Share of Two Party Vote for Republicans", title = "Which of the following best describes you?", subtitle = "Among Born-Again Protestants", caption = "Data: Data for Progress (2018)") +
  theme(legend.position = "bottom") +
  ggsave("D://dfp/pid_change_age.png", width = 10)


### Heatmap Crosstab ####


heat <- dfp %>% 
  filter(race ==1) %>% 
  filter(religpew ==1) %>% 
  filter(pew_bornagain ==1) %>% 
  mutate(att = frcode(pew_churatd == 6 ~ "Never",
                      pew_churatd == 5 ~ "Seldom",
                      pew_churatd == 4 ~ "Yearly", 
                      pew_churatd == 3 ~ "Monthly", 
                      pew_churatd == 2 ~ "Weekly", 
                      pew_churatd == 1 ~ "Weekly+")) %>% 
  filter(app_dtrmp <= 4) %>% 
  mutate(tr = frcode(app_dtrmp == 4 ~ "Strongly Disapprove", 
                     app_dtrmp == 3 ~ "Somewhat Disapprove", 
                     app_dtrmp == 2 ~ "Somewhat Approve", 
                     app_dtrmp == 1 ~ "Strongly Approve")) %>% 
  select(att, tr) %>% 
  group_by(att) %>% 
  ct(tr) %>% 
  ungroup(att) %>% 
  add_row(att = "Monthly", tr = "Somewhat Disapprove", n = 0, pct = 0)


heat %>% 
  filter(att != "NA") %>% 
  ggplot(., aes(x= att, y = tr)) +
  geom_tile(aes(fill = pct), color = "black") +
  scale_fill_gradient(low = "azure3", high = "#E94057") +
  theme_gg("Abel") +
  geom_text(aes(x= att, y = tr, label = paste0(pct*100, '%')), size = 4, family = "font") +
  labs(x= "", y = "", title = "Job Approval for President Trump", subtitle = "Among White Born-Again Protestants", caption = "Data: Data for Progress (2018)") +
  ggsave("D://dfp/heatmap.png", width = 6)

## Favorability Graph ####

favor_fun <- function(df, var, var1){
  
  var <- enquo(var)
  
  df1 <- df %>% 
    filter(race ==1) %>% 
    filter(religpew ==1) %>% 
    filter(pew_bornagain ==1) %>% 
    filter(!! var <= 4) %>% 
    mutate(ques = recode(!! var, "1=4; 2=3; 3=2; 4=1")) %>% 
    mean_ci(ques, wt = weight_DFP, ci = .84) %>% 
    mutate(group = var1) %>% 
    mutate(sample = "White BA Prot.") 
    
  df2 <- df %>% 
    filter(race !=1) %>% 
    filter(religpew ==1) %>% 
    filter(pew_bornagain ==1) %>% 
    filter(!! var <= 4) %>% 
    mutate(ques = recode(!! var, "1=4; 2=3; 3=2; 4=1")) %>% 
    mean_ci(ques, wt = weight_DFP, ci = .84) %>%  
    mutate(group = var1) %>% 
    mutate(sample = "Non-White BA Prot.") 
  
  df3 <- df %>% 
    filter(race ==1) %>% 
    filter(pew_bornagain ==2) %>% 
    filter(!! var <= 4) %>% 
    mutate(ques = recode(!! var, "1=4; 2=3; 3=2; 4=1")) %>% 
    mean_ci(ques, wt = weight_DFP, ci = .84) %>%  
    mutate(group = var1) %>% 
    mutate(sample = "White Non-BA") 
  
  bind_rows(df1, df2, df3)
}


eee1 <- dfp %>% favor_fun(favor_labor, "Labor Unions")
eee2 <- dfp %>% favor_fun(favor_dem, "Democratic Party")
eee3 <- dfp %>% favor_fun(favor_rep, "Republican Party")
eee4 <- dfp %>% favor_fun(favor_aca, "Obamacare/ACA")
eee5 <- dfp %>% favor_fun(favor_dtrump, "Trump")
eee6 <- dfp %>% favor_fun(favor_mcconnell, "McConnell")
eee7 <- dfp %>% favor_fun(favor_demcong, "Dem. in Congress")
eee8 <- dfp %>% favor_fun(favor_repcong, "Rep. in Congress")
eee9 <- dfp %>% favor_fun(favor_metoo, "MeToo")
eee10 <- dfp %>% favor_fun(favor_blm, "Black Lives Matter")


graph <- bind_df("eee")


graph %>% 
  ggplot(., aes(y=mean, x= fct_reorder(group, mean), color = sample)) +
  geom_point(position=position_dodge(width=0.5), size =4) +
  geom_errorbar(aes(ymin = lower, ymax=upper), position=position_dodge(0.5), size = 1) +
  coord_flip() +
  theme_gg("Abel") +
  labs(title = "Favorability of Various Groups", x = "", y = "Level of Favorability", caption = "Data: Data for Progress (2018)") +
  scale_y_continuous(limits = c(0.85,4.05), breaks = c(1,2,3,4), labels = c("Very Unfavorable", "Somewhat Unfavorable", "Somewhat Favorable", "Very Favorable")) +
  scale_color_npg() + 
  theme(legend.position = "bottom") +  
  theme(legend.title=element_blank()) +
  theme(text=element_text(size=28, family="font")) +
  ggsave("D://dfp/group_like.png", height = 6, width =16)