ct_selection_untitled-715B2FAD.R

fire <- read_csv("E://data/fire2025.csv")

library(googlesheets4)

acc <- read_sheet("https://docs.google.com/spreadsheets/d/1lZojjLMelKe38MKicA8UiT4v3gQv8scwDs31IjZjcf4/edit?usp=sharing")

acc <- acc %>% 
  select(school = `College or University`, pct = Percentage) %>% 
  mutate(type = "Selective")

fire <- left_join(fire, acc)

one <- fire %>% 
  filter(school == "Yale University" | school == "Harvard University") %>% 
  mutate(relig = frcode(religion == 1 | religion == 10 ~ "Protestant", 
                        religion == 2 ~ "Catholic", 
                        religion == 3 | religion == 4 | religion == 5 | religion == 6 | religion == 11 | religion == 12 ~ "Other World Religions", 
                        religion == 7 | religion == 8 ~ "Atheist/Agnostic", 
                        religion == 9 ~ "Nothing in Particular")) %>% 
  ct(relig, wt = weight, show_na = FALSE) %>% 
  mutate(type = "Harvard/Yale")

two <- fire %>% 
  filter(school == "Southern Illinois University-Edwardsville") %>% 
  mutate(relig = frcode(religion == 1 | religion == 10 ~ "Protestant", 
                        religion == 2 ~ "Catholic", 
                        religion == 3 | religion == 4 | religion == 5 | religion == 6 | religion == 11 | religion == 12 ~ "Other World Religions", 
                        religion == 7 | religion == 8 ~ "Atheist/Agnostic", 
                        religion == 9 ~ "Nothing in Particular")) %>% 
  ct(relig, wt = weight, show_na = FALSE) %>% 
  mutate(type = "SIU-Edwardsville")

both <- bind_rows(one, two)


both %>% 
  mutate(lab = round(pct, 2)) %>% 
  ggplot(., aes(x = 1, y = pct, fill = fct_rev(relig))) +
  geom_col(color = "black") + 
  coord_flip() +
  facet_wrap(~ type, ncol =1, strip.position = "left") +
  theme_rb() +
  scale_fill_manual(values = c(moma.colors("ustwo", 5))) +
  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(strip.text.y.left = element_text(angle = 0, hjust = 1)) +
  labs(x = "", y = "", title = "Comparing the Religious Composition of Two Elite Institutions to a Regional University", caption = "@ryanburge\nData: FIRE Free Speech Rankings, 2025") 
save("siu_vs_harvard.png", wd = 9, ht = 3)

gg <- fire %>% 
  mutate(
    relig = frcode(
      religion == 1 ~ "Protestant", 
      religion == 2 ~ "Catholic", 
      religion == 3 ~ "LDS", 
      religion == 4 ~ "Orthodox", 
      religion == 10 ~ "Christian",
      religion == 5 ~ "Jewish", 
      religion == 6 ~ "Muslim", 
      religion == 11 ~ "Buddhist", 
      religion == 12 ~ "Hindu", 
      religion == 7 ~ "Atheist", 
      religion == 8 ~ "Agnostic", 
      religion == 9 ~ "Nothing\nin Particular", 
      religion == 11 ~ "Other"
    ),
    type = ifelse(is.na(type), "Non-\nSelective", type) # Replace NA in type
  ) %>% 
  group_by(type) %>% 
  ct(relig, wt = weight, show_na = FALSE) 

gg %>% 
  ggplot(., aes(x = type, y = pct, fill = type)) +
  geom_col(color = "black") +
  facet_wrap(~ relig) +
  theme_rb() +
  scale_fill_calc() +
  y_pct() + 
  lab_bar(type = pct, above = TRUE, pos = .02, sz = 8) +
  labs(x = "", y = "", title = "The Religious Composition of Selective and Non-Selective Universities", 
       caption = "@ryanburge\nData: FIRE Free Speech Rankings, 2025")
save("elite_college_compare_fire25.png", wd = 7, ht = 10)

gg <- fire %>% 
  mutate(id7 = ideo) %>% 
  mutate(id7 = frcode(id7 == 1 | id7 == 2 | id7 == 3 ~ "Liberal", 
                      id7 == 4 ~ "Middle of the Road", 
                      id7 == 5 | id7 == 6 | id7 == 7 ~ "Conservative")) %>% 
  mutate(relig = frcode(religion == 1 | religion == 10 ~ "Protestant", 
                        religion == 2 ~ "Catholic", 
                        religion == 3 | religion == 4 | religion == 5 | religion == 6 | religion == 11 | religion == 12 ~ "Other World Religions", 
                        religion == 7 | religion == 8 ~ "Atheist/Agnostic", 
                        religion == 9 ~ "Nothing in Particular")) %>% 
  mutate(type = replace_na(type, "Non-Selective")) %>% 
  group_by(type, id7) %>% 
  ct(relig, wt = weight, show_na = FALSE)

gg %>% 
  filter(id7 != "NA") %>% 
  mutate(lab = round(pct, 2)) %>% 
  ggplot(., aes(x = fct_rev(type), y = pct, fill = fct_rev(relig))) +
  geom_col(color = "black") + 
  coord_flip() +
  facet_wrap(~ id7, ncol =1, strip.position = "top") +
  theme_rb() +
  scale_fill_manual(values = c(moma.colors("ustwo", 5))) +
  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, 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(strip.text.y.left = element_text(angle = 0, hjust = 1)) +
  labs(x = "", y = "", title = "Religious Composition by Political Ideology", caption = "@ryanburge\nData: FIRE Free Speech Rankings, 2025") 
save("id3_fire_relig5.png", wd = 9, ht = 5)


gg <- fire %>% 
  mutate(attend = religattend) %>% 
  mutate(attend = frcode(attend == 1 ~ "Never", 
                         attend == 2 ~ "Seldom", 
                         attend == 3 ~ "1-2x Year", 
                         attend == 4 ~ "Several Times a Year", 
                         attend == 5 ~ "Monthly", 
                         attend == 6 ~ "2-3x Month", 
                         attend == 7 ~ "About Weekly", 
                         attend == 8 ~ "Weekly", 
                         attend == 9 ~ "Weekly+"),
         type = ifelse(is.na(type), "Non-\nSelective", type) # Replace NA in type
  ) %>% 
  group_by(type) %>% 
  ct(attend, wt = weight, show_na = FALSE) 

gg %>% 
  ggplot(., aes(x = type, y = pct, fill = type)) +
  geom_col(color = "black") +
  facet_wrap(~ attend) +
  theme_rb() +
  scale_fill_calc() +
  y_pct() + 
  lab_bar(type = pct, above = TRUE, pos = .035, sz = 8) +
  labs(x = "", y = "", title = "The Religious Attendance of Selective and Non-Selective Universities", 
       caption = "@ryanburge\nData: FIRE Free Speech Rankings, 2025")
save("elite_college_compare_fire25_att.png", wd = 7, ht = 10)

gg <- fire %>% 
  mutate(id7 = ideo) %>% 
  mutate(id7 = frcode(id7 == 1 | id7 == 2 | id7 == 3 ~ "Liberal", 
                      id7 == 4 ~ "Middle of the Road", 
                      id7 == 5 | id7 == 6 | id7 == 7 ~ "Conservative")) %>% 
  mutate(attend = religattend) %>% 
  mutate(attend = frcode(attend == 1 ~ "Never", 
                         attend == 2 ~ "Seldom", 
                         attend == 3 ~ "1-2x Year", 
                         attend == 4 ~ "Several Times a Year", 
                         attend == 5 | attend == 6 ~ "Monthly", 
                         attend == 7 | attend == 8 | attend == 9 ~ "Weekly")) %>% 
  mutate(type = replace_na(type, "Non-Selective")) %>% 
  group_by(type, id7) %>% 
  ct(attend, wt = weight, show_na = FALSE)


gg %>% 
  filter(id7 != "NA") %>% 
  mutate(lab = round(pct, 2)) %>% 
  ggplot(., aes(x = fct_rev(type), y = pct, fill = fct_rev(attend))) +
  geom_col(color = "black") + 
  coord_flip() +
  facet_wrap(~ id7, ncol =1, strip.position = "top") +
  theme_rb() +
  scale_fill_manual(values = c(moma.colors("Smith", 6))) +
  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, family = "font", color = "black") +
  geom_text(aes(label = ifelse(attend == "Never", paste0(lab*100, '%'), '')), position = position_stack(vjust = 0.5), size = 7, 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(strip.text.y.left = element_text(angle = 0, hjust = 1)) +
  labs(x = "", y = "", title = "Religious Attendance by Political Ideology", caption = "@ryanburge\nData: FIRE Free Speech Rankings, 2025") 
save("id3_fire_att5.png", wd = 9, ht = 5)