visualizations.r

library(dplyr)
library(ggalt)
library(ggplot2)
library(readr)
library(tidyr)

source("data_maps.r")

# Generate summary plots for ABEM survey responses using harmonized data and
# shared factor orderings defined in `data_maps.r`.

# Import harmonized survey data and encode likert/socdem fields as ordered
# factors so plots display in the intended order.
data <- read_csv(
  "data/clinican_scale_measures_harmonized_analysis_data.csv",
  col_types = cols(
    socdem_hispanic = col_factor(levels = socdem_hispanic_factor_levels),
    socdem_identity = col_factor(levels = socdem_identity_factor_levels),
    socdem_marital = col_factor(levels = socdem_marital_factor_levels),
    socdem_military = col_factor(levels = socdem_military_factor_levels),
    socdem_care = col_factor(levels = socdem_care_factor_levels),
    socdem_experience = col_factor(levels = socdem_experience_factor_levels)
  )
) |>
  mutate(
    across(
      starts_with("abem_"),
      ~ factor(as.character(.x), levels = abem_factor_levels, ordered = TRUE)
    )
  )

# Load numeric Likert summary data for ABEM items to show mean differences; this
# dataset is prepared upstream so plotting code can stay lightweight.
abem_mean_diff <- read_csv(
  "data/csm_likert_numeric_data.csv",
  col_types = cols(
    item = col_factor(levels = abem_descriptive_names)
  )
)

# Bar plot comparing Canvas pre vs post mean scores by item
p1 <- abem_mean_diff |>
  ggplot(aes(x = mean_canvas_pre, xend = mean_canvas_post, y = item)) +
  geom_dumbbell(
    colour = "#a3c4dc",
    size = 3,
    colour_xend = "#0e668b",
    dot_guide = TRUE,
    dot_guide_size = 0.25,
    show.legend = TRUE
  ) +
  labs(x = "Mean Likert Value", y = NULL)

ggsave(
  filename = "visualizations/likert_answer_mean_changes.png",
  plot = p1,
  width = 4500,
  height = 3500,
  units = "px",
  dpi = "retina"
)


# Prep long-format data to compare pre/post response distributions
abem_long <- data |>
  filter(data_source %in% c("canvas_pre", "canvas_post")) |>
  pivot_longer(
    cols = starts_with("abem_"),
    names_to = "item",
    values_to = "response"
  ) |>
  drop_na(response) |>
  mutate(
    # Make scores numeric for plotting and attach descriptive item labels.
    score_num = as.integer(response) - 3,
    item = factor(
      abem_descriptive_names[item],
      levels = abem_descriptive_names
    ),
    data_source = recode(
      data_source,
      canvas_pre = "Canvas-pre",
      canvas_post = "Canvas-post"
    ),
    data_source = factor(data_source, levels = c("Canvas-pre", "Canvas-post"))
  )

# Distribution plot comparing pre/post ABEM item responses. Uses the descriptive
# item labels and numeric scores computed above to keep facets ordered.
p2 <- abem_long |>
  select(item, response, score_num, data_source) |>
  ggplot(aes(y = response, fill = data_source)) +
  geom_histogram(stat = "count", position = "dodge", width = 0.5) +
  scale_fill_manual(values = c("#a3c4dc", "#0e668b")) +
  facet_wrap(vars(item), labeller = label_wrap_gen(26)) +
  labs(x = NULL, y = "Likert Response", fill = "Survey")

# Persist the distribution plot for use in reports/manuscripts.
ggsave(
  filename = "visualizations/likert_answer_distributions.png",
  plot = p2,
  width = 4500,
  height = 3500,
  units = "px",
  dpi = "retina"
)

p3 <- abem_long |>
  select(id, item, response, score_num, data_source) |>
  ggplot(aes(y = response, fill = data_source)) +
  geom_histogram(stat = "count", position = "dodge", width = 0.5) +
  facet_wrap(vars(id, item), labeller = label_wrap_gen(26)) +
  labs(x = NULL, y = "Likert Response", fill = "Survey")