subway_hist.R

library(dplyr)
library(ggplot2)
library(ggdist)

url = 'https://osf.io/846cb/download'
httr::GET(url, httr::write_disk(tf <- tempfile(fileext = ".xlsx")))

readxl::read_xlsx(tf) %>%
  mutate(
    DIRECTION = factor(DIRECTION, levels = c("WEST","EAST"), 
                       ordered = TRUE),
    across(-matches("DISTANCE"), factor),
    STN_NAME = factor(STN_NAME, levels = c("SPAD","STG","B-Y","SHER"),
                      ordered = TRUE,
                      labels = c("Spadina","St. George",
                                 "Bloor-Younge","Sherbourne"))
    ) -> subway


# My plot

hist_scl = .5

subway %>%
  mutate(DISTANCE = factor(DISTANCE, levels = 1:6)) %>%
  group_by(STN_NAME, DIRECTION, DISTANCE, .drop=FALSE) %>%
  summarise(N = n()) %>%
  mutate(
    DIRECTION = factor(DIRECTION, levels = c("WEST","EAST"), 
                       ordered = TRUE),
    STN_NAME = factor(STN_NAME, levels = c("Spadina","St. George",
                                           "Bloor-Younge","Sherbourne"),
                      ordered = TRUE),
    total = sum(N),
    p = N / total,
    p_txt = case_when(
      p>0 ~ paste0(round(p*100,1),"%"),
      TRUE ~ ""
    ),
    rect_alpha = (as.integer(DISTANCE)-1)/5*.1+.9,
    txt_alpha = (as.integer(DISTANCE)-1)/5*.1+.9,
    ymin = as.integer(DISTANCE) - .5,
    ymax = as.integer(DISTANCE) + .5,
    xmin = case_when(
      DIRECTION == "WEST" ~ as.integer(STN_NAME) - p*!!hist_scl,
      TRUE ~ as.integer(STN_NAME) + p*!!hist_scl
    ),
    txt_hjust = case_when(
      DIRECTION == "WEST" ~ 1.1,
      TRUE ~ -.1
    ),
    txt_hjust_N = case_when(
      DIRECTION == "WEST" ~ 1.2,
      TRUE ~ -.2
    ),
    txt_total = case_when(
      DISTANCE == 1 ~ paste0("N=",total),
      TRUE ~ NA_character_
    ),
    xmax = as.integer(STN_NAME)
  ) -> freq_sum

freq_sum %>%
  ggplot(aes(x = xmin, y = ymin, alpha = DISTANCE,fill = DIRECTION)) +
  geom_rect(aes(xmin = xmin, xmax = xmax,
                ymin = ymin, ymax = ymax)) +
  geom_text(aes(y=as.integer(DISTANCE),x=xmin,
                label=p_txt, color = DIRECTION,
                hjust = txt_hjust),
            size = 2.5) +
  hrbrthemes::theme_ipsum_rc() +
  scale_x_continuous(name ="Station", 
                     limits=c(.5,4.5),
                     breaks = 1:4,
                     labels = levels(freq_sum$STN_NAME)) +
  scale_y_continuous(name ="Reported subjective distance", 
                     limits=c(.5,6.5),
                     breaks = 1:6) +
  theme(panel.grid.minor.x = element_blank(),
        panel.grid.major.y = element_blank(),
        legend.position="top") +
  guides(alpha = FALSE, color = FALSE) +
  scale_alpha_discrete(range = c(0.5, 1)) +
  scale_fill_discrete(name = "Direction",
                      labels = c("West","East")) +
  scale_color_discrete() +
  geom_text(aes(x = xmax, label = txt_total, hjust=txt_hjust_N, y=Inf), size = 2.5) +
  coord_cartesian(clip="off")

# Using {ggdist}

subway %>%
  ggplot(aes(x = STN_NAME, y = DISTANCE, alpha = DISTANCE, fill = DIRECTION)) +
  ggdist::stat_slab(
    aes(
      side = ifelse(DIRECTION == 'WEST', 'left', 'right')
      ),
    scale = 0.5, slab_type = 'histogram', breaks = seq(.5,6.5, 1)
  ) +
  scale_y_continuous(breaks = 1:6, minor_breaks = NULL)