Skip to content

Instantly share code, notes, and snippets.

@ryanburge ryanburge/gay_marriage_gay_sex.R Secret

Last active Jun 30, 2020
Embed
What would you like to do?
Gay Marriage Gay Sex
## 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
You can’t perform that action at this time.