Skip to content
{{ message }}

Instantly share code, notes, and snippets.

# ryanburge/scatter_states.R

Last active Dec 23, 2018
State Level Scatterplots and More!
 ## Packages and Data library(haven) library(labelled) library(socsci) library(car) library(ggsci) library(jtools) cces16 <- read_dta("D://cces/data/cces16.dta") ## Making the dataset #### ## Caculating Means by State for LGB lgb <- cces16 %>% mutate(lgb = recode(sexuality, "2:5=1; else=0")) %>% group_by(inputstate) %>% ct(lgb, wt = commonweight_vv_lgbt) %>% mutate(state = to_factor(inputstate)) %>% filter(n > 250) %>% select(state, lgbmean = mean) ## Calculating Means by State for Evangelical #### ## Evangelical code here: https://github.com/ryanburge/reltrad/blob/master/CCES/reltrad16.R evan <- cces16 %>% group_by(inputstate) %>% mean_ci(evangelical, wt = commonweight_vv) %>% mutate(state = to_factor(inputstate)) %>% filter(n > 250) %>% select(state, evanmean = mean) ## Calculating Total Size of Each State's Sample tot <- cces16 %>% group_by(inputstate) %>% count() %>% ungroup(inputstate) %>% mutate(state = to_factor(inputstate)) %>% select(state, total = n) ## Joining graph <- left_join(lgb, evan) graph <- left_join(graph, tot) ## Calculating Mean of GOP per state gop <- cces16 %>% mutate(repub = recode(pid3, "2=1; else =0")) %>% group_by(inputstate) %>% mean_ci(repub, wt = commonweight_vv) %>% ungroup(inputstate) %>% mutate(state = to_factor(inputstate)) %>% select(state, gop = mean) graph <- left_join(graph, gop) ## Calculating Religious Importance rel <- cces16 %>% mutate(relimp = recode(pew_religimp, "1=1; else=0")) %>% group_by(inputstate) %>% mean_ci(relimp, wt = commonweight_vv) %>% ungroup(inputstate) %>% mutate(state = to_factor(inputstate)) %>% select(state, relimp = mean) graph <- left_join(graph, rel) #### Graphs #### ## Graphing Rel Imp vs GOP graph %>% ggplot(., aes(x= relimp, y = gop, size = total, color = gop)) + geom_point(shape = 21, stroke = 3) + geom_smooth(method = lm, color = "black") + theme_gg("Abel") + geom_text_repel(aes(relimp, y = gop, label = state), size = 10) + scale_color_gradient(low = "dodgerblue3", high = "firebrick3") + scale_y_continuous(labels = percent) + scale_x_continuous(labels = percent) + labs(x = "Percent of Who Say Religion is Very Important", y = "Percent of Who ID as Republicans", title = "Relationship between Partisanshp and Religious Importance", caption = "Data: CCES 2016") + ggsave("D://cces/images/state_gop_rel.png", width = 8, height = 8) ## Graphing LGB vs GOP graph %>% ggplot(., aes(x= lgbmean, y = gop, size = total, color = gop)) + geom_point(shape = 21, stroke = 3) + geom_smooth(method = lm, color = "black") + theme_gg("Abel") + geom_text_repel(aes(lgbmean, y = gop, label = state), size = 10) + scale_color_gradient(low = "dodgerblue3", high = "firebrick3") + scale_y_continuous(labels = percent) + scale_x_continuous(labels = percent) + labs(x = "Percent of LGBT in Population", y = "Percent of Who ID as Republicans", title = "Relationship between Partisanshp and LGB Population", caption = "Data: CCES 2016") + ggsave("D://cces/images/state_gop_lgb.png", width = 8, height = 8) ### Calculating LGB Percentage by State #### fun <- function(df, relig, fam){ relig <- enquo(relig) fam <- enquo(fam) df %>% group_by(!! relig) %>% mutate(lgb = recode(sexuality, "2:5=1; else=0")) %>% mean_ci(lgb) %>% filter(n > 100) %>% mutate(relig = to_factor(!! relig)) %>% filter(relig != "Skipped") %>% select(relig, mean, sd, n, level, se, lower, upper) %>% mutate(family = !! fam) } aa <- fun(cces16, religpew_methodist, "Methodist") aa1 <- fun(cces16, religpew_baptist, "Baptist") aa2 <- fun(cces16, religpew_nondenom, "Non-Denom") aa3 <- fun(cces16, religpew_lutheran, "Lutheran") aa4 <- fun(cces16, religpew_presby, "Presbyterian") aa5 <- fun(cces16, religpew_pentecost, "Pentecostal") aa6 <- fun(cces16, religpew_episcop, "Episcopal") aa7 <- fun(cces16, religpew_congreg, "Congregational") aa8 <- fun(cces16, religpew_holiness, "Holiness") aa9 <- fun(cces16, religpew_reformed, "Reformed") aa10 <- cces16 %>% group_by(religpew) %>% mutate(lgb = recode(sexuality, "2:5=1; else=0")) %>% mean_ci(lgb) %>% filter(n > 100) %>% mutate(relig = to_factor(religpew)) %>% filter(relig != "Protestant") %>% select(-religpew) aa10\$family <- c("Catholic", "Mormon", "Orthodox", "Jewish", "Other Religion", "Other Religion", "Other Religion", "None", "None", "None", "Other Religion") graph <- bind_df("aa") ## Graphing LGB by Denom graph %>% ggplot(., aes(y=mean, x= fct_reorder(relig, mean), color = factor(family))) + geom_point(size = 2) + geom_errorbar(aes(ymin = lower, ymax=upper), size = 1) + coord_flip() + scale_color_d3(palette = "category20") + theme_gg("Abel") + labs(title = "What Traditions Have the Most LGB Members?", y = "Percent of Tradition that Identifies as LGB", x = "Religious Tradition", caption = "Data: CCES 2016") + theme(legend.position = "none") + theme(legend.title=element_blank()) + theme(plot.title = element_text(size = 64)) + scale_y_continuous(labels = percent) + theme(legend.position = c(.85,.45)) + geom_hline(yintercept = .083, linetype = "dashed") + annotate("text", x=48, y = .07, label = "Sample Avg.", size = 16, family = "font") + annotate("text", x=46, y = .07, label = "8.3%", size = 16, family = "font") + ggsave("D://cces/images/gay_denom.png", width = 12, height = 8) cces16 %>% mutate(lgb = recode(sexuality, "2:5=1; else=0")) %>% ct(lgb, wt = commonweight_vv_lgbt) ### Regression Analysis #### lm(lgbmean ~ gop, data = graph) reg1 <- lm(lgbmean ~ relimp + gop, data = graph) summary(reg1) dwplot(reg1) ## Wanted to Make Relimp and PID7 have the full range of values pid1 <- cces16 %>% filter(pid7 <= 7) %>% mutate(pid1 = pid7/7) %>% group_by(inputstate) %>% mean_ci(pid1, wt = commonweight_vv) %>% ungroup(inputstate) %>% mutate(state = to_factor(inputstate)) %>% select(state, pid1 = mean) rel1 <- cces16 %>% filter(pew_religimp <=4) %>% mutate(imp = recode(pew_religimp, "1=1;2=.6666;3=.33333;4=0")) %>% group_by(inputstate) %>% mean_ci(imp) %>% ungroup(inputstate) %>% mutate(state = to_factor(inputstate)) %>% select(state, rel1 = mean) graph <- left_join(graph, pid1) graph <- left_join(graph, rel1) ## Trying out Jtools gg <- lm(lgbmean ~ pid7*rel1, data = graph) gg2 <- interact_plot(gg, pred= pid7, modx = rel1, interval = T, int.width = .76) reg1 <- lm(lgbmean ~ rel1 + pid7, weights = total, data = graph) summary(reg1) dwplot(reg1) reg1 <- lm(lgbmean ~ rel1 + pid1, weights = total, data = graph) dwplot(reg1, vline = geom_vline(xintercept = 0, colour = "grey60", linetype = 2)) %>% relabel_predictors(rel1 = "Religious Importance", pid1 = "Republican Party ID") + theme_gg("Abel") + labs(x = "Coefficient Estimate", y = "", title = "Predicting % of LGBT (State Level)") + ggsave("D://cces/images/regress.png")
to join this conversation on GitHub. Already have an account? Sign in to comment