Mario Kart Dashboard Project Part 1

I was watching Youtube videos (as I am doing so often), and came across this video from a relatively small Mario Kart Youtuber named Bayesic. He describes in great detail how player stats in Mario Kart 8 Deluxe are calculated and used in game, and how to optimize a build and strategy through the lens of Pareto optimality. He builds a dashboard to optimize any given set of stats. I thought that was a great idea, and sounded like a good way to learn web scraping as well as a new (to me) shiny framework called shinydashboards.

To start with, let’s pull the tables from the internet. The website can be found here

I’ll be using the rvest package to translate the html into tables that can be saved into a feather.

library(rvest)

## Warning: package 'rvest' was built under R version 4.1.2

library(tidyverse)

## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --

## v ggplot2 3.3.5     v purrr   0.3.4
## v tibble  3.1.6     v dplyr   1.0.7
## v tidyr   1.2.0     v stringr 1.4.0
## v readr   2.1.2     v forcats 0.5.1

## Warning: package 'tibble' was built under R version 4.1.2

## Warning: package 'tidyr' was built under R version 4.1.2

## Warning: package 'readr' was built under R version 4.1.2

## Warning: package 'dplyr' was built under R version 4.1.2

## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter()         masks stats::filter()
## x readr::guess_encoding() masks rvest::guess_encoding()
## x dplyr::lag()            masks stats::lag()

library(janitor)

## 
## Attaching package: 'janitor'

## The following objects are masked from 'package:stats':
## 
##     chisq.test, fisher.test

library(feather)

## Warning: package 'feather' was built under R version 4.1.2

url <- "https://www.mariowiki.com/Mario_Kart_8_Deluxe_in-game_statistics"

kart_page <- read_html(url)

str(kart_page)

## List of 2
##  $ node:<externalptr> 
##  $ doc :<externalptr> 
##  - attr(*, "class")= chr [1:2] "xml_document" "xml_node"

The rvest package uses node syntax to describe what’s happening inside the html. To get deeper into the html, keep calling html_children

nodes <- kart_page %>%
        html_elements("body") %>%
        html_children()

nodes %>%
        html_children()

## {xml_nodeset (4)}
## [1] <div id="column-content">\n<div id="content" class="mw-body" role="main"> ...
## [2] <div id="column-one" lang="en" dir="ltr">\n<h2>Navigation menu</h2>\n<div ...
## [3] <div class="visualClear"></div>\n
## [4] <div id="footer" class="mw-footer" role="contentinfo" lang="en" dir="ltr" ...

The tables come out not very pretty. With some custom functions and lapply, we can change that.

kart_tables <- kart_page %>%
        html_table(fill = TRUE)

kart_tables1 <- kart_tables[c(2:10)]
kart_tables2 <- kart_tables[c(11:12)]

fix_names_1 <- function(x){
        new_x <- x %>%
                row_to_names(row_number = 1) %>%
                clean_names()
        
        dont <- names(new_x)[1]
        
        new_x <- new_x %>%
                mutate(across(!dont, as.numeric))
}

fix_names_2 <- function(x){
        new_x <- x %>%
                row_to_names(row_number = 2) %>%
                clean_names()
        
        dont <- names(new_x)[1]
        
        new_x <- new_x %>%
                mutate(across(!dont, as.numeric))
}

kart_tables_fixed1 <- lapply(kart_tables1, fix_names_1)

## Note: Using an external vector in selections is ambiguous.
## i Use `all_of(dont)` instead of `dont` to silence this message.
## i See <https://tidyselect.r-lib.org/reference/faq-external-vector.html>.
## This message is displayed once per session.

## Warning in mask$eval_all_mutate(quo): NAs introduced by coercion

## Warning in mask$eval_all_mutate(quo): NAs introduced by coercion

## Warning in mask$eval_all_mutate(quo): NAs introduced by coercion

## Warning in mask$eval_all_mutate(quo): NAs introduced by coercion

## Warning in mask$eval_all_mutate(quo): NAs introduced by coercion

## Warning in mask$eval_all_mutate(quo): NAs introduced by coercion

## Warning in mask$eval_all_mutate(quo): NAs introduced by coercion

## Warning in mask$eval_all_mutate(quo): NAs introduced by coercion

## Warning in mask$eval_all_mutate(quo): NAs introduced by coercion

## Warning in mask$eval_all_mutate(quo): NAs introduced by coercion

## Warning in mask$eval_all_mutate(quo): NAs introduced by coercion

## Warning in mask$eval_all_mutate(quo): NAs introduced by coercion

## Warning in mask$eval_all_mutate(quo): NAs introduced by coercion

## Warning in mask$eval_all_mutate(quo): NAs introduced by coercion

## Warning in mask$eval_all_mutate(quo): NAs introduced by coercion

## Warning in mask$eval_all_mutate(quo): NAs introduced by coercion

## Warning in mask$eval_all_mutate(quo): NAs introduced by coercion

## Warning in mask$eval_all_mutate(quo): NAs introduced by coercion

## Warning in mask$eval_all_mutate(quo): NAs introduced by coercion

## Warning in mask$eval_all_mutate(quo): NAs introduced by coercion

## Warning in mask$eval_all_mutate(quo): NAs introduced by coercion

## Warning in mask$eval_all_mutate(quo): NAs introduced by coercion

## Warning in row_to_names(., row_number = 1): Row 1 does not provide unique names.
## Consider running clean_names() after row_to_names().

kart_tables_fixed2 <- lapply(kart_tables2, fix_names_2)

## Warning in row_to_names(., row_number = 2): Row 2 does not provide unique names.
## Consider running clean_names() after row_to_names().

kart_tables_fixed <- append(kart_tables_fixed1, kart_tables_fixed2)

we can’t tibble a list, but we can tibble a dataframe from a list. They are then written to csv and feather, for data longetivity and for fastest loading speed.

karts <- as_tibble(as.data.frame(kart_tables_fixed[1]))
characters <- as_tibble(as.data.frame(kart_tables_fixed[2]))
tires <- as_tibble(as.data.frame(kart_tables_fixed[3]))
gliders <- as_tibble(as.data.frame(kart_tables_fixed[4]))
kart_mass <- as_tibble(as.data.frame(kart_tables_fixed[5]))
acceleration <- as_tibble(as.data.frame(kart_tables_fixed[6]))
slip <- as_tibble(as.data.frame(kart_tables_fixed[7]))
offroad_brake <- as_tibble(as.data.frame(kart_tables[9])) %>%
        slice(1:22) %>%
        row_to_names(row_number = 1) %>%
        clean_names()
        
offroad_slip <- as_tibble(as.data.frame(kart_tables[9])) %>%
        slice(23:45) %>%
        row_to_names(row_number = 1) %>%
        clean_names() 

boost <- as_tibble(as.data.frame(kart_tables_fixed[9]))
speed <- as_tibble(as.data.frame(kart_tables_fixed[10]))
handling <- as_tibble(as.data.frame(kart_tables_fixed[11]))


write_csv(karts, "karts.csv")
write_csv(characters, "characters.csv")
write_csv(tires, "tires.csv")
write_csv(gliders, "gliders.csv")
write_csv(kart_mass, "kart_mass.csv")
write_csv(acceleration, "acceleration.csv")
write_csv(slip, "slip.csv")
write_csv(offroad_brake, "offroad_brake.csv")
write_csv(offroad_slip, "offroad_slip.csv")
write_csv(boost, "boost.csv")
write_csv(speed, "speed.csv")
write_csv(handling, "handling.csv")



write_feather(karts, "karts.feather")
write_feather(characters, "characters.feather")
write_feather(tires, "tires.feather")
write_feather(gliders, "gliders.feather")
write_feather(kart_mass, "kart_mass.feather")
write_feather(acceleration, "acceleration.feather")
write_feather(slip, "slip.feather")
write_feather(offroad_brake, "offroad_brake.feather")
write_feather(offroad_slip, "offroad_slip.feather")
write_feather(boost, "boost.feather")
write_feather(speed, "speed.feather")
write_feather(handling, "handling.feather")

I’m posting this from the future.

The app can be found here.

The github repo can be found here.