Skip to content

Instantly share code, notes, and snippets.

@ryanburge ryanburge/scatter_states.R
Last active Dec 23, 2018

Embed
What would you like to do?
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")
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.