brianhaas19

Toronto Shelters (Tidy Tuesday 2020-12-01)

Dec 7th, 2020 (edited)
1,737
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. ###################################################################################################
  2. # Toronto Shelters - Average nightly number of people served in Toronto's shelter system.
  3. # Created by: reddit.com/user/brianhaas19
  4.  
  5. # Link to data
  6. # https://github.com/rfordatascience/tidytuesday/blob/master/data/2020/2020-12-01
  7.  
  8. # Setup
  9. library(tidyverse)
  10. library(scales)
  11. library(patchwork)
  12. library(ggrepel)
  13. library(ggsci)
  14. theme_set(theme_bw())
  15.  
  16. # Load data
  17. shelters <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-12-01/shelters.csv')
  18.  
  19. # Clean data
  20. shelters <- shelters %>%
  21.   rename(date = occupancy_date)
  22.  
  23. # Visualize
  24. ### Recommended parameters for R notebook: fig.height=7, fig.width=9
  25. line_size = 0.5
  26. p1 <- shelters %>%
  27.   filter(is.finite(capacity)) %>% # to be consistent with the second plot
  28.   mutate(month = lubridate::floor_date(date, "month")) %>%
  29.   group_by(month, sector) %>%
  30.   mutate(num_days = n_distinct(date)) %>% # number of days in the month for calculating nightly average
  31.   summarise(occupancy = sum(occupancy)/num_days) %>%
  32.   distinct() %>%
  33.   ungroup() %>% # ungroup() here so that the next line to create the labels works
  34.   mutate(label = if_else(month == max(month), as.character(sector), NA_character_)) %>%
  35.   ggplot(aes(month, occupancy, group = sector, color = sector)) +
  36.   geom_line(size = line_size, show.legend = FALSE) +
  37.   geom_label_repel(aes(label = label), seed = 1, show.legend = FALSE, size = 4, label.padding = 0.15,
  38.                    nudge_x = 0, na.rm = TRUE) + # *1
  39.   scale_y_continuous(labels = comma) +
  40.   ggsci::scale_color_jama() +
  41.   labs(x = NULL, y = "Number of People", title = expression(paste("Average nightly ", bold(occupancy), " by ", bold(sector), ":"))) +
  42.   theme(plot.title = element_text(size = 12))
  43.  
  44. p2 <- shelters %>%
  45.   filter(is.finite(capacity)) %>%
  46.   mutate(month = lubridate::floor_date(date, "month")) %>%
  47.   group_by(month) %>%
  48.   mutate(num_days = n_distinct(date)) %>%  
  49.   summarise(occupancy = sum(occupancy)/num_days,
  50.             capacity = sum(capacity)/num_days) %>%
  51.   distinct() %>%
  52.   pivot_longer(cols = c(occupancy, capacity), names_to = "type") %>%
  53.   ungroup() %>% # ungroup() here so that the next line to create the labels works
  54.   mutate(label = if_else(month == max(month), if_else(type == "occupancy", "Occupancy", "Capacity"), NA_character_)) %>%
  55.   ggplot(aes(month, value, color = type)) +
  56.   geom_line(size = line_size, show.legend = FALSE) +
  57.   geom_label_repel(aes(label = label), seed = 1, show.legend = FALSE, size = 4, label.padding = 0.15,
  58.                    nudge_x = 0, na.rm = TRUE) + # *1
  59.   scale_y_continuous(labels = comma) +
  60.   scale_color_manual(values = c("#80796B", "#6A6599")) + # these are the remaining two colors from ggsci::scale_color_jama() not used above
  61.   labs(x = NULL, y = "Number of People", title = expression(paste("Average nightly ", bold(occupancy), " and ", bold(capacity), " - all sectors:"))) +
  62.   theme(plot.title = element_text(size = 12))
  63.  
  64. # Use patchwork package to combine the plots:
  65. P <- p1/p2 + plot_annotation(title = expression(paste(bold("Toronto Shelters"), " - Average nightly number of people served in Toronto's shelter system.")),
  66.                         caption = expression(paste("Created by: ", italic("reddit.com/user/brianhaas19"), "\tData source: ", italic("https://github.com/rfordatascience/tidytuesday/blob/master/data/2020/2020-12-01"))))
  67. P
  68.  
  69. # Uncomment this line to save to disk:
  70. # ggsave(str_c(getwd(), "/toronto_shelters.png"),
  71. #        plot = P, height = 7, width = 9)
  72. ###################################################################################################
RAW Paste Data

Adblocker detected! Please consider disabling it...

We've detected AdBlock Plus or some other adblocking software preventing Pastebin.com from fully loading.

We don't have any obnoxious sound, or popup ads, we actively block these annoying types of ads!

Please add Pastebin.com to your ad blocker whitelist or disable your adblocking software.

×