Calculating the Qwerty Quotient

First load some libraries:

library(dplyr) # data manipulation
library(xml2) # xml parsing
library(purrr) # data manipulation
library(lubridate) # date formatting
library(ggplot2) # plotting
library(tidyr) # data manipulation
library(readr) # data input/output

Set up a function to read one page of user plays from the XML API and parse it into a data frame.

read_page <- function(pagenum, username){
  Sys.sleep(2) # time delay to play nice with BGG
  # create URL from username and page number
  page_string <- paste0('https://www.boardgamegeek.com/xmlapi2/plays?username=',
                        username,
                        '&page=',
                        pagenum)
  
  plays <- read_xml(page_string) # read the XML
  
  # now parse the required fields from the XML
  date <- plays %>% xml_find_all('//play') %>% xml_attr('date') %>% as.Date()
  quantity <- plays %>% xml_find_all('//play') %>% xml_attr('quantity') %>% as.integer()
  id <- plays %>% xml_find_all('//play/item') %>% xml_attr('objectid')
  name <- plays %>% xml_find_all('//play/item') %>% xml_attr('name')
  
  # and put them in a data frame to return
  data_frame(date, quantity, id, name)
}

Now get the first page in order to determine how many total pages there are for the user, and then call the read_page function for each of those pages. Takes a while!

username <- 'qwertymartin' # set target username here
page_string <- paste0('https://www.boardgamegeek.com/xmlapi2/plays?username=', username)
# get total plays and convert to total number of pages to retrieve
tot_plays <- read_xml(page_string) %>% xml_attr('total') %>% as.integer()
pages <- ceiling(tot_plays / 100)
#read all plays pages into one data frame using purrr::map_df to iterate
plays_df <- map_df(1:pages, read_page, username)

Do some tidying up - get rid of plays with ‘weird’ dates or quantities of zero. Then calculate the running total of plays for each game (cum_play) and the sum (normal and log) of the running totals where more than one play logged in the same item.

plays_df <- plays_df %>%
  arrange(date) %>% # sort by date
  filter(date > '2000-01-01', quantity > 0) %>% # get rid of weird items
  group_by(id) %>% 
  mutate(cum_play = cumsum(quantity)) %>% # find running total per game
  ungroup() %>%
  mutate(sum_play = quantity * (2 * cum_play - quantity + 1) / 2, # sum of running total
         sum_log = map2_dbl(cum_play, quantity, ~sum(log(seq(.x, .x+1-.y, -1))))) 
         # sum of running total of logs
plays_df

Now calculate means over monthly periods. You can change ‘month’ to ‘week’/‘quarter’/‘year’ if desired.

qq_df <- plays_df %>%
  group_by(month = floor_date(date, "month")) %>%
  summarise(qq = mean(sum_play),
            logqq = exp(sum(sum_log)/sum(quantity))) %>%
  ungroup()
qq_df

And finally plot the results. The normal and log measures are separated out in to separate rows as this is easier for ggplot.

qq_df %>%
  gather(measure, value, -month) %>% # make separate rows for normal and log qq
  filter(measure == 'logqq') %>% # only plot log 
  ggplot(aes(x = month, y = value, color = measure)) +
  geom_point() +
  theme_minimal() +
  theme(legend.position = 'none') +
  labs (x = 'date', y = 'log-qq')