R と GridDB を用いた Swisslos (スイスロト) の解析

$ git clone https://github.com/retowyss/swisslos-r-griddb.git 

# Required packages RJDBC and tidyverse 
# griddb is the connection object to our GridDB

drv <- JDBC(
  driverClass = "com.toshiba.mwcloud.gs.sql.Driver",
  # Point this to your gridstore jar
  classPath = "/jdbc/bin/gridstore-jdbc.jar"
)

# IP and port depend on your setup
griddb <- dbConnect(
  drv, 
  "jdbc:gs://172.20.0.42:20001/dockerGridDB/public", 
  "admin", 
  "admin"
)

# vectorized insert function
dbInsertTable <- function(conn, name, df, append = TRUE) {
  for (i in seq_len(nrow(df))) {
    dbWriteTable(conn, name, df[i, ], append = append)
  }
}

dbSendUpdate(griddb, paste(
  "CREATE TABLE IF NOT EXISTS swisslos_jackpots", 
  "(date STRING, jackpot INTEGER);"
))
dbInsertTable(griddb, "swisslos_jackpots", read_csv("data/swisslos_jackpots.csv"))


dbSendUpdate(griddb, paste(
  "CREATE TABLE IF NOT EXISTS swisslos_payouts", 
  "(combination STRING, winners INTEGER, prize FLOAT, date STRING);"
))
dbInsertTable(griddb, "swisslos_payouts", read_csv("data/swisslos_payouts.csv"))


dbSendUpdate(griddb, paste(
  "CREATE TABLE IF NOT EXISTS swisslos_numbers", 
  "(type STRING, number INTEGER, date STRING);"  
))
dbInsertTable(griddb, "swisslos_numbers", read_csv("data/swisslos_numbers.csv"))

dbListTables(griddb)

# stringr::str_interp is a handy function to parameterize SQL queries from R
# just be careful; SQL injections happen.
show_date <- function(conn, table, date = "2013-02-13") {
  dbGetQuery(conn, str_interp("SELECT * FROM ${table} WHERE date = '${date}';"))
} 

#only show swisslos_ tables
map(keep(dbListTables(griddb), ~ str_detect(., "swisslos_")), ~ show_date(griddb, .))

regular_numbers <- 42
regular_draws   <- 6
lucky_numbers   <- 6
lucky_draws     <- 1

# Binomial coefficient function
# Bin(a, b)
bin <- function(a, b) {
  map2_dbl(a, b, function(.a, .b) {
    if (.b == 0 | .a == .b) {
      1
    } else {
      .c <- .a - .b + 1
      prod(.c:.a) / prod(1:.b)
    }
  })
}

# 42 choose 6
swisslos_regular_combos <- bin(regular_numbers, regular_draws)

# probability to get n correct
swisslos_prob <- function(n) {
  n_match <- bin(regular_draws, n)
  n_miss <-  bin(regular_numbers - regular_draws, regular_draws - n)
  n_miss * n_match  / swisslos_regular_combos
} 

# We can check correctness with sum(swisslos_prob(0:6)) == 1, which yield true

tibble(n_correct = 0:6) %>% 
  mutate(
    prob_base  = swisslos_prob(n_correct),
    prob_lucky = prob_base / 6,
    prob_not_lucky = prob_base - prob_lucky
  ) %>% 
  knitr::kable(digits = 8)

# To retrieve the data from GridDB we type a SQL query
# Computing the result with SQL makes it unnecessary to pull the entire table
# into R

# paste makes it easy to type long SQL and break it up into multiple lines

# we make n a parameter because you could use 4 instead of 3 but 3 gets greater
# counts so we will stick with that
get_n_correct <- function(conn, n) {
  q <- paste(
    "SELECT SUM(winners) AS winners, date",
    "FROM swisslos_payouts",
    "WHERE combination = '${n}'  OR combination = '${n} + 1'",
    "GROUP BY date",
    "ORDER BY date;"
  )
  dbGetQuery(conn, str_interp(q))
}
  
three_correct <- get_n_correct(griddb, 3) %>% 
  mutate(tickets_played = winners / swisslos_prob(3)) %>% 
  as_tibble()
  
three_correct %>% head(5)

three_correct %>% 
  ggplot(aes(x = lubridate::as_date(date), y = tickets_played)) + 
  geom_col()

# You can test your SQL here, but because we need to get the entire 
# swisslos_jackpots table, we might just as well join it in R
three_correct_jp <- three_correct %>% 
  left_join(dbGetQuery(griddb, "SELECT * FROM swisslos_jackpots;"), by = "date")

three_correct_jp %>% 
  ggplot(aes(x = tickets_played, y = jackpot)) +
  geom_point()

cor.test(three_correct_jp$tickets_played, three_correct_jp$jackpot)

# Again, when writing straight SQL which is required for GridDB at the moment,
# we want to make it as easy as possible for ourselves.
# break SQL down into easy to understand snippets and combine
# I think it's a good idea to avoid nested str_interp and only use them 
# for R computation
get_n_lucky <- function(conn, n) {
  # Add lucky and regular winners for n
  q_combined_counts <- paste(
    "SELECT SUM(winners) AS winners, date",
    "FROM swisslos_payouts",
    "WHERE combination = '${n}' OR combination = '${n} + 1'",
    "GROUP BY date"
  )
  
  # Only get lucky 
  q_lucky_counts <- paste(
    "SELECT winners AS lucky, date",
    "FROM swisslos_payouts",
    "WHERE combination = '${n} + 1'"
  )
  
  # Combine lucky and regular counts
  q_lucky_and_regular_counts <- paste(
    "SELECT a.winners AS winners_count, b.lucky AS lucky_count, a.date AS date",
    "FROM (", q_combined_counts, ") a",
    "LEFT JOIN (", q_lucky_counts, ") b",
    "ON a.date = b.date",
    "ORDER BY a.date"
  )
  
  # Retrive lucky numbers
  q_lucky_numbers <- paste(
    "SELECT number AS lucky_number, date AS date",
    "FROM swisslos_numbers",
    "WHERE type = 'lucky'"
  )

  # Build the final query  
  q_final <- paste(
    "SELECT winners_count, lucky_count, lucky_number, c.date AS date",
    "FROM (", q_lucky_and_regular_counts, ") c",
    "LEFT JOIN (", q_lucky_numbers, ") d",
    "ON c.date = d.date"
  )
  
  # Print the query if you want to know why building it up this way makes
  # a lot of sense
  
  dbGetQuery(conn, str_interp(q_final))
}

lucky_counts <- get_n_lucky(griddb, 3) %>% 
  mutate(lucky_p = lucky_count / winners_count)

head(lucky_counts, n = 5)

lucky_counts %>% 
  ggplot(aes(x = factor(lucky_number), y = lucky_p, group = lucky_number)) + 
  geom_boxplot() +
  geom_hline(yintercept = 1/6)

# We can do all of this directly on our GridDB
# After we calculate the bias using the empirical frequencies and our
# swisslos_prob function, we combine the table with the numbers table and
# then we calculate the average bias for each number
get_3_and_4 <- function(conn) {
  # Three correct
  q_3 <- paste(
    "SELECT SUM(winners) AS w_3, date",
    "FROM swisslos_payouts",
    "WHERE combination = '3' OR combination = '3 + 1'",
    "GROUP BY date"
  )
  
  # Four correct
  q_4 <- paste(
    "SELECT SUM(winners) AS w_4, date",
    "FROM swisslos_payouts",
    "WHERE combination = '4' OR combination = '4 + 1'",
    "GROUP BY date"
  )
  
  # Combine the three counts and four counts tables
  q_w <- paste(
    "SELECT w_3, w_4, c.date AS date",
    "FROM (", q_3, ") c",
    "LEFT JOIN (", q_4, ") d",
    "ON c.date = d.date"
  )
  
  q_numbers <- paste(
    "SELECT number, date",
    "FROM swisslos_numbers",
    "WHERE type = 'normal'"
  )
  
  q_combine <- paste(
    "SELECT w_3 / w_4 - ${swisslos_prob(3) / swisslos_prob(4)} AS bias,",
    "number, a.date AS date",
    "FROM (", q_w, ") a",
    "LEFT JOIN (", q_numbers, ") b",
    "ON a.date = b.date"
  )
  
  q_final <- paste(
    "SELECT number, AVG(bias) AS bias",
    "FROM (", q_combine, ") e",
    "GROUP BY number"
  )
  
  dbGetQuery(conn, str_interp(q_final))
}

hacky <- get_3_and_4(griddb)
head(hacky)

# Centering and negating bias to make it look prettier
ggplot(hacky, aes(x = factor(number), y = -(bias - mean(bias)), fill = -bias)) + geom_col() +
  scale_fill_viridis_c() +
  theme(legend.position = "none")

dbDisconnect(griddb)