-
-
Save ryanburge/7c77037f698898e97b1849c3378fb220 to your computer and use it in GitHub Desktop.
This file contains hidden or 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
| library(rio) | |
| library(janitor) | |
| pew <- import("E://data/atp130.dta") %>% clean_names() | |
| gg1 <- pew %>% | |
| mutate(rel = f_relig) %>% | |
| mutate(rel = frcode(rel == 1 & f_born == 1 ~ "Evangelical Prot.", | |
| rel == 1 & f_born == 2 ~ "Non-Evangelical", | |
| rel == 2 ~ "Catholic", | |
| rel == 3 ~ "LDS", | |
| rel == 5 ~ "Jewish", | |
| rel == 9 ~ "Atheist", | |
| rel == 10 ~ "Agnostic", | |
| rel == 12 ~ "Nothing in Particular")) %>% | |
| mutate(accept = tattoo_accept_w130) %>% | |
| mutate(accept = case_when(accept == 1 ~ 1, | |
| accept == 2 ~ 0)) %>% | |
| group_by(rel) %>% | |
| mean_ci(accept, wt = weight_w130, ci = .84) | |
| gg2 <- pew %>% | |
| mutate(accept = tattoo_accept_w130) %>% | |
| mutate(accept = case_when(accept == 1 ~ 1, | |
| accept == 2 ~ 0)) %>% | |
| mean_ci(accept, wt = weight_w130, ci = .84) %>% | |
| mutate(rel = "Entire Sample") | |
| both <- bind_rows(gg1, gg2) %>% filter(rel != "NA") | |
| fill_colors <- c( | |
| "Entire Sample" = "#9E9E9E", # Neutral gray | |
| "Evangelical Prot." = "#E41A1C", # Red | |
| "Non-Evangelical" = "#377EB8", # Blue | |
| "Catholic" = "#4DAF4A", # Green | |
| "LDS" = "#FF7F00", # Orange | |
| "Jewish" = "#984EA3", # Purple | |
| "Atheist" = "#FFFF33", # Yellow | |
| "Agnostic" = "#A65628", # Brown | |
| "Nothing in Particular" = "#F781BF" # Pink | |
| ) | |
| # assuming `both` has: rel, mean, lower, upper (from mean_ci) | |
| plot_df <- both %>% | |
| mutate(rel = fct_reorder(rel, mean)) %>% filter(rel != 'NA') | |
| gg <- ggplot(plot_df, aes(x = rel, y = mean, fill = rel)) + | |
| geom_col(color = "black") + | |
| geom_errorbar(aes(ymin = lower, ymax = upper), width = 0.15, linewidth = 0.6) + | |
| lab_bar(above = FALSE, pos = .065, sz = 9, type = mean) + | |
| coord_flip(clip = "off") + | |
| scale_fill_manual(values = fill_colors) + | |
| scale_y_continuous(labels = scales::percent, limits = c(0, 1.05 * max(plot_df$upper, na.rm = TRUE))) + | |
| labs( | |
| x = NULL, y = "Share Saying More Accepting", | |
| title = "Over the past 20 or so years, do you think society has become more accepting\nor less accepting of people with tattoos, or has it stayed about the same? ", | |
| caption = "@ryanburge + @religiondata | Data: Pew American Trends Panel Wave 130" | |
| ) + | |
| theme_rb() + | |
| theme( | |
| plot.margin = margin(10, 30, 10, 10), | |
| axis.text.y = element_text(size = 10) | |
| ) | |
| save("tattoo_acceptance_overall.png", ht = 5.5) | |
| gg1 <- pew %>% | |
| mutate(rel = f_relig) %>% | |
| mutate(rel = frcode(rel == 1 & f_born == 1 ~ "Evangelical Prot.", | |
| rel == 1 & f_born == 2 ~ "Non-Evangelical", | |
| rel == 2 ~ "Catholic", | |
| rel == 3 ~ "LDS", | |
| rel == 5 ~ "Jewish", | |
| rel == 9 ~ "Atheist", | |
| rel == 10 ~ "Agnostic", | |
| rel == 12 ~ "Nothing in Particular")) %>% | |
| mutate(tat = frcode(tattoo_have_w130 == 1 ~ "One", | |
| tattoo_have_w130 == 2 ~ "Two or More", | |
| tattoo_have_w130 == 3 ~ "None")) %>% | |
| group_by(rel) %>% | |
| ct(tat, wt = weight_w130, show_na = FALSE) | |
| gg2 <- pew %>% | |
| mutate(tat = frcode(tattoo_have_w130 == 1 ~ "One", | |
| tattoo_have_w130 == 2 ~ "Two or More", | |
| tattoo_have_w130 == 3 ~ "None")) %>% | |
| ct(tat, wt = weight_w130, show_na = FALSE) %>% | |
| mutate(rel = "Entire Sample") | |
| both <- bind_rows(gg1, gg2) %>% filter(rel != "NA") | |
| lvl <- both %>% | |
| filter(tat == "None") %>% | |
| select(rel, sort = pct) | |
| both <- left_join(both, lvl) | |
| both$rel <- fct_reorder(both$rel, both$sort, .desc = TRUE) | |
| tat_colors <- c( | |
| "None" = "#BFC5CC", # neutral gray | |
| "One" = "#377EB8", # bright blue | |
| "Two or More" = "#E41A1C" # bright red | |
| ) | |
| both %>% | |
| mutate(lab = round(pct, 2)) %>% | |
| ggplot(., aes(x = 1, y = pct, fill = fct_rev(tat))) + | |
| geom_col(color = "black") + | |
| coord_flip() + | |
| scale_fill_manual(values = tat_colors, name = "Tattoos") + | |
| facet_wrap(~ rel, ncol =1, strip.position = "left") + | |
| theme_rb() + | |
| 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(age2 == "18-35", paste0(lab*100, '%'), '')), position = position_stack(vjust = 0.5), size = 4, family = "font", color = "white") + | |
| # geom_text(aes(label = ifelse(age2 == "36-44", paste0(lab*100, '%'), '')), position = position_stack(vjust = 0.5), size = 4, family = "font", color = "white") + | |
| theme(plot.title = element_text(size = 16)) + | |
| theme(legend.text = element_text(size = 20)) + | |
| theme(strip.text.y.left = element_text(angle = 0, hjust = 1)) + | |
| labs(x = "", y = "", title = "Do you currently have any tattoos?", caption = "@ryanburge + @religiondata | Data: Pew American Trends Panel Wave 130") | |
| save("number_of_tats.png", wd = 9, ht = 6) | |
| gg1 <- pew %>% | |
| mutate(age = frcode(f_agecat == 1 ~ "18-29", | |
| f_agecat == 2 ~ "30-49", | |
| f_agecat == 3 ~ "50-64", | |
| f_agecat == 4 ~ "65+")) %>% | |
| mutate(rel = f_relig) %>% | |
| mutate(rel = frcode(rel == 1 & f_born == 1 ~ "Evangelical Prot.", | |
| rel == 1 & f_born == 2 ~ "Non-Evangelical", | |
| rel == 2 ~ "Catholic", | |
| rel == 9 | rel == 10 ~ "Atheist/Agnostic", | |
| rel == 12 ~ "Nothing in Particular")) %>% | |
| mutate(tat = frcode(tattoo_have_w130 == 1 ~ "One", | |
| tattoo_have_w130 == 2 ~ "Two or More", | |
| tattoo_have_w130 == 3 ~ "None")) %>% | |
| group_by(rel, age) %>% | |
| ct(tat, wt = weight_w130, show_na = FALSE) %>% filter(rel != "NA") %>% filter(age != "NA") | |
| tat_colors <- c( | |
| "None" = "#BFC5CC", # neutral gray | |
| "One" = "#377EB8", # bright blue | |
| "Two or More" = "#E41A1C" # bright red | |
| ) | |
| gg1 %>% | |
| mutate(lab = round(pct, 2)) %>% | |
| ggplot(., aes(x = fct_rev(age), y = pct, fill = fct_rev(tat))) + | |
| geom_col(color = "black") + | |
| coord_flip() + | |
| scale_fill_manual(values = tat_colors, name = "Tattoos") + | |
| facet_wrap(~ rel, ncol =1, strip.position = "top") + | |
| theme_rb() + | |
| 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 = 6, family = "font", color = "black") + | |
| # geom_text(aes(label = ifelse(age2 == "18-35", paste0(lab*100, '%'), '')), position = position_stack(vjust = 0.5), size = 4, family = "font", color = "white") + | |
| # geom_text(aes(label = ifelse(age2 == "36-44", paste0(lab*100, '%'), '')), position = position_stack(vjust = 0.5), size = 4, family = "font", color = "white") + | |
| theme(plot.title = element_text(size = 16)) + | |
| theme(legend.text = element_text(size = 20)) + | |
| theme(strip.text.y.left = element_text(angle = 0, hjust = 1)) + | |
| labs(x = "", y = "", title = "Do you currently have any tattoos?", caption = "@ryanburge + @religiondata | Data: Pew American Trends Panel Wave 130") | |
| save("number_of_tats_by_age.png", wd = 9, ht = 10) | |
| gg1 <- pew %>% | |
| mutate(why = tattoo_why_a_w130) %>% | |
| mutate(why = frcode(why == 1 ~ "Major Reason", | |
| why == 2 ~ "Minor Reason", | |
| why == 3 ~ "Not a Reason")) %>% | |
| ct(why, wt = weight_w130, show_na = FALSE) | |
| gg2 <- pew %>% | |
| mutate(why = tattoo_why_a_w130) %>% | |
| mutate(why = frcode(why == 1 ~ "Major Reason", | |
| why == 2 ~ "Minor Reason", | |
| why == 3 ~ "Not a Reason")) %>% | |
| mutate(rel = f_relig) %>% | |
| mutate(rel = frcode(rel == 1 & f_born == 1 ~ "Evangelical Prot.", | |
| rel == 1 & f_born == 2 ~ "Non-Evangelical", | |
| rel == 2 ~ "Catholic", | |
| rel == 9 | rel == 10 ~ "Atheist/Agnostic", | |
| rel == 12 ~ "Nothing in Particular")) %>% | |
| group_by(rel) %>% | |
| ct(why, wt = weight_w130, show_na = FALSE) | |
| one <- bind_rows(gg1, gg2) %>% mutate(reason = "Honor Someone or Something") | |
| gg1 <- pew %>% | |
| mutate(why = tattoo_why_b_w130) %>% | |
| mutate(why = frcode(why == 1 ~ "Major Reason", | |
| why == 2 ~ "Minor Reason", | |
| why == 3 ~ "Not a Reason")) %>% | |
| ct(why, wt = weight_w130, show_na = FALSE) | |
| gg2 <- pew %>% | |
| mutate(why = tattoo_why_b_w130) %>% | |
| mutate(why = frcode(why == 1 ~ "Major Reason", | |
| why == 2 ~ "Minor Reason", | |
| why == 3 ~ "Not a Reason")) %>% | |
| mutate(rel = f_relig) %>% | |
| mutate(rel = frcode(rel == 1 & f_born == 1 ~ "Evangelical Prot.", | |
| rel == 1 & f_born == 2 ~ "Non-Evangelical", | |
| rel == 2 ~ "Catholic", | |
| rel == 9 | rel == 10 ~ "Atheist/Agnostic", | |
| rel == 12 ~ "Nothing in Particular")) %>% | |
| group_by(rel) %>% | |
| ct(why, wt = weight_w130, show_na = FALSE) | |
| two <- bind_rows(gg1, gg2) %>% mutate(reason = "To make a statement about what I believe") | |
| gg1 <- pew %>% | |
| mutate(why = tattoo_why_c_w130) %>% | |
| mutate(why = frcode(why == 1 ~ "Major Reason", | |
| why == 2 ~ "Minor Reason", | |
| why == 3 ~ "Not a Reason")) %>% | |
| ct(why, wt = weight_w130, show_na = FALSE) | |
| gg2 <- pew %>% | |
| mutate(why = tattoo_why_c_w130) %>% | |
| mutate(why = frcode(why == 1 ~ "Major Reason", | |
| why == 2 ~ "Minor Reason", | |
| why == 3 ~ "Not a Reason")) %>% | |
| mutate(rel = f_relig) %>% | |
| mutate(rel = frcode(rel == 1 & f_born == 1 ~ "Evangelical Prot.", | |
| rel == 1 & f_born == 2 ~ "Non-Evangelical", | |
| rel == 2 ~ "Catholic", | |
| rel == 9 | rel == 10 ~ "Atheist/Agnostic", | |
| rel == 12 ~ "Nothing in Particular")) %>% | |
| group_by(rel) %>% | |
| ct(why, wt = weight_w130, show_na = FALSE) | |
| three <- bind_rows(gg1, gg2) %>% mutate(reason = "To improve my personal appearance") | |
| all <- bind_rows(one, two, three) %>% filter(rel != "NA") | |
| # Define a clean color palette | |
| why_colors <- c( | |
| "Major Reason" = "#377EB8", # Dark blue | |
| "Minor Reason" = "#FF7F00", # Orange | |
| "Not a Reason" = "#BFC5CC" # Light gray | |
| ) | |
| all %>% | |
| mutate(lab = round(pct, 2)) %>% | |
| ggplot(., aes(x = fct_rev(rel), y = pct, fill = fct_rev(why))) + | |
| geom_col(color = "black") + | |
| coord_flip() + | |
| facet_wrap(~ reason, ncol =1, strip.position = "top") + | |
| theme_rb() + | |
| scale_fill_manual(values = why_colors, name = "Reason") + | |
| 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 = 7.5, family = "font", color = "black") + | |
| # geom_text(aes(label = ifelse(age2 == "18-35", paste0(lab*100, '%'), '')), position = position_stack(vjust = 0.5), size = 4, family = "font", color = "white") + | |
| # geom_text(aes(label = ifelse(age2 == "36-44", paste0(lab*100, '%'), '')), position = position_stack(vjust = 0.5), size = 4, family = "font", color = "white") + | |
| theme(plot.title = element_text(size = 28)) + | |
| theme(legend.text = element_text(size = 20)) + | |
| theme(strip.text.y.left = element_text(angle = 0, hjust = 1)) + | |
| labs(x = "", y = "", title = "Why Did You Get a Tattoo?", caption = "@ryanburge + @religiondata | Data: Pew American Trends Panel Wave 130") | |
| save("why_tats_relig.png", wd = 9, ht = 10) | |
| pew %>% | |
| mutate(rel = f_relig) %>% | |
| mutate(rel = frcode(rel == 1 & f_born == 1 ~ "Evangelical Prot.", | |
| rel == 1 & f_born == 2 ~ "Non-Evangelical", | |
| rel == 2 ~ "Catholic", | |
| rel == 9 | rel == 10 ~ "Atheist/Agnostic", | |
| rel == 12 ~ "Nothing in Particular")) %>% | |
| mutate(regret = case_when(tattoo_regret_w130 == 1 ~ 1, | |
| tattoo_regret_w130 == 2 ~ 0)) %>% | |
| group_by(rel) %>% | |
| mean_ci(regret, wt = weight_w130, ci = .84) | |
| gg1 <- pew %>% | |
| filter(f_agecat == 1 | f_agecat == 2) %>% | |
| mutate(rel = f_relig) %>% | |
| mutate(rel = frcode(rel == 1 & f_born == 1 ~ "Evangelical Prot.", | |
| rel == 1 & f_born == 2 ~ "Non-Evangelical", | |
| rel == 2 ~ "Catholic", | |
| rel == 9 | rel == 10 ~ "Atheist/Agnostic", | |
| rel == 12 ~ "Nothing in Particular")) %>% | |
| mutate(likely = case_when(tattoo_later_w130 == 5 ~ 1, | |
| tattoo_later_w130 <= 4 ~ 0)) %>% | |
| group_by(rel) %>% | |
| mean_ci(likely, wt = weight_w130, ci = .84) %>% filter(rel != "NA") | |
| gg2 <- pew %>% | |
| filter(f_agecat == 1 | f_agecat == 2) %>% | |
| mutate(likely = case_when(tattoo_later_w130 == 5 ~ 1, | |
| tattoo_later_w130 <= 4 ~ 0)) %>% | |
| mean_ci(likely, wt = weight_w130, ci = .84) %>% | |
| mutate(rel = "Entire Sample") | |
| both <- bind_rows(gg1, gg2) %>% filter(rel != "NA") | |
| fill_colors <- c( | |
| "Entire Sample" = "#9E9E9E", # Neutral gray | |
| "Evangelical Prot." = "#E41A1C", # Red | |
| "Non-Evangelical" = "#377EB8", # Blue | |
| "Catholic" = "#4DAF4A", # Green | |
| "LDS" = "#FF7F00", # Orange | |
| "Jewish" = "#984EA3", # Purple | |
| "Atheist/Agnostic" = "#FFFF33", # Yellow | |
| "Agnostic" = "#A65628", # Brown | |
| "Nothing in Particular" = "#F781BF" # Pink | |
| ) | |
| # assuming `both` has: rel, mean, lower, upper (from mean_ci) | |
| plot_df <- both %>% | |
| mutate(rel = fct_reorder(rel, mean)) %>% filter(rel != 'NA') | |
| gg <- ggplot(plot_df, aes(x = rel, y = mean, fill = rel)) + | |
| geom_col(color = "black") + | |
| geom_errorbar(aes(ymin = lower, ymax = upper), width = 0.15, linewidth = 0.6) + | |
| lab_bar(above = FALSE, pos = .045, sz = 9, type = mean) + | |
| coord_flip(clip = "off") + | |
| scale_fill_manual(values = fill_colors) + | |
| scale_y_continuous(labels = scales::percent, limits = c(0, 1.05 * max(plot_df$upper, na.rm = TRUE))) + | |
| labs( | |
| x = NULL, y = "Share Saying Not At All Likely", | |
| title = "How likely are you to get a tattoo in the future? ", | |
| subtitle = "Respondents Between the Ages of 18 and 49", | |
| caption = "@ryanburge + @religiondata | Data: Pew American Trends Panel Wave 130" | |
| ) + | |
| theme_rb() + | |
| theme( | |
| plot.margin = margin(10, 30, 10, 10), | |
| axis.text.y = element_text(size = 10) | |
| ) | |
| save("tattoo_likely_toget.png", ht = 4.5) | |
| gg1 <- pew %>% | |
| mutate(rel = f_relig) %>% | |
| mutate(rel = frcode(rel == 1 & f_born == 1 ~ "Evangelical Prot.", | |
| rel == 1 & f_born == 2 ~ "Non-Evangelical", | |
| rel == 2 ~ "Catholic", | |
| rel == 3 ~ "LDS", | |
| rel == 5 ~ "Jewish", | |
| rel == 9 ~ "Atheist", | |
| rel == 10 ~ "Agnostic", | |
| rel == 12 ~ "Nothing in Particular")) %>% | |
| mutate(impress = tattoo_react_w130) %>% | |
| mutate(impress = frcode(impress == 1 ~ "More Positive Than Negative", | |
| impress == 3 ~ "Neither", | |
| impress == 2 ~ "More Negative Than Positive")) %>% | |
| group_by(rel) %>% | |
| ct(impress, wt = weight_w130, show_na = FALSE) %>% filter(rel != "NA") | |
| gg2 <- pew %>% | |
| mutate(impress = tattoo_react_w130) %>% | |
| mutate(impress = frcode(impress == 1 ~ "More Positive Than Negative", | |
| impress == 3 ~ "Neither", | |
| impress == 2 ~ "More Negative Than Positive")) %>% | |
| ct(impress, wt = weight_w130, show_na = FALSE) %>% | |
| mutate(rel = "Entire Sample") | |
| both <- bind_rows(gg1, gg2) | |
| # Create ordering: Entire Sample first, then by % More Negative | |
| negative_order <- both %>% | |
| filter(impress == "More Negative Than Positive") %>% | |
| arrange(desc(pct)) %>% | |
| pull(rel) | |
| both <- both %>% | |
| mutate(rel = factor(rel, levels = c("Entire Sample", negative_order[negative_order != "Entire Sample"]))) | |
| # Define the color palette | |
| impress_colors <- c( | |
| "More Positive Than Negative" = "#4DAF4A", # Green | |
| "Neither" = "#BFC5CC", # Light gray | |
| "More Negative Than Positive" = "#E41A1C" # Red | |
| ) | |
| both %>% | |
| mutate(lab = round(pct, 2)) %>% | |
| ggplot(., aes(x = 1, y = pct, fill = fct_rev(impress))) + | |
| geom_col(color = "black") + | |
| coord_flip() + | |
| facet_wrap(~ rel, ncol =1, strip.position = "left") + | |
| scale_fill_manual(values = impress_colors, name = "Impression") + | |
| theme_rb() + | |
| 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 = 7.5, family = "font", color = "black") + | |
| theme(plot.title = element_text(size = 16)) + | |
| theme(legend.text = element_text(size = 15)) + | |
| theme(strip.text.y.left = element_text(angle = 0, hjust = 1)) + | |
| labs(x = "", y = "", title = "What kind of impression does seeing a tattoo on someone give you of that person?", | |
| subtitle = "Among People Without Tattoos", | |
| caption = "@ryanburge + @religiondata | Data: Pew American Trends Panel Wave 130") | |
| save("view_of_tattoos_relig.png", wd = 9, ht = 5) | |
| pew %>% | |
| filter(f_agecat == 1 | f_agecat == 2) %>% | |
| ct(tattoo_later_w130, show_na = FALSE, wt = weight_w130) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment