test-pool_draws.R
In rvec: Vectors Representing Random Variables

## 'pool_draws' ---------------------------------------------------------

test_that("'pool_draws' works with one by variable", {
  df <- data.frame(a = c(1, 1, 1, 2, 2, 2),
                   x = rvec(1:6),
                   y = rvec(matrix(1:12, nr = 6)))
  ans_obtained <- pool_draws(df, by = a)
  ans_expected <- tibble::tibble(a = c(1, 2),
                                 x = rvec(rbind(1:3, 4:6)),
                                 y = rvec(rbind(c(1:3, 7:9),
                                                c(4:6, 10:12))))
  expect_identical(ans_obtained, ans_expected)
})

test_that("'pool_draws' works with one grouping variable", {
  df <- data.frame(a = c(1, 1, 1, 2, 2, 2),
                   x = rvec(1:6),
                   y = rvec(matrix(1:12, nr = 6))) |>
    dplyr::group_by(a)
  ans_obtained <- pool_draws(df)
  ans_expected <- tibble::tibble(a = c(1, 2),
                                 x = rvec(rbind(1:3, 4:6)),
                                 y = rvec(rbind(c(1:3, 7:9),
                                                c(4:6, 10:12))))
  expect_identical(ans_obtained, ans_expected)
})

test_that("'pool_draws_inner' works with two by variables", {
  df <- data.frame(a = c(1, 1, 1, 2, 2, 2),
                   b = c(1:3, 1:3),
                   x = rvec(1:6),
                   y = rvec(matrix(1:12, nr = 6)))
  ans_obtained <- pool_draws(df, by = c(a, b))
  ans_expected <- tibble::tibble(df)
  expect_identical(ans_obtained, ans_expected)
})

test_that("'pool_draws_inner' works with two by grouping", {
  df <- data.frame(a = c(1, 1, 1, 2, 2, 2),
                   b = c(1:3, 1:3),
                   x = rvec(1:6),
                   y = rvec(matrix(1:12, nr = 6)))
  dfg <- df |>
    dplyr::group_by(a,b)
  ans_obtained <- pool_draws(dfg)
  ans_expected <- tibble::tibble(df)
  expect_identical(ans_obtained, ans_expected)
})


## 'pool_draws_inner' ---------------------------------------------------------

test_that("'pool_draws_inner' works with one by variable", {
  df <- data.frame(a = c(1, 1, 1, 2, 2, 2),
                   x = rvec(1:6),
                   y = rvec(matrix(1:12, nr = 6)))
  ans_obtained <- pool_draws_inner(df,
                                   by_colnums = c(a = 1L),
                                   groups_colnums = integer())
  ans_expected <- tibble::tibble(a = c(1, 2),
                                 x = rvec(rbind(1:3, 4:6)),
                                 y = rvec(rbind(c(1:3, 7:9),
                                                c(4:6, 10:12))))
  expect_identical(ans_obtained, ans_expected)
})

test_that("'pool_draws_inner' works with two groups variables", {
  df <- data.frame(a = c(1, 1, 1, 2, 2, 2),
                   b = c(1:3, 1:3),
                   x = rvec(1:6),
                   y = rvec(matrix(1:12, nr = 6)))
  ans_obtained <- pool_draws_inner(df,
                                   by_colnums = integer(),
                                   groups_colnums = c(a = 1L,
                                                      b = 2L))
  ans_expected <- tibble::tibble(df)
  expect_identical(ans_obtained, ans_expected)
})

test_that("'pool_draws_inner' works with no groups or by variables", {
  df <- data.frame(a = c(1, 1, 1, 2, 2, 2),
                   b = c(1:3, 1:3),
                   x = rvec(1:6),
                   y = rvec(matrix(1:12, nr = 6)))
  ans_obtained <- pool_draws_inner(df,
                                   by_colnums = integer(),
                                   groups_colnums = integer())
  ans_expected <- tibble::tibble(x = rvec(matrix(1:6, nr = 1)),
                                 y = rvec(matrix(1:12, nr = 1)))
  expect_identical(ans_obtained, ans_expected)
})

test_that("'pool_draws_inner' throws correct error with zero rows'", {
  df <- data.frame(a = integer(),
                   x = new_rvec_dbl(),
                   y = new_rvec_int())
  expect_error(pool_draws_inner(df,
                                by_colnums = c(a = 1L),
                                groups_colnums = integer()),
               "`data` has 0 rows.")
})

test_that("'pool_draws_inner' throws correct error with no rvecs'", {
  df <- data.frame(a = 1,
                   x = 2,
                   y = 3)
  expect_error(pool_draws_inner(df,
                                by_colnums = c(a = 1L),
                                groups_colnums = integer()),
               "`data` does not have any rvecs.")
})

test_that("'pool_draws_inner' throws correct error with one uneven 'by'", {
  df <- data.frame(a = c(1, 1, 1, 2, 2),
                   x = rvec(1:5),
                   y = rvec(matrix(1:10, nr = 5)))
  expect_error(pool_draws_inner(df,
                                by_colnums = c(a = 1L),
                                groups_colnums = integer()),
               "Some values of the 'by' variable occur more often than others.")
})

test_that("'pool_draws_inner' throws correct error with one uneven grouping", {
  df <- data.frame(a = c(1, 1, 1, 2, 2),
                   x = rvec(1:5),
                   y = rvec(matrix(1:10, nr = 5)))
  expect_error(pool_draws_inner(df,
                                groups_colnums = c(a = 1L),
                                by_colnums = integer()),
               "Some values of the grouping variable occur more often than others.")
})

test_that("'pool_draws_inner' throws correct error with uneven 'by' variables", {
  df <- data.frame(a = c(1, 1, 1, 2, 2, 2),
                   b = c(1:3, 1:2, 2),
                   x = rvec(1:6),
                   y = rvec(matrix(1:12, nr = 6)))
  expect_error(pool_draws_inner(df,
                                groups_colnums = integer(),
                                by_colnums = c(a = 1L,
                                               b = 2L)),
               "Some combinations of the 'by' variables occur more often than others.")
})

test_that("'pool_draws_inner' throws correct error with uneven grouping variables", {
  df <- data.frame(a = c(1, 1, 1, 2, 2, 2),
                   b = c(1:3, 1:2, 2),
                   x = rvec(1:6),
                   y = rvec(matrix(1:12, nr = 6)))
  expect_error(pool_draws_inner(df,
                                by_colnums = integer(),
                                groups_colnums = c(a = 1L,
                                               b = 2L)),
               "Some combinations of the grouping variables occur more often than others.")
})







## 'pool_draws_df' ------------------------------------------------------------

test_that("'pool_draws_vec' works with nrow > 0", {
  df <- data.frame(x = rvec(1:5), y = rvec(matrix(1:10, nr = 5)))
  ans_obtained <- pool_draws_df(df)
  ans_expected <- tibble::tibble(x = rvec(matrix(1:5, nr = 1)),
                                 y = rvec(matrix(1:10, nr = 1)))
  expect_identical(ans_obtained, ans_expected)
})

test_that("'pool_draws_vec' works with nrow = 0", {
  df <- data.frame(x = new_rvec_dbl())
  ans_obtained <- pool_draws_df(df)
  ans_expected <- df
  expect_identical(ans_obtained, ans_expected)
})


## 'pool_draws_vec' -----------------------------------------------------------

test_that("'pool_draws_vec' works with rvec length > 1", {
  m <- matrix(1:12, nr = 3)
  vec <- rvec(m)
  ans_obtained <- pool_draws_vec(vec)
  ans_expected <- rvec_int(matrix(as.integer(m), nr = 1))
  expect_identical(ans_obtained, ans_expected)
})

test_that("'pool_draws_vec' works with rvec length 1", {
  m <- 1 * matrix(1:12, nr = 1)
  vec <- rvec(m)
  ans_obtained <- pool_draws_vec(vec)
  ans_expected <- vec
  expect_identical(ans_obtained, ans_expected)
})

test_that("'pool_draws_vec' works with rvec length 0", {
  vec <- new_rvec_dbl(n_draw = 5)
  ans_obtained <- pool_draws_vec(vec)
  ans_expected <- vec
  expect_identical(ans_obtained, ans_expected)
})

test_that("'pool_draws_vec' works with character rvec", {
  m <- matrix(letters[1:12], nr = 3)
  vec <- rvec(m)
  ans_obtained <- pool_draws_vec(vec)
  ans_expected <- rvec(matrix(m, nr = 1))
  expect_identical(ans_obtained, ans_expected)
})

test_that("'pool_draws_vec' works with logical rvec", {
  m <- matrix(rep(FALSE, 12), nr = 3)
  vec <- rvec(m)
  ans_obtained <- pool_draws_vec(vec)
  ans_expected <- rvec(matrix(m, nr = 1))
  expect_identical(ans_obtained, ans_expected)
})

test_that("'pool_draws_vec' throws error with non-rvec", {
  expect_error(pool_draws_vec(1),
               "Internal error: `vec` is not an rvec.")
})