Skip to content

Instantly share code, notes, and snippets.

@ryanburge
Created December 7, 2024 15:31
Show Gist options
  • Select an option

  • Save ryanburge/93eb85334f2b9875e63469effbbeaa1b to your computer and use it in GitHub Desktop.

Select an option

Save ryanburge/93eb85334f2b9875e63469effbbeaa1b to your computer and use it in GitHub Desktop.
gg1 <- gss %>%
filter(year <= 2018) %>%
mutate(xmar = xmarsex) %>%
mutate(xmar = frcode(xmar == 4 ~ "Not Wrong",
xmar == 3 ~ "Sometimes",
xmar == 2 ~ "Almost Always",
xmar == 1 ~ "Always")) %>%
group_by(year) %>%
ct(xmar, wt = wtssall, show_na = FALSE)
gg2 <- gss %>%
filter(year > 2018) %>%
mutate(xmar = xmarsex) %>%
mutate(xmar = frcode(xmar == 4 ~ "Not Wrong",
xmar == 3 ~ "Sometimes",
xmar == 2 ~ "Almost Always",
xmar == 1 ~ "Always")) %>%
group_by(year) %>%
ct(xmar, wt = wtssnrps, show_na = FALSE)
both <- bind_rows(gg1, gg2)
both %>%
ggplot(., aes(x = year, y = pct, color = xmar, group = xmar)) +
geom_point(stroke = .75, shape = 21) +
geom_labelsmooth(aes(label = xmar), method = "loess", formula = y ~ x, family = "font", linewidth = 1, text_smoothing = 30, size = 6, linewidth = 1, boxlinewidth = 0.3, hjust = .75) +
y_pct() +
scale_color_wsj() +
theme_rb() +
theme(plot.title = element_text(size = 14)) +
labs(x = "", y = "", title = "What is your opinion about a married person having sexual relations with someone other than the marriage partner\nis it always wrong, almost always wrong, wrong only sometimes, or not wrong at all?",
caption = "@ryanburge + @religiondata\nData: General Social Survey, 1973-2024")
save("xmar_gss22.png")
gg1 <- gss %>%
filter(year <= 2018) %>%
mutate(xmar = xmarsex) %>%
mutate(xmar = frcode(xmar == 4 ~ "Not Wrong",
xmar == 3 ~ "Sometimes\nWrong",
xmar == 2 ~ "Almost Always\nWrong",
xmar == 1 ~ "Always\nWrong")) %>%
group_by(year) %>%
ct(xmar, wt = wtssall, show_na = FALSE)
gg2 <- gss %>%
filter(year > 2018) %>%
mutate(xmar = xmarsex) %>%
mutate(xmar = frcode(xmar == 4 ~ "Not Wrong",
xmar == 3 ~ "Sometimes\nWrong",
xmar == 2 ~ "Almost Always\nWrong",
xmar == 1 ~ "Always\nWrong")) %>%
group_by(year) %>%
ct(xmar, wt = wtssnrps, show_na = FALSE)
both <- bind_rows(gg1, gg2)
gg <- both %>%
filter(year == 2010 | year == 2022)
gg %>%
mutate(lab = round(pct, 2)) %>%
ggplot(., aes(x = factor(year), y = pct, fill = xmar)) +
geom_col(color = "black") +
facet_wrap(~ xmar, nrow = 1) +
theme_rb() +
scale_fill_wsj() +
y_pct() +
geom_text(aes(y = pct + .03, label = paste0(lab*100, '%')), position = position_dodge(width = .9), size = 7, family = "font") +
labs(x = "", y = "", title = "Views of Sex With Someone Other Than Marriage Partner",
caption = "@ryanburge + @religiondata\nData: General Social Survey, 1973-2022")
save("xmar_recent_bars.png", wd = 6)
gg <- gss %>%
gss_reltrad6(reltrad) %>%
filter(year > 2018) %>%
mutate(xmar = xmarsex) %>%
mutate(xmar = frcode(xmar == 4 ~ "Not Wrong",
xmar == 3 ~ "Sometimes Wrong",
xmar == 2 ~ "Almost Always Wrong",
xmar == 1 ~ "Always Wrong")) %>%
group_by(reltrad) %>%
ct(xmar, wt = wtssnrps, show_na = FALSE)
gg %>%
filter(reltrad != "NA") %>%
mutate(lab = round(pct, 2)) %>%
ggplot(., aes(x = 1, y = pct, fill = fct_rev(xmar))) +
geom_col(color = "black") +
coord_flip() +
facet_wrap(~ reltrad, ncol =1, strip.position = "left") +
theme_rb() +
scale_fill_wsj() +
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(lab*100, '%'), '')), position = position_stack(vjust = 0.5), size = 8, family = "font", color = "black") +
geom_text(aes(label = ifelse(xmar == "Almost Always Wrong", paste0(lab*100, '%'), '')), position = position_stack(vjust = 0.5), size = 8, family = "font", color = "white") +
geom_text(aes(label = ifelse(xmar == "Always Wrong", paste0(lab*100, '%'), '')), position = position_stack(vjust = 0.5), size = 8, family = "font", color = "white") +
theme(plot.title = element_text(size = 16)) +
theme(strip.text.y.left = element_text(angle = 0, hjust = 1)) +
theme(plot.title = element_text(size = 13)) +
labs(x = "", y = "", title = "What is your opinion about a married person having sexual relations with someone other than the marriage partner",
caption = "@ryanburge + @religiondata\nData: General Social Survey, 2021-2022")
save("xmar_reltrad22.png", wd = 9, ht = 4.5)
gg1 <- gss %>%
filter(year == 2010) %>%
gss_reltrad6(reltrad) %>%
mutate(xmar = xmarsex) %>%
mutate(xmar = case_when(xmar == 1 ~ 1,
xmar == 2 | xmar == 3 | xmar == 4 ~ 0)) %>%
group_by(year, reltrad) %>%
mean_ci(xmar, wt = wtssall, ci = .84) %>%
na.omit()
gg2 <- gss %>%
filter(year == 2022) %>%
gss_reltrad6(reltrad) %>%
mutate(xmar = xmarsex) %>%
mutate(xmar = case_when(xmar == 1 ~ 1,
xmar == 2 | xmar == 3 | xmar == 4 ~ 0)) %>%
group_by(year, reltrad) %>%
mean_ci(xmar, wt = wtssnrps, ci = .84) %>%
na.omit()
both <- bind_rows(gg1, gg2) %>% filter(reltrad != "NA")
both %>%
mutate(lab = round(mean, 2)) %>%
ggplot(., aes(x = factor(year), y = mean, fill = reltrad)) +
geom_col(color = "black") +
facet_wrap(~ reltrad, nrow = 2) +
theme_rb() +
error_bar() +
scale_fill_brewer(palette = "Set1") +
y_pct() +
geom_text(aes(y = .09, label = paste0(lab*100, '%')), position = position_dodge(width = .9), size = 9, family = "font") +
labs(x = "", y = "", title = "Share Saying Sex With Someone Other Than Marriage\nPartner is Always Wrong",
caption = "@ryanburge + @religiondata\nData: General Social Survey, 2010-2022")
save("xmar_recent_bars_reltrad.png", wd = 6)
gg1 <- gss %>%
filter(year <= 2018) %>%
mutate(birthyr = year - age) %>%
mutate(cohorts = frcode(birthyr >= 1940 & birthyr <= 1944 ~ "1940-1944",
birthyr >= 1945 & birthyr <= 1949 ~ "1945-1949",
birthyr >= 1950 & birthyr <= 1954 ~ "1950-1954",
birthyr >= 1955 & birthyr <= 1959 ~ "1955-1959",
birthyr >= 1960 & birthyr <= 1964 ~ "1960-1964",
birthyr >= 1965 & birthyr <= 1969 ~ "1965-1969",
birthyr >= 1970 & birthyr <= 1974 ~ "1970-1974",
birthyr >= 1975 & birthyr <= 1979 ~ "1975-1979",
birthyr >= 1980 & birthyr <= 1984 ~ "1980-1984",
birthyr >= 1985 & birthyr <= 1989 ~ "1985-1989",
birthyr >= 1990 & birthyr <= 1994 ~ "1990-1994",
birthyr >= 1995 & birthyr <= 2000 ~ "1995-2000")) %>%
mutate(xmar = xmarsex) %>%
mutate(xmar = case_when(xmar == 1 ~ 1,
xmar == 2 | xmar == 3 | xmar == 4 ~ 0)) %>%
group_by(cohorts, year) %>%
mean_ci(xmar, wt = wtssall)
gg2 <- gss %>%
filter(year > 2018) %>%
mutate(birthyr = year - age) %>%
mutate(cohorts = frcode(birthyr >= 1940 & birthyr <= 1944 ~ "1940-1944",
birthyr >= 1945 & birthyr <= 1949 ~ "1945-1949",
birthyr >= 1950 & birthyr <= 1954 ~ "1950-1954",
birthyr >= 1955 & birthyr <= 1959 ~ "1955-1959",
birthyr >= 1960 & birthyr <= 1964 ~ "1960-1964",
birthyr >= 1965 & birthyr <= 1969 ~ "1965-1969",
birthyr >= 1970 & birthyr <= 1974 ~ "1970-1974",
birthyr >= 1975 & birthyr <= 1979 ~ "1975-1979",
birthyr >= 1980 & birthyr <= 1984 ~ "1980-1984",
birthyr >= 1985 & birthyr <= 1989 ~ "1985-1989",
birthyr >= 1990 & birthyr <= 1994 ~ "1990-1994",
birthyr >= 1995 & birthyr <= 2000 ~ "1995-2000")) %>%
mutate(xmar = xmarsex) %>%
mutate(xmar = case_when(xmar == 1 ~ 1,
xmar == 2 | xmar == 3 | xmar == 4 ~ 0)) %>%
group_by(cohorts, year) %>%
mean_ci(xmar, wt = wtssnrps)
both <- bind_rows(gg1, gg2)
both %>%
filter(cohorts != "NA") %>%
ggplot(., aes(x = year, y =mean, color = cohorts, group = cohorts)) +
geom_point(stroke = .5, shape = 21, alpha = 1) +
geom_smooth(se = FALSE, method = "lm") +
facet_wrap(~ cohorts) +
scale_color_manual(values = met.brewer("Redon", 12)) +
theme_rb() +
y_pct() +
labs(x = "", y = "", title = "Share Saying Sex With Someone Other Than Marriage Partner is Always Wrong", caption = "@ryanburge + @religiondata\nData: General Social Survey, 1973-2022")
save("infidelity_law_birth_cohort.png", ht = 9)
gg1 <- gss %>%
filter(year == 2010) %>%
mutate(age2 = frcode(age <= 39 ~ "18-39",
age >= 40 ~ "40+")) %>%
gss_reltrad6(reltrad) %>%
mutate(xmar = xmarsex) %>%
mutate(xmar = case_when(xmar == 1 ~ 1,
xmar == 2 | xmar == 3 | xmar == 4 ~ 0)) %>%
group_by(year, reltrad, age2) %>%
mean_ci(xmar, wt = wtssall, ci = .84) %>%
na.omit()
gg2 <- gss %>%
filter(year == 2022) %>%
mutate(age2 = frcode(age <= 39 ~ "18-39",
age >= 40 ~ "40+")) %>%
gss_reltrad6(reltrad) %>%
mutate(xmar = xmarsex) %>%
mutate(xmar = case_when(xmar == 1 ~ 1,
xmar == 2 | xmar == 3 | xmar == 4 ~ 0)) %>%
group_by(year, reltrad, age2) %>%
mean_ci(xmar, wt = wtssnrps, ci = .84) %>%
na.omit()
both <- bind_rows(gg1, gg2) %>% filter(reltrad != "NA")
both %>%
mutate(lab = round(mean, 2)) %>%
ggplot(., aes(x = age2, y = mean, fill = factor(year))) +
geom_col(color = "black", position = "dodge") +
facet_wrap(~ reltrad, nrow = 2) +
theme_rb(legend = TRUE) +
error_bar() +
scale_fill_calc() +
y_pct() +
geom_text(aes(y = .09, label = ifelse(year == 2010, paste0(lab*100, '%'), "")), position = position_dodge(width = .9), size = 5, family = "font", color = "white") +
geom_text(aes(y = .09, label = ifelse(year == 2022, paste0(lab*100, '%'), "")), position = position_dodge(width = .9), size = 5, family = "font", color = "black") +
labs(x = "Age Group", y = "", title = "Share Saying Sex With Someone Other Than Marriage\nPartner is Always Wrong",
caption = "@ryanburge + @religiondata\nData: General Social Survey, 2010-2022")
save("xmar_recent_bars_reltrad_age2.png", wd = 6)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment