Advertisement
Schw4rzR0tG0ld

UEFA CL Drawing Calculation 2014/15

Dec 13th, 2014
797
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. ## AUTHOR: Sebastian Schwarz (@Schw4rzR0tGold)
  2. ## LICENSE: MIT + Sebastian Schwarz
  3.  
  4. # Champions League Draw Calculation
  5. library(data.table)
  6. library(plyr)
  7. library(magrittr)
  8.  
  9. # INSERT DATA
  10. teams.colnames <- c("short", "name", "group",
  11.                     "position", "association")
  12.  
  13. teams <- rbind(
  14.   c("ATL", "Atletico Madrid", "A", 1, "ESP"),
  15.   c("JUV", "Juventus Turin", "A", 2, "ITA"),
  16.   c("REA", "Real Madrid", "B", 1, "ESP"),
  17.   c("BAS", "FC Basel", "B", 2, "SUI"),
  18.   c("ASM", "AS Monaco", "C", 1, "FRA"),
  19.   c("B04", "Bayer 04 Leverkusen", "C", 2, "GER"),
  20.   c("BVB", "Borussia Dortmund", "D", 1, "GER"),
  21.   c("FCA", "FC Arsenal", "D", 2, "ENG"),
  22.   c("BAY", "FC Bayern München", "E", 1, "GER"),
  23.   c("MAC", "Manchester City", "E", 2, "ENG"),
  24.   c("BAR", "FC Barcelona", "F", 1, "ESP"),
  25.   c("PSG", "Paris St. Germain", "F", 2, "FRA"),
  26.   c("CHL", "FC Chelsea", "G", 1, "ENG"),
  27.   c("S04", "FC Schalke 04", "G", 2, "GER"),
  28.   c("POR", "FC Porto", "H", 1, "POR"),
  29.   c("DON", "FC Shakthar Donetsk", "H", 2, "UKR")
  30. ) %>% data.table %>%
  31.   setnames(., teams.colnames)
  32.  
  33.  
  34. # GROUP FIRST AND SECOND
  35. teams.first <- teams[position == 1, ] %>%
  36.   setnames(., paste(teams.colnames, "first", sep = "."))
  37.  
  38. teams.second <- teams[position == 2, ] %>%
  39.   setnames(., paste(teams.colnames, "second", sep = "."))
  40.  
  41. # ALL PAIRS
  42. # cross join to calcualte all group first vs. group second draws (8x8 = 64)
  43. teams.cj <- setkey(teams.first[,c(k = 1, .SD)], k)[teams.second[, c(k = 1, .SD)],
  44.                                                    allow.cartesian=TRUE][,k:=NULL]
  45.  
  46. # set all other restrictions (49 pairs remain)
  47. teams.cj <- teams.cj[group.first != group.second &
  48.                        association.first != association.second, ]
  49.  
  50. # reduce table
  51. teams.cj <- teams.cj[, list(short.first, short.second)]
  52.  
  53. # ALL POSSIBILITIES
  54. # all group first teams
  55. short.firsts <- unique(teams.cj$short.first)
  56.  
  57. # Per Team (you might insert a lapply or loop here)
  58. teams.cj.1 <- teams.cj[short.first == short.firsts[1], c(k = 1, .SD)] %>%
  59.   setnames(., c("k", paste(colnames(teams.cj), 1, sep ="."))) %>% setkey(., k)
  60. teams.cj.2 <- teams.cj[short.first == short.firsts[2], c(k = 1, .SD)] %>%
  61.   setnames(., c("k", paste(colnames(teams.cj), 2, sep ="."))) %>% setkey(., k)
  62. teams.cj.3 <- teams.cj[short.first == short.firsts[3], c(k = 1, .SD)] %>%
  63.   setnames(., c("k", paste(colnames(teams.cj), 3, sep ="."))) %>% setkey(., k)
  64. teams.cj.4 <- teams.cj[short.first == short.firsts[4], c(k = 1, .SD)] %>%
  65.   setnames(., c("k", paste(colnames(teams.cj), 4, sep ="."))) %>% setkey(., k)
  66. teams.cj.5 <- teams.cj[short.first == short.firsts[5], c(k = 1, .SD)] %>%
  67.   setnames(., c("k", paste(colnames(teams.cj), 5, sep ="."))) %>% setkey(., k)
  68. teams.cj.6 <- teams.cj[short.first == short.firsts[6], c(k = 1, .SD)] %>%
  69.   setnames(., c("k", paste(colnames(teams.cj), 6, sep ="."))) %>% setkey(., k)
  70. teams.cj.7 <- teams.cj[short.first == short.firsts[7], c(k = 1, .SD)] %>%
  71.   setnames(., c("k", paste(colnames(teams.cj), 7, sep ="."))) %>% setkey(., k)
  72. teams.cj.8 <- teams.cj[short.first == short.firsts[8], c(k = 1, .SD)] %>%
  73.   setnames(., c("k", paste(colnames(teams.cj), 8, sep ="."))) %>% setkey(., k)
  74.  
  75. # cross join
  76. teams.cj.a <- teams.cj.1[
  77.   teams.cj.2, allow.cartesian=TRUE][
  78.     teams.cj.3, allow.cartesian=TRUE][
  79.       teams.cj.4, allow.cartesian=TRUE][
  80.         teams.cj.5, allow.cartesian=TRUE][
  81.           teams.cj.6, allow.cartesian=TRUE][
  82.             teams.cj.7, allow.cartesian=TRUE][
  83.               teams.cj.8, allow.cartesian=TRUE][,k:=NULL]
  84.  
  85. # remove impossible (i.e. all where one group second teams is selected twice)
  86. # (could be written more compactly, but this is very clear)
  87. pairs.all <- teams.cj.a[  !(short.second.1 == short.second.2) &
  88.                           !(short.second.1 == short.second.3) &
  89.                           !(short.second.1 == short.second.4) &
  90.                           !(short.second.1 == short.second.5) &
  91.                           !(short.second.1 == short.second.6) &
  92.                           !(short.second.1 == short.second.7) &
  93.                           !(short.second.1 == short.second.8) &
  94.                           !(short.second.2 == short.second.3) &
  95.                           !(short.second.2 == short.second.4) &
  96.                           !(short.second.2 == short.second.5) &
  97.                           !(short.second.2 == short.second.6) &
  98.                           !(short.second.2 == short.second.7) &
  99.                           !(short.second.2 == short.second.8) &
  100.                           !(short.second.3 == short.second.4) &
  101.                           !(short.second.3 == short.second.5) &
  102.                           !(short.second.3 == short.second.6) &
  103.                           !(short.second.3 == short.second.7) &
  104.                           !(short.second.3 == short.second.8) &
  105.                           !(short.second.4 == short.second.5) &
  106.                           !(short.second.4 == short.second.6) &
  107.                           !(short.second.4 == short.second.7) &
  108.                           !(short.second.4 == short.second.8) &
  109.                           !(short.second.5 == short.second.6) &
  110.                           !(short.second.5 == short.second.7) &
  111.                           !(short.second.5 == short.second.8) &
  112.                           !(short.second.6 == short.second.7) &
  113.                           !(short.second.6 == short.second.8) &
  114.                           !(short.second.7 == short.second.8)  ]
  115.  
  116. # reformat
  117. pairs.all <- as.matrix(pairs.all)
  118.  
  119. pairs.all <- paste(
  120.   paste(pairs.all[, 1], pairs.all[, 2], sep = "-"),
  121.   paste(pairs.all[, 3], pairs.all[, 4], sep = "-"),
  122.   paste(pairs.all[, 5], pairs.all[, 6], sep = "-"),
  123.   paste(pairs.all[, 7], pairs.all[, 8], sep = "-"),
  124.   paste(pairs.all[, 9], pairs.all[, 10], sep = "-"),
  125.   paste(pairs.all[, 11], pairs.all[, 12], sep = "-"),
  126.   paste(pairs.all[, 13], pairs.all[, 14], sep = "-"),
  127.   paste(pairs.all[, 15], pairs.all[, 16], sep = "-"),
  128.   sep = ",")
  129.  
  130. # example: calculate probability of FC Bayern vs. FC Basel
  131. length(grep("BAY-BAS", pairs.all)) / length(pairs.all)
  132.  
  133. # save to file
  134. write.table(pairs.all, file = "all_cl_draws.csv", col.names = FALSE,
  135.             row.names = TRUE, sep = ";")
  136.  
  137. # yes it is overly vebose... but i think also very clear
Advertisement
RAW Paste Data Copied
Advertisement