-
-
Save ryanburge/7b7afbeed1774ed664546c2300dc203f to your computer and use it in GitHub Desktop.
Gay Marriage Gay Sex
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
## Graph 1 #### | |
ttt1 <- gss %>% | |
gss_reltrad(reltrad) %>% | |
mutate(mar = case_when(marhomo == 1 | marhomo == 2 ~ 1, | |
marhomo == 3 | marhomo == 4 | marhomo == 5 ~ 0)) %>% | |
group_by(year, reltrad) %>% | |
mean_ci(mar, wt = wtss) %>% | |
na.omit() %>% | |
mutate(type = "Should Have Right to Marry") | |
ttt2 <- gss %>% | |
gss_reltrad(reltrad) %>% | |
mutate(mar = case_when(homosex == 4 ~ 1, | |
homosex == 3 | homosex == 2 | homosex == 1 ~ 0)) %>% | |
group_by(year, reltrad) %>% | |
mean_ci(mar, wt = wtss) %>% | |
na.omit() %>% | |
mutate(type = "Same Sex Relations - Not Wrong at All") | |
graph <- bind_rows(ttt1, ttt2) | |
graph %>% | |
ggplot(., aes(x = year, y= mean, color = type, group = type)) + | |
geom_point() + | |
smooth() + | |
facet_wrap(~ reltrad) + | |
y_pct() + | |
theme_gg("Abel", legend = TRUE) + | |
scale_x_continuous(breaks = c(1978, 1988, 1998, 2008, 2018)) + | |
scale_color_manual(values = c("#00539C", "#EEA47F")) + | |
labs(x = "", y = "", title = "Different Views of Same Sex Couples", caption = "@ryanburge\nData: GSS 1973-2018") + | |
ggsave("E://ssm_two_waves.png", type = "cairo-png", width = 7, height = 7) | |
### Graph 2 #### | |
graph <- gss %>% | |
filter(year >= 2010) %>% | |
gss_reltrad6(reltrad) %>% | |
mutate(sex = frcode(homosex == 4 ~ "Favor", | |
homosex == 3 | homosex == 2 | homosex == 1 ~ "Oppose")) %>% | |
mutate(mar = case_when(marhomo == 1 | marhomo == 2 ~ "Favor", | |
marhomo == 3 | marhomo == 4 | marhomo == 5 ~ "Oppose")) %>% | |
group_by(reltrad, sex) %>% | |
ct(mar, show_na = FALSE, wt = wtss) %>% | |
na.omit() | |
graph <- graph %>% | |
group_by(reltrad) %>% | |
summarise(sum = sum(n)) %>% | |
left_join(graph) %>% | |
mutate(pct = n/sum) %>% | |
mutate(pct = round(pct, 3)) | |
graph %>% | |
ggplot(., aes(x= sex, y = mar)) + | |
geom_tile(aes(fill = pct), color = "black") + | |
facet_wrap(~ reltrad) + | |
scale_fill_gradient2(low = "#9CECFB", mid = "#65C7F7", high = "#0052D4", midpoint = .35) + | |
theme_gg("Abel") + | |
geom_text(aes(x= sex, y = mar, label = paste0(pct*100, '%')), size = 4, family = "font") + | |
labs(x= "Homosexual Sex", y = "Same-Sex Marriage", title = "Crosstab Views of Homosexuality", subtitle = "", caption = "@ryanburge\nData: GSS 2010-2018") + | |
ggsave("E://ssm_heat.png", width = 6) | |
## Graph 3 #### | |
gss %>% | |
filter(year >= 2010) %>% | |
mutate(sex = frcode(homosex == 4 ~ "Favor", | |
homosex == 3 | homosex == 2 | homosex == 1 ~ "Oppose")) %>% | |
mutate(mar = case_when(marhomo == 1 | marhomo == 2 ~ "Favor", | |
marhomo == 3 | marhomo == 4 | marhomo == 5 ~ "Oppose")) %>% | |
mutate(age2 = frcode(age <= 35 ~ "18-35", | |
age >= 36 & age <= 64 ~ "36-64", | |
age >= 65 ~ "65+")) %>% | |
filter(sex == "Oppose") %>% | |
filter(mar == "Favor") %>% | |
ct(age2, wt = wtss) | |
gg <- gss %>% | |
filter(year >= 2010) %>% | |
mutate(sex = frcode(homosex == 4 ~ "Favor", | |
homosex == 3 | homosex == 2 | homosex == 1 ~ "Oppose")) %>% | |
mutate(mar = case_when(marhomo == 1 | marhomo == 2 ~ "Favor", | |
marhomo == 3 | marhomo == 4 | marhomo == 5 ~ "Oppose")) %>% | |
filter(sex == "Oppose") %>% | |
filter(mar == "Favor") %>% | |
filter(partyid <= 6) %>% | |
ct(partyid, wt =wtss, show_na = FALSE) %>% | |
mutate(pid7 = frcode(partyid == 0 ~ "Str. Dem.", | |
partyid == 1 ~ "Not Str. Dem.", | |
partyid == 2 ~ "Lean Dem.", | |
partyid == 3 ~ "Ind.", | |
partyid == 4 ~ "Lean Rep.", | |
partyid == 5 ~ "Not Str. Rep.", | |
partyid == 6 ~ "Str. Rep.")) | |
one <- gg %>% | |
ggplot(., aes(x = 1, y = pct, fill = fct_rev(pid7))) + | |
geom_col(color = "black") + | |
coord_flip() + | |
pid7_fill() + | |
theme_gg("Abel") + | |
theme(legend.position = "bottom") + | |
scale_y_continuous(labels = percent) + | |
theme(strip.text.y.left = element_text(angle=0)) + | |
guides(fill = guide_legend(reverse=T, nrow = 1)) + | |
theme(axis.title.y=element_blank(), axis.text.y=element_blank(), axis.ticks.y=element_blank()) + | |
theme(panel.grid.minor.y=element_blank(), panel.grid.major.y=element_blank()) + | |
geom_text(aes(label = ifelse(pct >.05, paste0(pct*100, '%'), '')), position = position_stack(vjust = 0.5), size = 4, family = "font", color = "black") + | |
labs(x = "", y = "", title = "Who Are Those Opposed to Gay Sex, But in Favor of Gay Marriage?", subtitle = "Partisanship", caption = "") + | |
ggsave("E://pid7_gaysex.png", width = 9, height = 2.25) | |
## Age ### | |
gg <- gss %>% | |
filter(year >= 2010) %>% | |
mutate(sex = frcode(homosex == 4 ~ "Favor", | |
homosex == 3 | homosex == 2 | homosex == 1 ~ "Oppose")) %>% | |
mutate(mar = case_when(marhomo == 1 | marhomo == 2 ~ "Favor", | |
marhomo == 3 | marhomo == 4 | marhomo == 5 ~ "Oppose")) %>% | |
mutate(age2 = frcode(age <= 35 ~ "18-35", | |
age >= 36 & age <= 64 ~ "36-64", | |
age >= 65 ~ "65+")) %>% | |
filter(sex == "Oppose") %>% | |
filter(mar == "Favor") %>% | |
ct(age2, wt = wtss, show_na = FALSE) | |
two <- gg %>% | |
ggplot(., aes(x = 1, y = pct, fill = fct_rev(age2))) + | |
geom_col(color = "black") + | |
coord_flip() + | |
scale_fill_manual(values = c("#EE5455", "#5a70d6", "#FAD743")) + | |
theme_gg("Abel") + | |
theme(legend.position = "bottom") + | |
scale_y_continuous(labels = percent) + | |
theme(strip.text.y.left = element_text(angle=0)) + | |
guides(fill = guide_legend(reverse=T, nrow = 1)) + | |
theme(axis.title.y=element_blank(), axis.text.y=element_blank(), axis.ticks.y=element_blank()) + | |
theme(panel.grid.minor.y=element_blank(), panel.grid.major.y=element_blank()) + | |
geom_text(aes(label = ifelse(pct >.05, paste0(pct*100, '%'), '')), position = position_stack(vjust = 0.5), size = 4, family = "font", color = "black") + | |
labs(x = "", y = "", title = "", subtitle = "Age", caption = "") + | |
ggsave("E://age_gaysex.png", width = 9, height = 2.25) | |
## Race ### | |
gg <- gss %>% | |
filter(year >= 2010) %>% | |
mutate(sex = frcode(homosex == 4 ~ "Favor", | |
homosex == 3 | homosex == 2 | homosex == 1 ~ "Oppose")) %>% | |
mutate(mar = case_when(marhomo == 1 | marhomo == 2 ~ "Favor", | |
marhomo == 3 | marhomo == 4 | marhomo == 5 ~ "Oppose")) %>% | |
mutate(race = frcode(race == 1 & hispanic == 1 ~ "White", | |
race == 2 ~ "Black", | |
race == 1 & hispanic != 1 ~ "Hispanic", | |
TRUE ~ "Something Else")) %>% | |
filter(sex == "Oppose") %>% | |
filter(mar == "Favor") %>% | |
ct(race, wt = wtss, show_na = FALSE) | |
three <- gg %>% | |
ggplot(., aes(x = 1, y = pct, fill = fct_rev(race))) + | |
geom_col(color = "black") + | |
coord_flip() + | |
scale_fill_manual(values = c("#004986", "#B97441", "#FCF4EA", "#FFC845")) + | |
theme_gg("Abel") + | |
theme(legend.position = "bottom") + | |
scale_y_continuous(labels = percent) + | |
theme(strip.text.y.left = element_text(angle=0)) + | |
guides(fill = guide_legend(reverse=T, nrow = 1)) + | |
theme(axis.title.y=element_blank(), axis.text.y=element_blank(), axis.ticks.y=element_blank()) + | |
theme(panel.grid.minor.y=element_blank(), panel.grid.major.y=element_blank()) + | |
geom_text(aes(label = ifelse(pct >.05, paste0(pct*100, '%'), '')), position = position_stack(vjust = 0.5), size = 4, family = "font", color = "black") + | |
labs(x = "", y = "", title = "", subtitle = "Race", caption = "") + | |
ggsave("E://race_gaysex.png", width = 9, height = 2.25) | |
## Attend ### | |
gg <- gss %>% | |
filter(year >= 2010) %>% | |
mutate(sex = frcode(homosex == 4 ~ "Favor", | |
homosex == 3 | homosex == 2 | homosex == 1 ~ "Oppose")) %>% | |
mutate(mar = case_when(marhomo == 1 | marhomo == 2 ~ "Favor", | |
marhomo == 3 | marhomo == 4 | marhomo == 5 ~ "Oppose")) %>% | |
mutate(race = frcode(race == 1 & hispanic == 1 ~ "White", | |
race == 2 ~ "Black", | |
race == 1 & hispanic != 1 ~ "Hispanic", | |
TRUE ~ "Something Else")) %>% | |
filter(sex == "Oppose") %>% | |
filter(mar == "Favor") %>% | |
mutate(att = frcode(attend == 0 ~ "Never", | |
attend == 1 | attend == 2 | attend == 3 ~ "Yearly", | |
attend == 4 | attend == 5 ~ "Monthly", | |
attend == 6 | attend == 7 | attend == 8 ~ "Weekly")) %>% | |
ct(att, wt = wtss, show_na = FALSE) | |
four <- gg %>% | |
ggplot(., aes(x = 1, y = pct, fill = fct_rev(att))) + | |
geom_col(color = "black") + | |
coord_flip() + | |
scale_fill_manual(values = c("#79D7F7", "#838B96", "#D1DDE6", "#F5F5F5")) + | |
theme_gg("Abel") + | |
theme(legend.position = "bottom") + | |
scale_y_continuous(labels = percent) + | |
theme(strip.text.y.left = element_text(angle=0)) + | |
guides(fill = guide_legend(reverse=T, nrow = 1)) + | |
theme(axis.title.y=element_blank(), axis.text.y=element_blank(), axis.ticks.y=element_blank()) + | |
theme(panel.grid.minor.y=element_blank(), panel.grid.major.y=element_blank()) + | |
geom_text(aes(label = ifelse(pct >.05, paste0(pct*100, '%'), '')), position = position_stack(vjust = 0.5), size = 4, family = "font", color = "black") + | |
labs(x = "", y = "", title = "", subtitle = "Church Attendance", caption = "@ryanburge\nData: GSS 2010-2018") + | |
ggsave("E://attend_gaysex.png", width = 9, height = 2.25) | |
library(patchwork) | |
all <- one / two / three / four | |
ggsave("E://patched_gaysex.png", width = 9, height = 9, all) | |
## Graph 4 #### | |
ppp1 <- gss %>% | |
filter(evangelical == 1) %>% | |
filter(age <= 35) %>% | |
mutate(gaym = case_when(marhomo == 1 | marhomo == 2 ~ 1, | |
marhomo == 3 | marhomo == 4 | marhomo == 5 ~ 0)) %>% | |
group_by(year) %>% | |
mean_ci(gaym, wt = wtss) %>% | |
na.omit() %>% | |
mutate(type = "Should Have Right to Marry") | |
ppp2 <- gss %>% | |
filter(evangelical == 1) %>% | |
filter(age <= 35) %>% | |
mutate(mar = case_when(homosex == 4 ~ 1, | |
homosex == 3 | homosex == 2 | homosex == 1 ~ 0)) %>% | |
group_by(year) %>% | |
mean_ci(mar, wt = wtss) %>% | |
na.omit() %>% | |
mutate(type = "Same Sex Relations - Not Wrong at All") | |
gg <- bind_rows(ppp1, ppp2) | |
top <- gg %>% | |
filter(year >= 2004) %>% | |
ggplot(., aes(x = year, y = mean, fill = type)) + | |
geom_col(color = "black", position = "dodge") + | |
geom_errorbar(aes(ymin=lower, ymax=upper), width=.2, position=position_dodge(1.85)) + | |
geom_text(aes(y = .05, label = paste0(mean*100, '%')), position = position_dodge(width = 1.85), size = 4, family = "font") + | |
theme_gg("Abel") + | |
y_pct() + | |
scale_fill_manual(values = c("#1C88AC", "#31BD01")) + | |
scale_x_continuous(breaks = c(2004, 2008, 2012, 2016)) + | |
labs(x = "", y= "", title = "Views of Homosexuality", caption = "", subtitle = "Evangelical Respondents Between 18 and 35") + | |
ggsave("E://gaym_young_evan_dodge.png", type = "cairo-png", width = 9) | |
ppp1 <- gss %>% | |
filter(evangelical != 1) %>% | |
filter(age <= 35) %>% | |
mutate(gaym = case_when(marhomo == 1 | marhomo == 2 ~ 1, | |
marhomo == 3 | marhomo == 4 | marhomo == 5 ~ 0)) %>% | |
group_by(year) %>% | |
mean_ci(gaym, wt = wtss) %>% | |
na.omit() %>% | |
mutate(type = "Should Have Right to Marry") | |
ppp2 <- gss %>% | |
filter(evangelical != 1) %>% | |
filter(age <= 35) %>% | |
mutate(mar = case_when(homosex == 4 ~ 1, | |
homosex == 3 | homosex == 2 | homosex == 1 ~ 0)) %>% | |
group_by(year) %>% | |
mean_ci(mar, wt = wtss) %>% | |
na.omit() %>% | |
mutate(type = "Same Sex Relations - Not Wrong at All") | |
gg <- bind_rows(ppp1, ppp2) | |
bottom <- gg %>% | |
filter(year >= 2004) %>% | |
ggplot(., aes(x = year, y = mean, fill = type)) + | |
geom_col(color = "black", position = "dodge") + | |
geom_errorbar(aes(ymin=lower, ymax=upper), width=.2, position=position_dodge(1.85)) + | |
geom_text(aes(y = .05, label = paste0(mean*100, '%')), position = position_dodge(width = 1.85), size = 4, family = "font") + | |
theme_gg("Abel", legend = TRUE) + | |
y_pct() + | |
scale_fill_manual(values = c("#1C88AC", "#31BD01")) + | |
scale_x_continuous(breaks = c(2004, 2008, 2012, 2016)) + | |
labs(x = "", y= "", title = "", caption = "@ryanburge\nData: GSS 2004-2018", subtitle = "Non-Evangelical Respondents Between 18 and 35") + | |
ggsave("E://gaym_young_all_dodge.png", type = "cairo-png", width = 9) | |
patch <- top / bottom | |
ggsave("E://patched_gaym.png", type = "cairo-png", height = 10, patch, width = 8.5) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment