Skip to content

Instantly share code, notes, and snippets.

@ryanburge

ryanburge/ct_selection_untitled-30012276.R Secret

Created December 31, 2024 22:14
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save ryanburge/d542813abf3ce2c2a85fb68f15cbc3d1 to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save ryanburge/d542813abf3ce2c2a85fb68f15cbc3d1 to your computer and use it in GitHub Desktop.
Download ZIP
Raw
ct_selection_untitled-30012276.R
gg <- gss %>%
filter(year <= 2018) %>%
mutate(age2 = frcode(age >= 18 & age <= 35 ~ "18-35",
age >= 36 & age <= 44 ~ "36-44",
age >= 45 & age <= 54 ~ "45-54",
age >= 55 & age <= 64 ~ "55-64",
age >= 65 ~ "65+")) %>%
mutate(xtn = case_when(relig == 1 | relig == 2 | relig == 10 | relig == 11 ~ 1,
TRUE ~ 0)) %>%
group_by(year, age2) %>%
mean_ci(xtn, wt = wtssall, ci = .84) %>%
na.omit() %>%
mutate(grp = "Christian")
gg1 <- gss %>%
filter(year <= 2018) %>%
mutate(age2 = frcode(age >= 18 & age <= 35 ~ "18-35",
age >= 36 & age <= 44 ~ "36-44",
age >= 45 & age <= 54 ~ "45-54",
age >= 55 & age <= 64 ~ "55-64",
age >= 65 ~ "65+")) %>%
mutate(nofaith = case_when(reltrad == 7 ~ 1,
TRUE ~ 0)) %>%
group_by(year, age2) %>%
mean_ci(nofaith, wt = wtssall, ci = .84) %>%
na.omit() %>%
mutate(grp = "None")
gg2 <- gss %>%
filter(year > 2018) %>%
mutate(age2 = frcode(age >= 18 & age <= 35 ~ "18-35",
age >= 36 & age <= 44 ~ "36-44",
age >= 45 & age <= 54 ~ "45-54",
age >= 55 & age <= 64 ~ "55-64",
age >= 65 ~ "65+")) %>%
mutate(xtn = case_when(relig == 1 | relig == 2 | relig == 10 | relig == 11 ~ 1,
TRUE ~ 0)) %>%
group_by(year, age2) %>%
mean_ci(xtn, wt = wtssnrps, ci = .84) %>%
na.omit() %>%
mutate(grp = "Christian")
gg3 <- gss %>%
filter(year > 2018) %>%
mutate(age2 = frcode(age >= 18 & age <= 35 ~ "18-35",
age >= 36 & age <= 44 ~ "36-44",
age >= 45 & age <= 54 ~ "45-54",
age >= 55 & age <= 64 ~ "55-64",
age >= 65 ~ "65+")) %>%
mutate(nofaith = case_when(reltrad == 7 ~ 1,
TRUE ~ 0)) %>%
group_by(year, age2) %>%
mean_ci(nofaith, wt = wtssnrps, ci = .84) %>%
na.omit() %>%
mutate(grp = "None")
graph <- bind_rows(gg, gg1, gg2, gg3) %>%
filter(age2 == "18-35")
graph %>%
ggplot(., aes(x = year, y = mean, color = grp, group = grp, linetype = grp)) +
annotate(geom = "rect", xmin = 1991, xmax = 1998, ymin = -Inf, ymax = Inf, fill = "grey", colour = "black", alpha = 0.5) +
geom_line() +
geom_point(stroke = 1, shape = 21, fill = "white") +
theme_rb() +
y_pct() +
scale_color_calc() +
add_text(x = 2002, y = .77, word = "Christian", sz = 7) +
add_text(x = 2002, y = .24, word = "Nones", sz = 7) +
add_text(x = 1994.5, y = .70, word = "Down 14%", sz = 6) +
add_text(x = 1994.5, y = .23, word = "Up 12%", sz =7) +
scale_x_continuous(breaks = c(1973, 1978, 1983, 1988, 1993, 1998, 2003, 2008, 2013, 2018)) +
labs(x = "", y = "", title = "The Religious Affiliation of 18-35 Year Olds", caption = "@ryanburge\nData: General Social Survey, 1972-2022")
save("young_folks_boxes_updated_gss22.png")
gg <- gss %>%
filter(year <= 2018) %>%
mutate(age2 = frcode(age >= 18 & age <= 35 ~ "18-35",
age >= 36 & age <= 44 ~ "36-44",
age >= 45 & age <= 54 ~ "45-54",
age >= 55 & age <= 64 ~ "55-64",
age >= 65 ~ "65+")) %>%
mutate(ml = case_when(reltrad == 2 ~ 1,
TRUE ~ 0)) %>%
group_by(year, age2) %>%
mean_ci(ml, wt = wtssall, ci = .84) %>%
na.omit()
gg1 <- gss %>%
filter(year > 2018) %>%
mutate(age2 = frcode(age >= 18 & age <= 35 ~ "18-35",
age >= 36 & age <= 44 ~ "36-44",
age >= 45 & age <= 54 ~ "45-54",
age >= 55 & age <= 64 ~ "55-64",
age >= 65 ~ "65+")) %>%
mutate(ml = case_when(reltrad == 2 ~ 1,
TRUE ~ 0)) %>%
group_by(year, age2) %>%
mean_ci(ml, wt = wtssnrps, ci = .84) %>%
na.omit()
graph <- bind_rows(gg, gg1) %>%
filter(age2 == "18-35")
graph %>%
ggplot(., aes(x = year, y = mean)) +
annotate(geom = "rect", xmin = 1991, xmax = 1998, ymin = -Inf, ymax = Inf, fill = "grey", colour = "black", alpha = 0.5) +
geom_line(color = "darkgreen") +
geom_point(stroke = 1, shape = 21, fill = "white", color = "darkgreen") +
theme_rb() +
geom_smooth(se = FALSE, color = "black", linewidth = .5, linetype = "twodash") +
scale_y_continuous(labels = percent, limits = c(0, .255)) +
scale_color_calc() +
# add_text(x = 2002, y = .77, word = "Christian", sz = 7) +
# add_text(x = 2002, y = .24, word = "Nones", sz = 7) +
add_text(x = 1994.5, y = .22, word = "Down 3%", sz = 7) +
# add_text(x = 1994.5, y = .23, word = "Up 12%", sz =7) +
scale_x_continuous(breaks = c(1973, 1978, 1983, 1988, 1993, 1998, 2003, 2008, 2013, 2018)) +
labs(x = "", y = "", title = "The Share of 18-35 Year Olds Who Are Mainline Protestant", caption = "@ryanburge\nData: General Social Survey, 1972-2022")
save("young_folks_mainline_gss22.png")
gg <- gss %>%
filter(year <= 2018) %>%
mutate(age2 = frcode(age >= 18 & age <= 35 ~ "18-35",
age >= 36 & age <= 44 ~ "36-44",
age >= 45 & age <= 54 ~ "45-54",
age >= 55 & age <= 64 ~ "55-64",
age >= 65 ~ "65+")) %>%
mutate(ml = case_when(reltrad == 1 ~ 1,
TRUE ~ 0)) %>%
group_by(year, age2) %>%
mean_ci(ml, wt = wtssall, ci = .84) %>%
na.omit()
gg1 <- gss %>%
filter(year > 2018) %>%
mutate(age2 = frcode(age >= 18 & age <= 35 ~ "18-35",
age >= 36 & age <= 44 ~ "36-44",
age >= 45 & age <= 54 ~ "45-54",
age >= 55 & age <= 64 ~ "55-64",
age >= 65 ~ "65+")) %>%
mutate(ml = case_when(reltrad == 1 ~ 1,
TRUE ~ 0)) %>%
group_by(year, age2) %>%
mean_ci(ml, wt = wtssnrps, ci = .84) %>%
na.omit()
graph <- bind_rows(gg, gg1) %>%
filter(age2 == "18-35")
graph %>%
ggplot(., aes(x = year, y = mean)) +
annotate(geom = "rect", xmin = 1991, xmax = 1998, ymin = -Inf, ymax = Inf, fill = "grey", colour = "black", alpha = 0.5) +
geom_line(color = "orchid") +
geom_point(stroke = 1, shape = 21, fill = "white", color = "orchid") +
theme_rb() +
geom_smooth(se = FALSE, color = "black", linewidth = .5, linetype = "twodash") +
scale_y_continuous(labels = percent, limits = c(0, .285)) +
scale_color_calc() +
# add_text(x = 2002, y = .77, word = "Christian", sz = 7) +
# add_text(x = 2002, y = .24, word = "Nones", sz = 7) +
add_text(x = 1994.5, y = .14, word = "Down 3%", sz = 7) +
# add_text(x = 1994.5, y = .23, word = "Up 12%", sz =7) +
scale_x_continuous(breaks = c(1973, 1978, 1983, 1988, 1993, 1998, 2003, 2008, 2013, 2018)) +
labs(x = "", y = "", title = "The Share of 18-35 Year Olds Who Are Evangelical Protestant", caption = "@ryanburge\nData: General Social Survey, 1972-2022")
save("young_folks_evangelical_gss22.png")
gg <- gss %>%
filter(year <= 2018) %>%
mutate(age2 = frcode(age >= 18 & age <= 35 ~ "18-35",
age >= 36 & age <= 44 ~ "36-44",
age >= 45 & age <= 54 ~ "45-54",
age >= 55 & age <= 64 ~ "55-64",
age >= 65 ~ "65+")) %>%
mutate(ml = case_when(reltrad == 3 ~ 1,
TRUE ~ 0)) %>%
group_by(year, age2) %>%
mean_ci(ml, wt = wtssall, ci = .84) %>%
na.omit() %>%
filter(year != 1982) %>%
filter(year != 1987)
gg1 <- gss %>%
filter(year > 2018) %>%
mutate(age2 = frcode(age >= 18 & age <= 35 ~ "18-35",
age >= 36 & age <= 44 ~ "36-44",
age >= 45 & age <= 54 ~ "45-54",
age >= 55 & age <= 64 ~ "55-64",
age >= 65 ~ "65+")) %>%
mutate(ml = case_when(reltrad == 3 ~ 1,
TRUE ~ 0)) %>%
group_by(year, age2) %>%
mean_ci(ml, wt = wtssnrps, ci = .84) %>%
na.omit()
gg2 <- gss %>%
filter(year == 1982 | year == 1987) %>%
mutate(age2 = frcode(age >= 18 & age <= 35 ~ "18-35",
age >= 36 & age <= 44 ~ "36-44",
age >= 45 & age <= 54 ~ "45-54",
age >= 55 & age <= 64 ~ "55-64",
age >= 65 ~ "65+")) %>%
mutate(ml = case_when(reltrad == 3 ~ 1,
TRUE ~ 0)) %>%
group_by(year, age2) %>%
mean_ci(ml, wt = oversamp, ci = .84) %>%
na.omit()
graph <- bind_rows(gg, gg1, gg2) %>%
filter(age2 == "18-35")
graph %>%
ggplot(., aes(x = year, y = mean)) +
annotate(geom = "rect", xmin = 1991, xmax = 1998, ymin = -Inf, ymax = Inf, fill = "grey", colour = "black", alpha = 0.5) +
geom_line(color = "firebrick1") +
geom_point(stroke = 1, shape = 21, fill = "white", color = "firebrick1") +
theme_rb() +
geom_smooth(se = FALSE, color = "black", linewidth = .5, linetype = "twodash") +
scale_y_continuous(labels = percent, limits = c(0, .285)) +
scale_color_calc() +
# add_text(x = 2002, y = .77, word = "Christian", sz = 7) +
# add_text(x = 2002, y = .24, word = "Nones", sz = 7) +
add_text(x = 1994.5, y = .14, word = "Down 3%", sz = 7) +
# add_text(x = 1994.5, y = .23, word = "Up 12%", sz =7) +
scale_x_continuous(breaks = c(1973, 1978, 1983, 1988, 1993, 1998, 2003, 2008, 2013, 2018)) +
labs(x = "", y = "", title = "The Share of 18-35 Year Olds Who Are Black Protestant", caption = "@ryanburge\nData: General Social Survey, 1972-2022")
save("young_folks_bprots_gss22.png")
gg <- gss %>%
filter(year <= 2018) %>%
mutate(age2 = frcode(age >= 18 & age <= 35 ~ "18-35",
age >= 36 & age <= 44 ~ "36-44",
age >= 45 & age <= 54 ~ "45-54",
age >= 55 & age <= 64 ~ "55-64",
age >= 65 ~ "65+")) %>%
mutate(ml = case_when(reltrad == 4 ~ 1,
TRUE ~ 0)) %>%
group_by(year, age2) %>%
mean_ci(ml, wt = wtssall, ci = .84) %>%
na.omit()
gg1 <- gss %>%
filter(year > 2018) %>%
mutate(age2 = frcode(age >= 18 & age <= 35 ~ "18-35",
age >= 36 & age <= 44 ~ "36-44",
age >= 45 & age <= 54 ~ "45-54",
age >= 55 & age <= 64 ~ "55-64",
age >= 65 ~ "65+")) %>%
mutate(ml = case_when(reltrad == 4 ~ 1,
TRUE ~ 0)) %>%
group_by(year, age2) %>%
mean_ci(ml, wt = wtssnrps, ci = .84) %>%
na.omit()
graph <- bind_rows(gg, gg1) %>%
filter(age2 == "18-35")
graph %>%
ggplot(., aes(x = year, y = mean)) +
annotate(geom = "rect", xmin = 1991, xmax = 1998, ymin = -Inf, ymax = Inf, fill = "grey", colour = "black", alpha = 0.5) +
geom_line(color = "dodgerblue3") +
geom_point(stroke = 1, shape = 21, fill = "white", color = "dodgerblue3") +
theme_rb() +
geom_smooth(se = FALSE, color = "black", linewidth = .5, linetype = "twodash") +
scale_y_continuous(labels = percent, limits = c(0, .32)) +
scale_color_calc() +
# add_text(x = 2002, y = .77, word = "Christian", sz = 7) +
# add_text(x = 2002, y = .24, word = "Nones", sz = 7) +
add_text(x = 1994.5, y = .18, word = "Down 2%", sz = 7) +
# add_text(x = 1994.5, y = .23, word = "Up 12%", sz =7) +
scale_x_continuous(breaks = c(1973, 1978, 1983, 1988, 1993, 1998, 2003, 2008, 2013, 2018)) +
labs(x = "", y = "", title = "The Share of 18-35 Year Olds Who Are Catholic", caption = "@ryanburge\nData: General Social Survey, 1972-2022")
save("young_folks_catholic_gss22.png")
gss_reltrad6 <- function(df, var){
var <- enquo(var)
df %>%
# ungroup(!! var) %>%
mutate(reltrad = frcode(!! var == 1 ~ "Evangelical",
!! var == 2 ~ "Mainline",
!! var == 3 ~ "Black\nProt.",
!! var == 4 ~ "Catholic",
!! var == 5 | !! var == 6 ~ "Other\nFaith",
!! var == 7 ~ "No\nReligion"))
}
## New Bar Labels ####
lab_bar2 <- function(type, pos = 0, sz = 8, above = TRUE) {
# Capture the type column using tidy evaluation
type <- enquo(type)
geom_text(
aes(
y = if (above) !!type + pos else pos,
label = paste0(round(!!type, 2) * 100, '%') # Automatically rounds to 2 decimals
),
position = position_dodge(width = 0.9),
size = sz,
family = "font" # Hard-coded font family
)
}
one <- gss %>%
filter(year == 1991) %>%
filter(age >= 18 & age <= 35) %>%
gss_reltrad6(reltrad) %>%
ct(reltrad, wt = wtssall, show_na = FALSE) %>%
mutate(year = "1991")
two <- gss %>%
filter(year == 1998) %>%
filter(age >= 18 & age <= 35) %>%
gss_reltrad6(reltrad) %>%
ct(reltrad, wt = wtssall, show_na = FALSE) %>%
mutate(year = "1998")
both <- bind_rows(one, two)
both %>%
ggplot(., aes(x = reltrad, y = pct, fill = year)) +
geom_col(color = "black", position = "dodge") +
theme_rb(legend = TRUE) +
y_pct() +
scale_fill_calc() +
theme(legend.text = element_text(size = 16)) +
lab_bar2(type = pct, above = TRUE, pos = .0125, sz = 6.5) +
labs(x = "", y = "", title = "The Religious Composition of 18-35 Year Olds, 1991 vs. 1998",
caption = "@ryanburge\nData: General Social Survey, 1991-1998")
save("gss_compared_18to35.png", wd = 7)
gg1 <- gss %>%
filter(age <= 35) %>%
filter(year <= 2018) %>%
mutate(att = attend) %>%
mutate(att = frcode(att == 0 ~ "Never",
att == 1 ~ "Seldom",
att == 2 | att == 3 ~ "Yearly",
att == 4 | att == 5 ~ "Monthly",
att == 6 | att == 7 | att == 8 ~ "Weekly")) %>%
group_by(year) %>%
ct(att, wt = wtssall, show_na = FALSE)
gg2 <- gss %>%
filter(age <= 35) %>%
filter(year > 2018) %>%
mutate(att = attend) %>%
mutate(att = frcode(att == 0 ~ "Never",
att == 1 ~ "Seldom",
att == 2 | att == 3 ~ "Yearly",
att == 4 | att == 5 ~ "Monthly",
att == 6 | att == 7 | att == 8 ~ "Weekly")) %>%
group_by(year) %>%
ct(att, wt = wtssnrps, show_na = FALSE)
both <- bind_rows(gg1, gg2)
both %>%
ggplot(., aes(x = year, y = pct, color = att, group = att)) +
annotate(geom = "rect", xmin = 1991, xmax = 1998, ymin = -Inf, ymax = Inf, fill = "grey", colour = "black", alpha = 0.5) +
geom_point(stroke = .25, shape = 21, fill = "white") +
theme_rb() +
geom_smooth(se = FALSE, linewidth = 1) +
scale_y_continuous(labels = percent, limits = c(0, .42)) +
scale_color_gdocs() +
add_text(x = 2016, y = .37, word = "Never", sz = 7) +
add_text(x = 2016, y = .28, word = "Yearly", sz = 7) +
add_text(x = 2016, y = .22, word = "Weekly", sz = 7) +
add_text(x = 2011, y = .09, word = "Seldom", sz = 7) +
add_text(x = 2019, y = .15, word = "Monthly", sz = 7) +
scale_x_continuous(breaks = c(1973, 1978, 1983, 1988, 1993, 1998, 2003, 2008, 2013, 2018)) +
labs(x = "", y = "", title = "The Religious Attendance of 18-35 Year Olds", caption = "@ryanburge\nData: General Social Survey, 1972-2022")
save("young_folks_relattend_gss22.png")
gg1 <- gss %>%
filter(age <= 35) %>%
filter(year == 1991) %>%
mutate(att = attend) %>%
mutate(att = frcode(att == 0 ~ "Never",
att == 1 ~ "Seldom",
att == 2 | att == 3 ~ "Yearly",
att == 4 | att == 5 ~ "Monthly",
att == 6 | att == 7 | att == 8 ~ "Weekly")) %>%
ct(att, wt = wtssall, show_na = FALSE) %>%
mutate(year = "1991")
gg2 <- gss %>%
filter(age <= 35) %>%
filter(year == 1998) %>%
mutate(att = attend) %>%
mutate(att = frcode(att == 0 ~ "Never",
att == 1 ~ "Seldom",
att == 2 | att == 3 ~ "Yearly",
att == 4 | att == 5 ~ "Monthly",
att == 6 | att == 7 | att == 8 ~ "Weekly")) %>%
group_by(year) %>%
ct(att, wt = wtssall, show_na = FALSE) %>%
mutate(year = "1998")
both <- bind_rows(gg1, gg2)
both %>%
ggplot(., aes(x = att, y = pct, fill = year)) +
geom_col(color = "black", position = "dodge") +
theme_rb(legend = TRUE) +
y_pct() +
scale_fill_calc() +
theme(legend.text = element_text(size = 16)) +
lab_bar2(type = pct, above = TRUE, pos = .0125, sz = 6.5) +
labs(x = "", y = "", title = "The Religious Attendance of 18-35 Year Olds, 1991 vs. 1998",
caption = "@ryanburge\nData: General Social Survey, 1991-1998")
save("gss_compared_18to35_att.png", wd = 7)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment