In jemus42/speedrunr: Access Data from 'speedrun.com'

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>", 
  message = FALSE, 
  error = FALSE, fig.height = 6, fig.width = 8
)

I like Ocarina of Time 100%. So let's take a look at that.

Identify what you want

First up we need the game's ID and category ID. That's easy:

library(dplyr)
library(kableExtra)
library(speedrunr)

get_games("Ocarina of Time")

get_categories("j1l9qz1g")

So we're good.

game <- "j1l9qz1g"
category <- "q255jw2o"

oot100 <- get_runs(game = "j1l9qz1g", category = "q255jw2o", max = Inf)

Note that I'm useing max = Inf to make sure I get all the runs.

str(oot100)

We want some additional data:

oot100 <- oot100 %>%
  add_platforms() %>%
  add_regions() %>%
  find_records()

oot100 %>% 
  arrange(time_hms) %>%
  select(time_hms, record, player_name, date, system_platform, system_region) %>%
  head(10) %>%
  kable() %>%
  kable_styling()

Category Overview

Now we can take a look at the categories (recent) history, with highlighted records:

library(ggplot2)
library(ggrepel)
library(hrbrthemes)
library(hms)

oot100 %>%
  filter(time_hms < hms::hms(hours = 5)) %>%
  {
    ggplot(., aes(date, time_hms)) +
      geom_point(size = 1, alpha = .75) +
      geom_point(size = 2, data = filter(., record), aes(color = player_name)) +
      geom_label_repel(data = filter(., record),
                       aes(label = time_hms, color = player_name),
                       fill = "white", show.legend = F) +
      scale_x_date(date_breaks = "6 months", date_labels = "%b '%y") +
      scale_y_time(breaks = seq(2 * 60^2, 20 * 60^2,  1/3 * 60^2),
                   minor_breaks = seq(2 * 60^2, 20 * 60^2, 5 * 60)) +
      scale_color_brewer(palette = "Dark2") +
      labs(title = "Ocarina of Time: 100% Speedrun Record History",
           subtitle = paste0("All data from speedrun.com (n = ", nrow(.), ")"),
           x = "Date of Run", y = "Time",
           color = "Runner", caption = "Data limited to sub 5h runs") +
      theme_ipsum() +
      theme(legend.position = "top")
  }

Please note that the data on speedrun.com does not cover the whole history. There are lots of older runs missing here, and unless the mods come together und do some historic backlogging, that's as good as it gets for now.

We can also take a look at the recent developments:

library(lubridate)

tmp <- oot100 %>%
  filter(time_hms < hms::hms(hours = 4, minutes = 30),
         date >= today() - months(6)) %>%
  select(player_name, time_hms, date)

bind_rows(
  tmp,
  tmp %>%
    group_by(player_name) %>%
    summarize(time_hms = min(time_hms), date = today()) %>%
    ungroup
) %>%
  {
    ggplot(., aes(x = date, y = time_hms, 
                  color = player_name, fill = player_name)) +
      geom_point(size = 1, alpha = .75) +
      geom_step() +
      geom_label_repel(
        data = . %>% 
          group_by(player_name) %>%
          summarize(y = min(time_hms), x = max(date)),
        aes(label = player_name, x = x, y = y),
        color = "black", alpha = .75, show.legend = F,
        hjust = 1, direction = "y", nudge_x = 60^2
      ) +
      scale_x_date(date_breaks = "1 month", date_labels = "%b '%y",
                   limits = c(as.Date(NA), today() + days(45))) +
      scale_y_time(breaks = seq(0, 20 * 60^2,  1/12 * 60^2),
                   minor_breaks = seq(0, 20 * 60^2, 1/24 * 60)) +
      scale_color_viridis_d(
        direction = -1, guide = FALSE, aesthetics = c("color", "fill")
      ) +
      labs(title = "Ocarina of Time: 100% Speedruns",
           subtitle = "All runs of the past 6 months",
           caption = "Data from speedrun.com",
           x = "Date of Run", y = "Time (H:M:S)") +
      theme_ipsum(grid = "X") + theme(axis.text.x = element_text(hjust = 0))
  }