In benjaminguinaudeau/pairwiseR: What the Package Does (One Line, Title Case)

knitr::opts_chunk$set(echo = TRUE)

pacman::p_load(tidyverse, RSQLite, DBI, pairwiseR)
con <- dbConnect(SQLite(), "data/mp.db")
user <- "test_1"
par <- 3


com <- con %>%
  tbl("com") %>%
  filter(user != "benjamin") %>%
  collect()

DBI::dbWriteTable(con, "com", com, overwrite = T)
con <- pairwiseR::init_db(user = "benjamin", path = "data/mp.db")

dk <- con %>%
  tbl("dk") %>%
  filter(user != "benjamin") %>%
  collect()

DBI::dbWriteTable(con, "dk", dk, overwrite = T)
con <- pairwiseR::init_db(user = "benjamin", path = "data/mp.db")


already <- tibble(
  user = "benjamin", 
  pageid_1 = c(47, 48, 49, 46, 47, 48), 
  pageid_2 = c(46, 47, 48, 47, 48, 49), 
  more_left = c(-1, -1, -1, 1, 1, 1)
)
con %>% remove_last_action("benjamin")
con %>%
  get_already("benjamin") %>%
  arrange(-time)

already %>%
  arrange(time)
  count(type)

True Data

already <- con %>%
  dplyr::tbl("com") %>%
  dplyr::collect(.) %>%
  dplyr::filter(user == {{user}}) %>%
  dplyr::filter(party == {{party}})

get_analytically_solved(already, quiet = T, par = 2)

pair_mp <- get_pair_matrix(n_mp = 300)
pageid <- unique(pair_mp$pageid_1)

res <- 0:5 %>%
  map(~{
    message(.x)
    target <- pageid %>%
      sample_frac(.7) %>%
      simule_ranking()

    already <- target %>%
      sample_n(1)

    step <- 1
    while(nrow(already) != nrow(target)){
      utils::flush.console()
      cat("\rStep: ", step)
      new_pair <- pair_mp %>%
        dplyr::anti_join(already, by = c("pageid_1", "pageid_2")) %>%
        dplyr::sample_n(min(5, nrow(.)))
      if(nrow(new_pair) == 0){break}

      answer <- new_pair %>%
        select(contains("pageid")) %>%
        left_join(target, by = c("pageid_1", "pageid_2"))

      out <- tibble(pageid_1 = answer$pageid_2, 
                    pageid_2 = answer$pageid_1, 
                    more_left = -answer$more_left) %>%
        bind_rows(answer) %>%
        mutate(step = !!step)

      already <- bind_rows(already, out)
      solved <- get_analytically_solved(already, quiet = F, par = .x) %>%
        mutate(step = !!step)
      already <- bind_rows(already, solved) %>%
        distinct(pageid_1, pageid_2, .keep_all = T) 

      message(nrow(already), " were solved in total")
      step <- step + 1
    }
    return(already)
  })

max_step <- res %>%
  map_dbl(~{
    max(.x$step, na.rm = T)
  })

tibble(par = 0:10, max_step)

already %>%
  count(step) %>%
  filter(step != 50) %>%
  ggplot(aes(x = step, y = n)) + geom_line()

# analytically_solved <- function(pageid_1, pageid_2, par, already){
#   a <- already %>% filter(pageid_1 == .x$pageid_1)
#   b <- already %>% filter(pageid_1 == .x$pageid_2)
#   
#   left_a <- a %>%
#     filter(more_left == 1) %>%
#     pull(pageid_2)
#   
#   right_a <- a %>%
#     filter(more_left == -1) %>%
#     pull(pageid_2)
#   
#   left_b <- b %>%
#     filter(more_left == 1) %>%
#     pull(pageid_2)
#   
#   right_b <- b %>%
#     filter(more_left == -1) %>%
#     pull(pageid_2)
#   
#   out <- length(intersect(left_a, right_b)) > par | length(intersect(left_b, right_a)) > par
#   
#   return(out)
# }