Gay Marriage Gay Sex

gay_marriage_gay_sex.R

## 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)