In LueBecko/juggerdata: A package containing all the datasets from the juggerdata project for reuseability and a number of helpful functions

knitr::opts_chunk$set(echo = TRUE)
knitr::opts_chunk$set(fig.width=7, fig.height=6, fig.align = "center")

Introduction

Starting with the release of the packages version 1.1. it comes bundled with a set of functions for reading and including data sets from the nearly ancient software - written by Bunny in 2008 and used in a handful of tournaments. While the Swiss tournament system never gained a high popularity among jugger players and organizers it is sound and safe to apply for a tournament - the resulting rankings are valid, the matchmaking is plausible - until a certain degree of convergence is reached - and the software makes the math behind it manageable.

This vignette highlights the process of reading a tournament file produced by the program and transforming it into the packages result format. The sample tournament data was generated in a real tournament - the first Hanseatic Jugger Cup in 2013. In this tournament 14 teams - one of the as a mix-team which is omitted in the final published ranking - played six full rounds of the Swiss system, seven games per round, on three fields. Afterwards the top 4 teams played a fully balanced ranking tree for the top 4 places ending in a big finale between GAG and Die leere Menge. The final ranking of all participating teams can be found in the JTR (LINK) or within this package.

Reading tournament data

The function readSwissTournament and accompanying summary and print functions come with the package juggerdata.

library(tidyverse)
library(juggerdata)

# note: the data-file can be named arbitrarily, since the program does not enforce any file endings
HanseaticJuggerCup2013 <- readSwissTournament("HanseaticJuggerCupR6") # R6 stands for round 6

summary(HanseaticJuggerCup2013)


ggplot(HanseaticJuggerCup2013$rounds %>%
         union_all(HanseaticJuggerCup2013$rounds %>%
                     rename(entryId1 = entryId2, entryId2 = entryId1, points1 = points2, points2 = points1)) %>%
         mutate(status = factor(x = sign(points2 - points1), labels = c("Team1", "Draw", "Team2"))),
       aes(x = entryId1, y = entryId2, fill = status)) +
  geom_raster() +
  scale_x_continuous("Team1", breaks = HanseaticJuggerCup2013$teams$entryId, minor_breaks = NULL, labels = HanseaticJuggerCup2013$teams$teamName) + #, limits = c(1,nrow(HanseaticJuggerCup2013$teams))
  scale_y_continuous("Team2", breaks = HanseaticJuggerCup2013$teams$entryId, minor_breaks = NULL, labels = HanseaticJuggerCup2013$teams$teamName) + #, limits = c(1,nrow(HanseaticJuggerCup2013$teams))
  scale_fill_discrete("Winner", h = c(40,200), l = 50) +
  ggtitle("1. Hanseatic Jugger Cup, 2013", "games played and won") +
  theme_minimal() + theme(plot.title = element_text(hjust = 0.3),
                          plot.subtitle = element_text(hjust = 0.3),
                          axis.text.x = element_text(angle = -90, vjust = 0.5))

If you read the above team names you might wonder if there is an error in the reader, but this is actually the content of the file. Back in 2013 the teams were entered into the tournament software a day before. But due to some forgotten reasons the first carefully and correctly written file was lost and so the operator of the software (if you wonder: it was me.) had to retype and setup everything within a few minutes before the first games started and thus in a wild typing frenzy teams like GÄG and Kmikze Eulen were born. For historical accuracy those names are documented here, but in the process of preparing this data set will be replaced by the correct names.

As can be seen in the visualized game matrix above a lot of various games where played within the tournament - 6 rounds for 14 teams is only 7 open games left for each team. This could be enough to generate a reasonable ranking, since some clear structures are visible within the data - e.g. GAG and Die Leere Menge won every game except when they played each other. Let's see about that.

Visualising rankings

The above functions also compute all intermediate rankings, which can be visualized with some ggplot-magic.

library(directlabels)

HanseaticJuggerCup2013Summary <- summary(HanseaticJuggerCup2013)

ggplot(HanseaticJuggerCup2013Summary$rankings %>%
         left_join(HanseaticJuggerCup2013Summary$teams, by = "entryId"),
       aes(x = round, y = rank, color = teamName, group = teamName)) +
  geom_line() +
  geom_dl(aes(label = teamName), method = list(dl.combine("first.points", "last.points"), cex = 0.8)) +
  scale_x_continuous("Swiss tournament rounds", breaks = 1:6, minor_breaks = NULL, labels = paste('R', 1:6, sep = ''), limits = c(0,7)) +
  scale_y_continuous("Swiss rank", breaks = 1:14, minor_breaks = NULL, trans = "reverse", position = "right") +
  scale_color_discrete(h = c(0,240), l = 50, guide = FALSE) +
  ggtitle("1. Hanseatic Jugger Cup, 2013", "rankings over all swiss system rounds") +
  theme_minimal() + theme(panel.grid.major.y = element_blank(),
                          plot.title = element_text(hjust = 0.3),
                          plot.subtitle = element_text(hjust = 0.3))

From the above visualization one might get the intuition that changes in the ranking are bigger in the beginning than in the end - or in other words that the ranking converges towards a finale stable ranking of teams. And this is actually the prime motivation to employ a Swiss system for your tournament - getting a stable and plausible ranking after a considerable amount of rounds/games. So lets visualize those changes.

changeData <- HanseaticJuggerCup2013Summary$rankings %>% 
  group_by(entryId) %>%
  arrange(round) %>%
  mutate(round = as.factor(round),
        'total rank changes' = lag(rank, 1) - rank,
        'absolute rank changes' = abs(lag(rank, 1) - rank)) %>%
  filter(round != 1) %>% select(-rank, -opp, -scoreCum, -pointsCum, -pointsDiffCum, -BHZ) %>%
  gather("rankChangeTyp", "Value", -entryId, -round)

ggplot(changeData,
       aes(x = round, y = Value, color = as.factor(1), fill = as.factor(1))) +
  facet_wrap(~rankChangeTyp, scales = "free", ncol = 1) +
  geom_boxplot() +
  scale_x_discrete("Swiss tournament rounds transition", labels = paste('R', 1:5, '-R', 2:6, sep = '')) +
  scale_y_continuous("Swiss rank change", breaks = -5:5, minor_breaks = NULL, position = "left") +
  scale_color_discrete(h = c(100,140), l = 50, guide = FALSE) +
  scale_fill_discrete(h = c(100,140), l = 75, c = 100, guide = FALSE) +
  ggtitle("1. Hanseatic Jugger Cup, 2013", "rank changes swiss system rounds") +
  theme_minimal() + theme(panel.grid.major.y = element_blank(),
                          plot.title = element_text(hjust = 0.3),
                          plot.subtitle = element_text(hjust = 0.3))

This looks like the intuition holds... But it would be wrong to not do some thorough testing. The hypotheses tested are a) absolute rank changes decreases with increasing rounds and b) the variance of total rank changes decreases with increasing rounds.

testData <- changeData %>% ungroup() %>% filter(rankChangeTyp == "absolute rank changes") %>% select(entryId, round, Value) %>%
  spread(round, Value) %>% select(-entryId)

indices <- expand.grid(round1 = 1:ncol(testData), round2 = 1:ncol(testData))
testResultsA <- cbind(indices,
                      t(mapply(function(i1,i2) { broom::tidy(wilcox.test(x = as.numeric(testData[[i1]]),
                                                                         y = as.numeric(testData[[i2]]),
                                                                         alternative = "less")) }, indices[[1]], indices[[2]])[1:2,]))
testResultsA <- testResultsA %>% mutate(statistic = unlist(statistic), p.value = unlist(p.value))
# knitr::kable(testResultsA)
ggplot(testResultsA %>% mutate(sigLabel = if_else(p.value < 0.05, '*', '')),
       aes(x = as.factor(round1), y = as.factor(round2), fill = p.value, label = sigLabel)) +
  geom_raster() + geom_text() +
  scale_x_discrete("round transition", labels = paste('R', 1:5, '-R', 2:6, sep = '')) +
  scale_y_discrete("round transition", labels = paste('R', 1:5, '-R', 2:6, sep = '')) +
  scale_fill_continuous(name = "p") +
  ggtitle("1. Hanseastic Jugger Cup, 2013", "wilcoxon test results (one-sided)") +
  theme_minimal() + theme(panel.grid.major.y = element_blank(), panel.grid.major.x = element_blank(),
                          plot.title = element_text(hjust = 0.3),
                          plot.subtitle = element_text(hjust = 0.3))

The above table and graph highlight that later round are indeed significantly more likely to experience smaller absolute changes than the earlier rounds. So hypothesis A seems to be true. Interestingly there seems to be a switch in the last round - a not significant increase in absolute changes. This could be read as a sign that convergence was reached, but more on that later.

Now to the second hypotheses: Variance decreases from round to round.

Usually to test if two distributions are different based don't heir variance one would use a F-test (or in R var.test). But This is only applicable on normal data, which this data is not. The natural test for situations like this is the leveneTest from the package car.

testData <- changeData %>% ungroup() %>% filter(rankChangeTyp == "total rank changes") %>% select(round, Value)

indices <- expand.grid(round1 = unique(testData$round), round2 = unique(testData$round))
testResultsB <- cbind(indices,
                      t(mapply(function(i1,i2) { if (i1 == i2) return(data_frame(statistic = NA, p.value = NA, variance = var(testData %>% filter(round == i1))[2,2])) else cbind(broom::tidy(car::leveneTest(Value ~ round, testData %>% filter(round %in% c(i1,i2))))[1,3:4], variance = NA) }, indices[[1]], indices[[2]])))
testResultsB <- testResultsB %>% mutate(statistic = unlist(statistic), p.value = unlist(p.value), variance = unlist(variance))

ggplot(testResultsB %>% mutate(varianceLabel = if_else(is.na(variance), if_else(p.value < 0.05, '*', ''), paste("var = ", format(variance, digits = 3)) )),
       aes(x = as.factor(round1), y = as.factor(round2), fill = p.value, label = varianceLabel)) +
  geom_raster() + geom_text() +
  scale_x_discrete("round transition", labels = paste('R', 1:5, '-R', 2:6, sep = '')) +
  scale_y_discrete("round transition", labels = paste('R', 1:5, '-R', 2:6, sep = '')) +
  scale_fill_continuous(name = "p", na.value = "white") +
  ggtitle("1. Hanseastic Jugger Cup, 2013", "Levene test results") +
  theme_minimal() + theme(panel.grid.major.y = element_blank(), panel.grid.major.x = element_blank(),
                          plot.title = element_text(hjust = 0.3),
                          plot.subtitle = element_text(hjust = 0.3))

The numbers in the diagonal are the variances and it is clear that they are monotonically decreasing over all rounds. Further the p-values of the levene tests indicate that changes in the last three rounds significantly differ from the changes between the first two rounds - with Bonferroni correction for multiple comparison only R1-R2 to R4-R5 remains significant (F = 8.275, p = 0.008). Given the small number of rounds and games per round this result is only a weak support for the second hypothesis.

Stability of rankings

If we accept that the above two hypotheses hold and that enough rounds are played we would see stable rankings of all participating teams. Kendall's tau is a prime indicator of similarity between rank lists, so lets look at a tau-map of the rankings of this single tournament.

rankTaus <- cor(HanseaticJuggerCup2013Summary$rankings %>% select(round, entryId, rank) %>%
                  spread(round, rank) %>% select(-entryId), method = "kendall")

# ggplot(rankTaus %>% as.data.frame() %>% rownames_to_column("round1") %>% gather("round2", "tau", -round1),
#       aes(x = round1, y = round2, fill = tau)) +
#   geom_raster() +
#   scale_x_discrete("round", labels = paste('R', 1:6, sep = '')) +
#   scale_y_discrete("round", labels = paste('R', 1:6, sep = '')) +
#   scale_fill_continuous(name = "tau", na.value = "white") +
#   ggtitle("1. Hanseastic Jugger Cup, 2013", "Kendall's tau between each round") +
#   theme_minimal() + theme(panel.grid.major.y = element_blank(), panel.grid.major.x = element_blank(),
#                           plot.title = element_text(hjust = 0.3),
#                           plot.subtitle = element_text(hjust = 0.3))

ggplot(data_frame(tau = rankTaus[row(rankTaus) - col(rankTaus) == 1], round = 1:5),
      aes(x = round, y = tau, color = tau)) +
  geom_step() +
  scale_x_continuous("round transition", labels = paste('R', 1:5, '-R', 2:6, sep = '')) +
  scale_y_continuous("tau") +
  scale_fill_continuous(name = "tau", na.value = "white") +
  ggtitle("1. Hanseastic Jugger Cup, 2013", "Kendall's tau between consecutive rounds") +
  theme_minimal() + theme(panel.grid.major.y = element_blank(), panel.grid.major.x = element_blank(),
                          plot.title = element_text(hjust = 0.3),
                          plot.subtitle = element_text(hjust = 0.3))

The tau between the rounds increases and seems to level after round 5 - just what one expects from a converging process. But to determine the conditions of this convergence will be part of another analysis.

Preparing the data for juggerdata

The aim of the package juggerdata is to share such jugger game data as above. This data can easily be included in the package if processed the right way - as will be highlighted in this section.

LueBecko/juggerdata documentation built on May 20, 2019, 4:07 p.m.