In jemus42/gdqdonations: Get data from the 'GDQ' donation tracker

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  warning = FALSE,
  fig.align = "center",
  fig.width = 8,
  fig.showtext = TRUE
)

if (!("Cubano" %in% showtextdb::font_installed())) {
  showtextdb::font_install(
    font_desc = list(
      showtext_name = "Cubano",
      font_ext = "ttf",
      regular_url = "https://dump.jemu.name/cubano-regular-webfont.ttf"
    )
  )
}

if (!("Fira Sans Condensed" %in% showtextdb::font_installed())) {
  # showtextdb::font_install(showtextdb::google_fonts("Fira Sans Condensed"))
  sysfonts::font_add_google("Fira Sans Condensed")
}

library(gdqdonations)
library(dplyr)
library(tidyr)
library(ggplot2)
library(kableExtra)

donations <- gdqdonations::gdq_donations %>% 
  augment_donations()
runs <- gdqdonations::gdq_runs

gdq_donation_totals <-
  donations %>%
  group_by(event) %>%
  summarize(
    total = sum(amount),
    avg = mean(amount),
    gdq = unique(gdq),
    year = unique(year)
  ) %>%
  arrange(as.numeric(year)) %>%
  mutate(cumtot = cumsum(total))

gdq_donation_totals %>%
  ggplot(aes(x = year, y = total, fill = gdq)) +
  geom_col(position = position_dodge2(preserve = "single"), alpha = .75) +
  scale_x_year_discrete() +
  scale_y_currency(
    breaks = seq(0, 10e6, 5e5),
    minor_breaks = seq(0, 10e6, 2.5e5)
  ) +
  scale_colorfill_gdq(guide = "none") +
  labs(
    title = "Games Done Quick: Donation Totals",
    subtitle = glue::glue("Donation totals for <span style='color:{gdq_pal[['AGDQ']]}'>AGDQ</span> and <span style='color:{gdq_pal[['SGDQ']]}'>SGDQ</span> as per the official tracker page")
  ) +
  theme_gdq()

Relative Progress

Unfortunately finding the proper "end time" is not that easy, since the end time of the last run (or finale section) typically comes way before the last of the donations have trickled in.
Also, the last "run" listed on the runs page is sometimes the finale, sometimes the last game, sometimes an explicit total:?

full_join(
  runs %>%
    group_by(event) %>%
    slice_tail(n = 1) %>% 
    select(event, run, run_end),
  donations %>% 
    group_by(event) %>% 
    slice_tail(n = 1) %>% 
    select(event, amount, donation_time = time),
  by = "event"
) %>% 
  arrange(donation_time) %>% 
  mutate(hours_since_end = (run_end %--% donation_time) / lubridate::dhours(1)) %>% 
  select(
    event,
    last_run = run, last_run_end = run_end,
    last_donation = donation_time, amount,
    hours_since_end
  ) %>% 
  kable() %>% 
  kable_styling()

How about we compare first/last donation and first/last run times per event.

bind_rows(
  runs %>%
    group_by(event) %>% 
    summarize(
      type = "run",
      first = min(run_start, na.rm = TRUE),
      last = max(run_end, na.rm = TRUE)
    ),
  donations %>%
    group_by(event) %>% 
    summarize(
      type = "donation",
      first = min(time, na.rm = TRUE),
      last = max(time, na.rm = TRUE)
    )
) %>% 
  arrange(first) %>% 
  mutate(
    event = factor(event, levels = event_index$event)
  ) %>% 
  ggplot(aes(y = 0, xmin = first, xmax = last, fill = type, color = type)) +
  facet_wrap(facets = vars(event), scales = "free", nrow = 4) +
  geom_errorbarh(height = .5, size = 1.5, alpha = 2/3) +
  scale_x_datetime(breaks = scales::pretty_breaks(n = 3)) +
  scale_y_continuous(limits = c(-1, 1)) +
  scale_color_brewer(palette = "Dark2", guide = "none") +
  labs(
    title = "First and Last <span style='color:#1B9E77'>Donation</span> and <span style='color:#D95F02'>Run</span>  per Event",
    subtitle = "Donations are logged long before and after the main event period",
    x = "Date"
  ) +
  theme_gdq(
    axis.text.x = element_text(size = rel(.8)),
    axis.line.y = element_blank(),
    axis.text.y = element_blank(),
    axis.title.y = element_blank()
  )

Trying to reasonably determine start and end of the main event period to scale donation progress relatively.

donations %>%
  filter(time_rel >= 0 & time_rel <= 1.05) %>%
  group_by(event) %>%
  mutate(amount_total = cumsum(amount)) %>%
  ungroup() %>%
  mutate(
    highlight = event == latest_event()
  ) %>% 
  ggplot(aes(x = time_rel, y = amount_total, color = highlight, group = event)) +
  geom_step() +
  scale_x_continuous(labels = scales::percent_format()) +
  scale_y_currency(breaks = scales::pretty_breaks()) +
  scale_color_manual(
    values = c("TRUE" = gdq_pal[["GDQ"]], "FALSE" = "gray"), 
    labels = c("TRUE" = latest_event(), "FALSE" = "Previous events"),
    name = "",
    guide = "none"
  ) +
  labs(
    title = "Latest event donation progression",
    subtitle = "Compared to previous events, with time (roughly) relative to start/end of event",
    y = "Cumulative donation total",
    x = "Event Progression"
  ) +
  theme_gdq()