tests/testthat/test-pooling.R

In coalitions: Bayesian "Now-Cast" Estimation of Event Probabilities in Multi-Party Democracies

context("Test pooling")
test_that("Pooling works as expected", {

  pooled <- .survey_sample %>%
    pool_surveys(last_date = max(tidyr::unnest(.survey_sample, "surveys")$date))

  expect_data_frame(pooled, nrow=7, ncol=8)
  expect_equal(sum(pooled$percent), 100)
  expect_equal(round(sum(pooled$votes)), 3055)

  pool <- pooled %>% tidyr::nest(survey = party:votes)
  pool <- pool %>% get_probabilities(., nsim=10) %>% unnest(probabilities)
  expect_data_frame(pool, nrow=6, ncol=4)
  expect_subset(colnames(pool), c("pollster", "date", "coalition",
    "probability"))

  ## test that duplicated percentages don't break pool_surveys
  s1          <- .survey_sample %>% unnest(surveys) %>% slice(1) %>% unnest(survey)
  s1$percent  <- c(34, 34, 8.5, 8, 4.5, 8, 3)
  s1$votes    <- s1$percent * 1421/100
  s2          <- s1
  s2$pollster <- "emnid"
  s2$date     <- as.Date("2016-08-22")
  s12         <- bind_rows(s1, s2) %>%
    nest(survey = party:votes) %>%
    nest(surveys = -pollster)
  pool <- pool_surveys(s12, last_date=as.Date("2017-08-22"))
  expect_data_frame(pool, nrow=7, ncol=8)

})