tests/testthat/test-multi.R

In dmphillippo/multinma: Bayesian Network Meta-Analysis of Individual and Aggregate Data

test_that("`inclusive` argument is validated", {
  m <- "`inclusive` must be a logical value"

  expect_error(multi(a = 1:4, b = 1:4, inclusive = "a"), m)
  expect_error(multi(a = 1:4, b = 1:4, inclusive = 1), m)
  expect_error(multi(a = 1:4, b = 1:4, inclusive = list()), m)
  expect_error(multi(a = 1:4, b = 1:4, inclusive = NA), m)
  expect_error(multi(a = 1:4, b = 1:4, inclusive = NULL), m)

  expect_warning(multi(1, 2 , inclusive = TRUE, type = "competing"),
                 "Ignoring inclusive = TRUE")
})

test_that("`type` argument is validated", {
  m <- "`type` must be"

  expect_error(multi(a = 1:4, b = 1:4, type = "a"), m)
  expect_error(multi(a = 1:4, b = 1:4, type = 1), m)
  expect_error(multi(a = 1:4, b = 1:4, type = list()), m)
  expect_error(multi(a = 1:4, b = 1:4, type = NA), m)
  expect_error(multi(a = 1:4, b = 1:4, type = NULL), m)
})

test_that("basic validation of `...`", {
  expect_error(multi(), "At least 2 outcomes")
  expect_error(multi(1:3), "At least 2 outcomes")
  expect_error(multi(a = 1:4, a = 1:4), "Duplicate outcome category labels")
  a <- 1:4
  expect_error(multi(a, a), "Duplicate outcome category labels")
  expect_error(multi(1:2, 1:4), "must be the same length")
  expect_error(multi(a = 1, b = Inf), "cannot be Inf")
  expect_error(multi(a = 1, b = NaN), "cannot be NaN")
  expect_error(multi(a = 1, b = "a"), "must be numeric")
  expect_error(multi(a = 1, b = 1.5), "must be integer")
  expect_error(multi(a = 1, b = -1), "must be non-negative")
})

df_inclusive <- tibble::tribble(~a, ~b, ~c,
                                1, 1, 1,
                                5, 4, 1,
                                5, 2, 2,
                                10, 5, 0,
                                5, 5, 0,    # y > -Inf, y > b, y > c
                                7, NA, 6,   # y > -Inf, y > c
                                10, 4, NA)  # y > -Inf, y > b

# internally stored as exclusive counts
df_exclusive <- tibble::tribble(~a, ~b, ~c,
                                0, 0, 1,
                                1, 3, 1,
                                3, 0, 2,
                                5, 5, 0,
                                0, 5, 0,    # -Inf < y < b, b < y < c, y > c
                                1, NA, 6,   # -Inf < y < c, y > c
                                6, 4, NA)   # -Inf < y < b, y > b

test_that("ordered inclusive outcome validation", {
  m <- "must be decreasing or constant across increasing categories"

  expect_error(multi(1, 2, 3, inclusive = TRUE, type = "ordered"), paste0(m, ".+row 1"))
  expect_error(multi(5, 4, 6, inclusive = TRUE, type = "ordered"), paste0(m, ".+row 1"))
  expect_error(multi(5, NA, 6, inclusive = TRUE, type = "ordered"), paste0(m, ".+row 1"))
  expect_error(with(df_inclusive[-7, ], multi(c, b, a, inclusive = TRUE, type = "ordered")), paste0(m, ".+rows 2, 3, 4, 5 and 6"))

  expect_error(multi(a = NA, b = 10, c = 5, inclusive = TRUE, type = "ordered"),
               "cannot be missing in the lowest category.+row 1")

  expect_error(multi(a = 10, b = NA, inclusive = TRUE, type = "ordered"),
               "must be present for at least 2 categories.+row 1")

  o <- with(df_inclusive, multi(a, b, c, inclusive = TRUE, type = "ordered"))
  expect_s3_class(o, "multi_ordered")
  expect_equivalent(unclass(o), as.matrix(df_exclusive))
  expect_equal(colnames(o), colnames(df_inclusive))

  o2 <- with(df_inclusive, multi(A = a, B = b, C = c, inclusive = TRUE, type = "ordered"))
  expect_equal(colnames(o2), c("A", "B", "C"))
})

test_that("exclusive outcome validation", {
  expect_error(multi(a = NA, b = 10, c = 5, inclusive = FALSE, type = "ordered"),
               "cannot be missing in the lowest category.+row 1")

  expect_error(multi(a = 10, b = NA, inclusive = FALSE, type = "ordered"),
               "must be present for at least 2 categories.+row 1")
  expect_error(multi(a = 10, b = NA, inclusive = FALSE, type = "competing"),
               "must be present for at least 2 categories.+row 1")

  o <- with(df_exclusive, multi(a, b, c, inclusive = FALSE, type = "ordered"))
  expect_s3_class(o, "multi_ordered")
  expect_equivalent(unclass(o), as.matrix(df_exclusive))
  expect_equal(colnames(o), colnames(df_exclusive))

  o2 <- with(df_exclusive, multi(a, b, c, inclusive = FALSE, type = "competing"))
  expect_s3_class(o2, "multi_competing")
  expect_equivalent(unclass(o2), as.matrix(df_exclusive))
  expect_equal(colnames(o2), colnames(df_exclusive))

  o3 <- with(df_exclusive, multi(A = a, B = b, C = c, inclusive = FALSE, type = "ordered"))
  expect_equal(colnames(o3), c("A", "B", "C"))

  o4 <- with(df_exclusive, multi(A = a, B = b, C = c, inclusive = FALSE, type = "competing"))
  expect_equal(colnames(o4), c("A", "B", "C"))

  # NA should be allowed in leftmost category for competing outcomes
  df_e2 <- dplyr::add_row(df_exclusive, a = NA, b = 5, c = 10)
  o5 <- with(df_e2, multi(a, b, c, inclusive = FALSE, type = "competing"))
  expect_equivalent(unclass(o5), as.matrix(df_e2))
})