ct_selection_untitled-390B86BF.R

library(rio)

fire <- import("E://data/fire2026.csv")


# Vector of all the topic variables
topics <- c("abortion", "affirmact", "china", "climate", "crime", "econineq",
            "freespeech", "gayrights", "genderineq", "gunctrl", "hatespeech",
            "immigration", "ipc", "election", "police", "raceineq", "relig",
            "sexasslt", "supreme", "transrights", "none1")

# Calculate share saying yes (1) for each topic
results <- fire |>
  summarise(across(all_of(topics), ~ weighted.mean(.x == 1, w = weight, na.rm = TRUE))) |>
  pivot_longer(everything(), names_to = "topic", values_to = "share") |>
  arrange(desc(share))

results <- results |>
  mutate(label = case_when(
    topic == "ipc"        ~ "Israeli/Palestinian",
    topic == "abortion"   ~ "Abortion",
    topic == "election"   ~ "2024 Election",
    topic == "transrights"~ "Transgender Rights",
    topic == "raceineq"   ~ "Racial Inequality",
    topic == "immigration"~ "Immigration",
    topic == "gunctrl"    ~ "Gun Control",
    topic == "gayrights"  ~ "Gay Rights",
    topic == "relig"      ~ "Religion",
    topic == "sexasslt"   ~ "Sexual Assault",
    topic == "police"     ~ "Police Misconduct",
    topic == "genderineq" ~ "Gender Inequality",
    topic == "hatespeech" ~ "Hate Speech",
    topic == "affirmact"  ~ "Affirmative Action",
    topic == "econineq"   ~ "Economic Inequality",
    topic == "freespeech" ~ "Freedom of Speech",
    topic == "climate"    ~ "Climate Change",
    topic == "none1"      ~ "None of the Above",
    topic == "crime"      ~ "Crime",
    topic == "supreme"    ~ "The Supreme Court",
    topic == "china"      ~ "China"
  ))

# Named color vector for all 20 topics
topic_colors <- c(
  "Israeli/Palestinian" = "#e41a1c",
  "Abortion"                     = "#377eb8",
  "2024 Election"   = "#4daf4a",
  "Transgender Rights"           = "#984ea3",
  "Racial Inequality"            = "#ff7f00",
  "Immigration"                  = "#a65628",
  "Gun Control"                  = "#f781bf",
  "Gay Rights"                   = "#999999",
  "Religion"                     = "#66c2a5",
  "Sexual Assault"               = "#fc8d62",
  "Police Misconduct"            = "#8da0cb",
  "Gender Inequality"            = "#e78ac3",
  "Hate Speech"                  = "#a6d854",
  "Affirmative Action"           = "#ffd92f",
  "Economic Inequality"          = "#e5c494",
  "Freedom of Speech"            = "#b3b3b3",
  "Climate Change"               = "#1b9e77",
  "Crime"                        = "#d95f02",
  "The Supreme Court"            = "#7570b3",
  "China"                        = "#e7298a"
)

# Chart 1 - full results
results |>
  filter(topic != "none1") |>
  ggplot(aes(x = reorder(label, share), y = share, fill = label)) +
  geom_col(color = "black") +
  coord_flip() +
  scale_fill_manual(values = topic_colors) +
  y_pct() +
  lab_bar(above = TRUE, type = share, pos = .025, sz = 7) +
  theme_rb(legend = FALSE) +
  labs(
    x = "", y = "",
    title = "Which campus topics are hardest to discuss openly?",
    subtitle = "Share of students saying each issue is difficult to have an\nopen and honest conversation about",
    caption = "@ryanburge | Data: FIRE 2026"
  )
save("fire_difficult_topics.png", wd = 10, ht = 8)


results |>
  filter(topic != "none1") |>
  ggplot(aes(x = reorder(label, share), y = share, fill = label)) +
  geom_col(color = "black") +
  coord_flip() +
  scale_fill_tableau(palette = "Tableau 20") +
  y_pct() +
  lab_bar(above = TRUE, type = share, pos = .025, sz = 7) +
  theme_rb(legend = FALSE) +
  labs(
    x = "", y = "",
    title = "Which campus topics are hardest to discuss openly?",
    subtitle = "Share of students saying each issue is difficult to have an\nopen and honest conversation about",
    caption = "@ryanburge | Data: FIRE 2026"
  )

save("fire_difficult_topics.png", wd = 10, ht = 8)



fire <- fire |>
  mutate(reltrad = frcode(
    religion == 1  ~ "Protestant",
    religion == 2  ~ "Catholic",
    religion == 10 ~ "Christian (Generic)",
    religion == 3  ~ "LDS",
    religion == 4  ~ "Orthodox",
    religion == 5  ~ "Jewish",
    religion == 6  ~ "Muslim",
    religion == 7  ~ "Atheist",
    religion == 8  ~ "Agnostic",
    religion == 9  ~ "Nothing in Particular",
    religion == 11 ~ "Buddhist",
    religion == 12 ~ "Hindu",
    religion == 13 ~ "Other"
  ))


# For each reltrad, calc share for each topic, then grab top 3
top3_by_reltrad <- fire |>
  group_by(reltrad) |>
  summarise(across(all_of(topics), ~ weighted.mean(.x == 1, w = weight, na.rm = TRUE))) |>
  pivot_longer(-reltrad, names_to = "topic", values_to = "share") |>
  left_join(results |> select(topic, label), by = "topic") |>
  group_by(reltrad) |>
  slice_max(share, n = 3) |>
  arrange(reltrad, desc(share))

top3_by_reltrad


# Chart 2 - top 3 by reltrad, colors consistent with chart 1
top3_by_reltrad |>
  filter(!is.na(reltrad), reltrad != "Other") |>
  ungroup() |>
  mutate(rank = row_number(), .by = reltrad) |>
  ggplot(aes(x = share, y = reorder(label, share), fill = label)) +
  geom_col(color = "black") +
  facet_wrap(~ reltrad, scales = "free_y", ncol = 3) +
  scale_x_continuous(labels = scales::percent_format(accuracy = 1)) +
  scale_fill_manual(values = topic_colors) +
  geom_text(
    aes(x = share + .03, label = paste0(round(share, 2) * 100, "%")),
    hjust = 0, size = 5, family = "bold"
  ) +
  labs(
    title = "Top 3 Most Uncomfortable Campus Conversation Topics",
    subtitle = "By religious tradition",
    x = "Share saying difficult to discuss openly",
    y = NULL,
    caption = "@ryanburge | Data: FIRE 2026"
  ) +
  theme_rb(legend = FALSE) +
  theme(
    strip.text = element_text(face = "bold"),
    axis.text.y = element_text(size = 12, family = "bold"),
    axis.text.x = element_text(size = 12)
  )
save("fire_top3_reltrad.png", wd = 12, ht = 6.5)


# Overall mean for each topic across full sample
overall_means <- fire |>
  summarise(across(all_of(topics), ~ mean(.x == 1, na.rm = TRUE))) |>
  pivot_longer(everything(), names_to = "topic", values_to = "overall_mean")

# By reltrad, calc share for each topic, then index against overall mean
indexed <- fire |>
  filter(!is.na(reltrad)) |>
  group_by(reltrad) |>
  summarise(across(all_of(topics), ~ weighted.mean(.x == 1, w = weight, na.rm = TRUE))) |>
  pivot_longer(-reltrad, names_to = "topic", values_to = "share") |>
  left_join(overall_means, by = "topic") |>
  left_join(results |> select(topic, label), by = "topic") |>
  mutate(index = share - overall_mean) |>
  arrange(reltrad, desc(index))

# Top 3 most distinctive per group
distinctive <- indexed |>
  group_by(reltrad) |>
  slice_max(index, n = 3)

distinctive |> select(reltrad, label, share, overall_mean, index) |> as.data.frame()


library(gt)

table <- distinctive |>
  filter(reltrad != "Other") %>% 
  group_by(reltrad) |>
  slice_max(index, n = 1) |>
  ungroup() |>
  select(reltrad, label, share, overall_mean, index) |>
  mutate(
    share = share * 100,
    overall_mean = overall_mean * 100,
    index = index * 100
  ) |>
  gt() |>
  opt_table_font(
    font = c(
      "Abel Regular", "Segoe UI",
      default_fonts()[-c(1:3)]
    )) %>%
  cols_label(
    reltrad = "Religious Tradition",
    label = "Most Distinctive Issue",
    share = "Group %",
    overall_mean = "Overall %",
    index = "Difference"
  ) |>
  fmt_number(columns = c(share, overall_mean, index), decimals = 1) |>
  cols_align(align = "left", columns = c(reltrad, label)) |>
  cols_align(align = "center", columns = c(share, overall_mean, index)) |>
  tab_header(
    title = "What Makes Each Religious Group Unique?",
    subtitle = "The campus conversation topic each tradition finds most unusually difficult"
  ) |>
  tab_spanner(
    label = "% saying difficult to discuss",
    columns = c(share, overall_mean)
  ) |>
  tab_source_note("@ryanburge | Data: FIRE 2026") |>
  data_color(
    columns = index,
    method = "numeric",
    palette = c("white", "#2166ac")
  )

gtsave(table, "E://graphs25/distinct_table_fire2026.png")



fire <- fire |>
  mutate(pid7 = frcode(
    partyid == 1 ~ "Strong Dem",
    partyid == 2 ~ "Weak Dem",
    partyid == 3 ~ "Lean Dem",
    partyid == 4 ~ "Independent",
    partyid == 5 ~ "Lean Rep",
    partyid == 6 ~ "Weak Rep",
    partyid == 7 ~ "Strong Rep",
    partyid == 8 ~ "Something Else"
  ))

top3_pid <- fire |>
  filter(!is.na(pid7)) |>
  group_by(pid7) |>
  summarise(across(all_of(topics), ~ weighted.mean(.x == 1, w = weight, na.rm = TRUE))) |>
  pivot_longer(-pid7, names_to = "topic", values_to = "share") |>
  left_join(results |> select(topic, label), by = "topic") |>
  group_by(pid7) |>
  slice_max(share, n = 3) |>
  mutate(rank = row_number()) |>
  select(pid7, rank, label)

# Pivot wide so each party is a column
top3_pid |>
  mutate(rank = paste0("Issue ", rank)) |>
  pivot_wider(names_from = pid7, values_from = label) |>
  gt() |>
  cols_label(rank = "") |>
  tab_header(
    title = "Top 3 Most Difficult Campus Topics to Discuss",
    subtitle = "By party identification"
  ) |>
  tab_source_note("Source: FIRE 2026") |>
  cols_align(align = "center") |>
  tab_style(
    style = cell_text(weight = "bold"),
    locations = cells_column_labels()
  )


top_distinctive_pid <- fire |>
  filter(!is.na(pid7)) |>
  group_by(pid7) |>
  summarise(across(all_of(topics), ~ mean(.x == 1, na.rm = TRUE))) |>
  pivot_longer(-pid7, names_to = "topic", values_to = "share") |>
  left_join(overall_means, by = "topic") |>
  left_join(results |> select(topic, label), by = "topic") |>
  mutate(index = share - overall_mean) |>
  group_by(pid7) |>
  slice_max(index, n = 1) |>
  select(pid7, label, share, overall_mean, index)

top_distinctive_pid |> as.data.frame()




bump_data <- fire |>
  filter(!is.na(pid7), pid7 != "Something Else") |>
  group_by(pid7) |>
  summarise(across(all_of(topics), ~ weighted.mean(.x == 1, w = weight, na.rm = TRUE))) |>
  pivot_longer(-pid7, names_to = "topic", values_to = "share") |>
  left_join(results |> select(topic, label), by = "topic") |>
  filter(topic != "none1") |>
  group_by(pid7) |>
  mutate(rank = rank(-share, ties.method = "first")) |>
  ungroup() |>
  mutate(
    pid7 = factor(pid7, levels = c("Strong Dem", "Weak Dem", "Lean Dem",
                                   "Independent", "Lean Rep", "Weak Rep", "Strong Rep")),
    highlight = case_when(
      topic == "ipc"         ~ "highlight",
      topic == "abortion"    ~ "highlight",
      topic == "transrights" ~ "highlight",
      topic == "gayrights"   ~ "highlight",
      topic == "sexasslt"    ~ "highlight",
      TRUE                   ~ "other"
    )
  )

label_data <- bump_data |>
  filter(pid7 == "Strong Rep") |>
  arrange(rank)


bump_data |>
  ggplot(aes(x = pid7, y = rank, group = topic, color = label,
             linewidth = highlight, alpha = highlight)) +
  geom_line() +
  geom_point(data = bump_data |> filter(highlight == "highlight"),
             color = "white", size = 4, show.legend = FALSE) +
  geom_point(data = bump_data |> filter(highlight == "highlight"),
             size = 3, show.legend = FALSE) +
  geom_point(data = bump_data |> filter(highlight == "other"),
             size = 2, show.legend = FALSE) +
  geom_text(
    data = label_data |> filter(highlight == "other"),
    aes(x = 7.2, y = rank, label = label, color = label),
    hjust = 0, size = 4, family = "font", show.legend = FALSE
  ) +
  geom_text(
    data = label_data |> filter(highlight == "highlight"),
    aes(x = 7.2, y = rank, label = label, color = label),
    hjust = 0, size = 4, family = "bold", show.legend = FALSE
  ) +
  scale_y_reverse(breaks = 1:20) +
  scale_x_discrete(expand = expansion(mult = c(0.05, 0.25))) +
  scale_color_manual(values = topic_colors) +
  scale_linewidth_manual(values = c("highlight" = 1.8, "other" = 0.5)) +
  scale_alpha_manual(values = c("highlight" = 1, "other" = 0.6)) +
  guides(color = "none", linewidth = "none", alpha = "none") +
  labs(
    title = "How Topic Rankings Shift Across the Political Spectrum",
    subtitle = "Rank order of difficult campus topics by party ID",
    x = "", y = "Rank",
    caption = "@ryanburge | Data: FIRE 2026"
  ) +
  theme_rb(legend = FALSE) +
  theme(
    axis.text.x = element_text(size = 16, family = "bold"),
    panel.grid.major.y = element_blank(),
    panel.grid.minor.y = element_blank(),
    panel.grid.major.x = element_line(color = "grey80", linewidth = 0.3)
  )
save("fire_bump_pid.png", wd = 14, ht = 9)



gg <- fire |>
  filter(reltrad %in% c("Protestant", "Catholic", "Christian (Generic)")) |>
  filter(!is.na(pid7), pid7 != "Something Else") |>
  mutate(pid7 = factor(pid7, levels = c("Strong Dem", "Weak Dem", "Lean Dem",
                                        "Independent", "Lean Rep", "Weak Rep", "Strong Rep")),
         pid7 = dplyr::recode(pid7,
                       "Strong Dem"  = "Strong\nDem",
                       "Weak Dem"    = "Weak\nDem",
                       "Lean Dem"    = "Lean\nDem",
                       "Independent" = "Indep.",
                       "Lean Rep"    = "Lean\nRep",
                       "Weak Rep"    = "Weak\nRep",
                       "Strong Rep"  = "Strong\nRep"
         )) |>
  group_by(reltrad, pid7) |>
  mean_ci(abortion, wt = weight, ci = .84) |>
  arrange(reltrad, pid7)

gg |>
  ggplot(aes(x = pid7, y = mean, fill = pid7)) +
  geom_col(color = "black") +
  facet_wrap(~ reltrad) +
  error_bar() +
  pid7_fill(rev = TRUE) +
  theme_rb() +
  lab_bar_white(above = FALSE, type = mean, pos = .04, sz = 6) +
  y_pct() +
  labs(
    x = "", y = "",
    title = "Share of Christian Students Who Find Abortion Difficult to Discuss on Campus",
    subtitle = "By religious tradition and party identification",
    caption = "@ryanburge | Data: FIRE 2026"
  )

save("fire_abortion_christian_pid.png", wd = 12, ht = 6)

gg2 <- fire |>
  filter(reltrad %in% c("Protestant", "Catholic", "Christian (Generic)")) |>
  filter(!is.na(pid7), pid7 != "Something Else") |>
  mutate(pid7 = factor(pid7, levels = c("Strong Dem", "Weak Dem", "Lean Dem",
                                        "Independent", "Lean Rep", "Weak Rep", "Strong Rep")),
         pid7 = dplyr::recode(pid7,
                       "Strong Dem"  = "Strong\nDem",
                       "Weak Dem"    = "Weak\nDem",
                       "Lean Dem"    = "Lean\nDem",
                       "Independent" = "Indep.",
                       "Lean Rep"    = "Lean\nRep",
                       "Weak Rep"    = "Weak\nRep",
                       "Strong Rep"  = "Strong\nRep"
         )) |>
  pivot_longer(cols = c(abortion, gayrights), names_to = "topic", values_to = "value") |>
  mutate(topic = dplyr::recode(topic,
                        "abortion"  = "Abortion",
                        "gayrights" = "Gay Rights"
  )) |>
  group_by(reltrad, pid7, topic) |>
  mean_ci(value, wt = weight, ci = .84) |>
  arrange(topic, reltrad, pid7)

gg2 |>
  ggplot(aes(x = pid7, y = mean, fill = pid7)) +
  geom_col(color = "black") +
  facet_grid(topic ~ reltrad) +
  error_bar() +
  pid7_fill(rev = TRUE) +
  theme_rb() +
  lab_bar_white(above = FALSE, type = mean, pos = .04, sz = 6) +
  y_pct() +
  labs(
    x = "", y = "",
    title = "Which Campus Topics Are Hard to Discuss? Among Christian Students",
    subtitle = "By issue, religious tradition, and party identification",
    caption = "@ryanburge | Data: FIRE 2026"
  )

save("fire_abortion_gay_christian_pid.png", wd = 14, ht = 8)



gg2 <- fire |>
  filter(reltrad %in% c("Protestant", "Catholic", "Christian (Generic)")) |>
  filter(!is.na(pid7), pid7 != "Something Else") |>
  mutate(pid3 = frcode(
    partyid %in% c(1, 2, 3) ~ "Democrat",
    partyid == 4            ~ "Independent",
    partyid %in% c(5, 6, 7) ~ "Republican"
  )) |>
  pivot_longer(cols = c(abortion, gayrights, transrights),
               names_to = "topic", values_to = "value") |>
  mutate(topic = dplyr::recode(topic,
                               "abortion"    = "Abortion",
                               "gayrights"   = "Gay Rights",
                               "transrights" = "Transgender Rights"
  )) |>
  group_by(reltrad, pid3, topic) |>
  mean_ci(value, wt = weight, ci = .84) |>
  arrange(topic, reltrad, pid3)

gg2 |>
  ggplot(aes(x = pid3, y = mean, fill = pid3)) +
  geom_col(color = "black") +
  facet_grid(topic ~ reltrad) +
  error_bar() +
  pid3_fill() +
  theme_rb() +
  lab_bar_white(above = FALSE, type = mean, pos = .06, sz = 9) +
  y_pct() +
  labs(
    x = "", y = "",
    title = "Which Campus Topics Are Hard to Discuss? Among Christian Students",
    subtitle = "By issue, religious tradition, and party identification",
    caption = "@ryanburge | Data: FIRE 2026"
  ) +
  theme(
    strip.text.x = element_text(size = 14, family = "bold"),
    strip.text.y = element_text(size = 16, family = "bold"),
    axis.text.x = element_text(size = 12, family = "bold")
  )

save("fire_abortion_gay_trans_christian_pid.png", wd = 10, ht = 10)




library(marginaleffects)

# Recode predictors
fire <- fire |>
  mutate(
    female     = as.numeric(gender == 2),
    straight   = as.numeric(sexorientation == 1),
    pid_scale  = as.numeric(partyid),
    ideo_scale = case_when(ideo %in% 1:7 ~ as.numeric(ideo), TRUE ~ NA_real_),
    attend     = as.numeric(religattend),
    white      = as.numeric(race == 7)
  )

# Run three models
m_trans <- glm(transrights ~ pid_scale + ideo_scale + reltrad + attend +
                 female + straight + white + age,
               data = fire, family = binomial(link = "logit"),
               weights = weight)

m_gay <- glm(gayrights ~ pid_scale + ideo_scale + reltrad + attend +
               female + straight + white + age,
             data = fire, family = binomial(link = "logit"),
             weights = weight)

m_abort <- glm(abortion ~ pid_scale + ideo_scale + reltrad + attend +
                 female + straight + white + age,
               data = fire, family = binomial(link = "logit"),
               weights = weight)

# Average marginal effects
ame_trans <- avg_slopes(m_trans)
ame_gay   <- avg_slopes(m_gay)
ame_abort <- avg_slopes(m_abort)

ame_trans
ame_gay
ame_abort



library(broom)

# Tidy all three models and bind together
tidy_all <- bind_rows(
  tidy(m_trans) |> mutate(model = "Transgender Rights"),
  tidy(m_gay)   |> mutate(model = "Gay Rights"),
  tidy(m_abort) |> mutate(model = "Abortion")
) 

# Pull AMEs instead of raw log-odds — much more interpretable
ame_all <- bind_rows(
  as.data.frame(ame_trans) |> mutate(model = "Transgender Rights"),
  as.data.frame(ame_gay)   |> mutate(model = "Gay Rights"),
  as.data.frame(ame_abort) |> mutate(model = "Abortion")
) |>
  filter(term %in% c("pid_scale", "ideo_scale", "attend", "female", "white", "straight", "age")) |>
  mutate(
    term = dplyr::recode(term,
                         "pid_scale"  = "Party ID (R)",
                         "ideo_scale" = "Ideology (Conservative)",
                         "attend"     = "Religious Attendance",
                         "female"     = "Female",
                         "white"      = "White",
                         "straight"   = "Heterosexual",
                         "age"        = "Age"
    ),
    model = factor(model, levels = c("Abortion", "Gay Rights", "Transgender Rights"))
  )

ame_all |>
  ggplot(aes(x = estimate, y = reorder(term, estimate), color = model,
             xmin = conf.low, xmax = conf.high)) +
  geom_vline(xintercept = 0, linetype = "dashed", color = "grey50") +
  geom_errorbarh(height = 0.2, position = position_dodge(width = 0.6)) +
  geom_point(size = 3, position = position_dodge(width = 0.6)) +
  scale_color_manual(values = c(
    "Abortion"           = "#377eb8",
    "Gay Rights"         = "#984ea3",
    "Transgender Rights" = "#e41a1c"
  )) +
  scale_x_continuous(labels = scales::percent_format(accuracy = 1)) +
  labs(
    x = "Average Marginal Effect (percentage points)",
    y = NULL,
    title = "What Predicts Finding a Topic Difficult to Discuss on Campus?",
    subtitle = "Average marginal effects from logistic regression; controls include religion tradition",
    caption = "@ryanburge | Data: FIRE 2026",
    color = ""
  ) +
  theme_rb(legend = TRUE) +
  theme(
    legend.position = "top",
    axis.text.y = element_text(size = 12, family = "bold")
  )

save("fire_ame_coefplot.png", wd = 12, ht = 7)


fire |>
  filter(reltrad %in% c("Jewish", "Muslim", "Atheist", "Agnostic")) |>
  filter(!is.na(pid7), pid7 != "Something Else") |>
  mutate(pid3 = frcode(
    partyid %in% c(1, 2, 3) ~ "Democrat",
    partyid == 4            ~ "Independent",
    partyid %in% c(5, 6, 7) ~ "Republican"
  )) |>
  group_by(reltrad, pid3) |>
  mean_ci(ipc, wt = weight, ci = .84) |>
  arrange(reltrad, pid3)



fire |>
  filter(reltrad %in% c("Jewish", "Muslim", "Atheist", "Agnostic")) |>
  filter(!is.na(pid7), pid7 != "Something Else") |>
  mutate(pid3 = frcode(
    partyid %in% c(1, 2, 3) ~ "Democrat",
    partyid == 4            ~ "Independent",
    partyid %in% c(5, 6, 7) ~ "Republican"
  )) |>
  group_by(reltrad, pid3) |>
  mean_ci(ipc, wt = weight, ci = .84) |>
  ggplot(aes(x = pid3, y = mean, fill = pid3)) +
  geom_col(color = "black") +
  facet_wrap(~ reltrad, nrow = 1) +
  error_bar() +
  pid3_fill() +
  lab_bar_white(above = FALSE, type = mean, pos = .06, sz = 9) +
  y_pct() +
  theme_rb() +
  labs(
    x = "", y = "",
    title = "Share Finding Israeli/Palestinian Conflict Difficult to Discuss on Campus",
    subtitle = "By religious tradition and party identification",
    caption = "@ryanburge | Data: FIRE 2026"
  ) +
  theme(
    strip.text = element_text(size = 14, family = "bold"),
    axis.text.x = element_text(size = 12, family = "bold")
  )

save("fire_ipc_pid3_reltrad.png", wd = 12, ht = 6)