Created
December 28, 2017 18:37
-
-
Save Stan125/976af7518668a02eb11a0cd6beff5355 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
### speedrun.com tinkering ### | |
## Libraries ## | |
library(jsonlite) | |
library(ggplot2) | |
library(dplyr) | |
library(lubridate) | |
library(data.table) | |
library(viridis) | |
## Other preliminary stuff ## | |
base_url <- "https://www.speedrun.com/api/v1" | |
## Functions ## | |
get_lb <- function(game_id, category, ntop = 5, date = Sys.Date()) { | |
base_link <- paste0(base_url, "/leaderboards/", game_id, "/category/", category, "?", | |
"top=", ntop, "&", | |
"date=", date) | |
result <- fromJSON(base_link)$data$runs | |
if (length(result) == 0) | |
return(NULL) | |
if (length(result) > 0) | |
result <- result %>% | |
flatten() %>% | |
select(place, run.id, run.game, run.players, run.category, run.date, run.submitted, | |
run.times.primary_t, run.system.platform, run.system.region) %>% | |
set_colnames(c("place", "run_id", "game", "player", "category", "date_run", | |
"date_submitted", "time", "platform", "region")) %>% | |
mutate(submitted = as_datetime(date_submitted)) %>% | |
cbind(., do.call(bind_rows, .$player)) %>% | |
select(-player, -rel, -uri) | |
# Handler for different name/id cases | |
if (!is.null(result$name)) | |
result %<>% rename(player_name = name) | |
else | |
result %<>% mutate(player_name = NA) | |
if (!is.null(result$id)) | |
result %<>% rename(player_id = id) | |
else | |
result %<>% mutate(player_id = NA) | |
return(result %>% as_tibble()) | |
} | |
get_user <- function(player_id, just_name = FALSE) { | |
base_link <- paste0(base_url, "/users/", player_id) | |
if (just_name) { | |
result <- fromJSON(base_link)$data$names$international | |
} | |
if (!just_name) { | |
result <- fromJSON(base_link) %>% | |
unlist() %>% | |
as.data.frame() %>% t() %>% as.data.frame() %>% | |
select(data.id:data.weblink, data.signup, data.location.country.names.international, | |
data.twitch.uri, data.twitter.uri) %>% | |
set_colnames(c("player_id", "full_name", "link", "signup", "origin", | |
"twitch_url", "twitter_url")) %>% | |
as_tibble() | |
} | |
return(result) | |
} | |
## Function tryout ## | |
# get_lb() | |
sev_stars <- "7dgrrxk4" | |
h120_stars <- "wkpoo02r" | |
smario <- "o1y9wo6q" | |
result_lb <- get_lb(smario, h120_stars, date = date) | |
# get_player() | |
ex_player <- "v814mkp8" | |
get_user(ex_player) | |
get_user(ex_player, just_name = TRUE) | |
## Get leaderboard for all days between 2004 and today ## | |
date_seq <- seq.Date(as.Date("2004-01-01"), Sys.Date(), by = 1) | |
lb_sm64 <- lapply(date_seq, FUN = function(x) { | |
cat(paste0(round(which(x == date_seq) / length(date_seq) * 100, 2), "%\n")) # progress | |
get_lb(smario, h120_stars, ntop = 1, date = x) # lb | |
}) | |
full_data <- as_tibble(do.call(rbind, lb_sm64)) | |
full_data_unique <- unique(full_data) | |
# Get player Names | |
full_data_unique %<>% | |
mutate(player_name = ifelse(is.na(player_name), | |
sapply(player_id, FUN = get_user, just_name = TRUE), | |
player_name)) %>% | |
mutate(player_name = as.factor(player_name)) | |
## Make time variable better ## | |
# Function to get all important variables from period | |
per_f <- function(time) | |
return(paste0(time@hour, | |
lubridate::minute(time), | |
lubridate::seconds(time), collapse = ":")) | |
f_data <- full_data_unique %>% | |
bind_rows(tibble(date_run = as.character(Sys.Date()), # Extra row for plot purposes | |
time = min(.[["time"]]))) %>% | |
mutate(time = as.period(dseconds(time))) %>% | |
mutate(time = paste0(time@hour, ":", lubridate::minute(time), ":", lubridate::second(time))) %>% | |
mutate(time = as.POSIXct(time, format = "%H:%M:%S")) %>% | |
mutate(date_run = as_datetime(date_run)) | |
# Make plot | |
sm64_plot <- ggplot(f_data, aes(x = date_run, y = time)) + | |
geom_step() + | |
geom_point(aes(color = player_name)) + | |
scale_colour_viridis(discrete = TRUE) + | |
geom_text(aes(label = player_name), angle = 45, hjust = -0.2, size = 3, | |
check_overlap = TRUE) + | |
scale_x_datetime(date_breaks = "1 year", date_labels = "%Y") + | |
scale_y_datetime(date_breaks = "10 min", date_labels = "%H:%M", | |
limits = as.POSIXct(c("01:30:00", "03:10:00"), format = "%H:%M:%S")) + | |
theme_bw() + | |
labs(x = "Years", y = "Time in Hours:Minutes", | |
title = "Speedrun World Records for Super Mario 64 (120 Stars) over the years", | |
subtitle = "Current WR held by cheese05") | |
sm64_plot$labels$colour <- "Player Name" | |
ggsave(file = "s64_plot.png", plot = sm64_plot, width = 20, | |
height = 10, units = "cm", dpi = 400, scale = 1.5) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment