tests/testthat/test-relative_effects.R

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

smk_net <- set_agd_arm(smoking,
                       study = studyn,
                       trt = trtc,
                       r = r,
                       n = n,
                       trt_ref = "No intervention")

# Only test gradients, no sampling
smk_fit_RE <- nma(smk_net,
                  trt_effects = "random",
                  prior_intercept = normal(scale = 100),
                  prior_trt = normal(scale = 100),
                  prior_het = normal(scale = 5),
                  test_grad = TRUE)

test_that("all_contrasts argument", {
  m <- "should be TRUE or FALSE"
  expect_error(relative_effects(smk_fit_RE, all_contrasts = "a"), m)
  expect_error(relative_effects(smk_fit_RE, all_contrasts = 1), m)
  expect_error(relative_effects(smk_fit_RE, all_contrasts = list()), m)
  expect_error(relative_effects(smk_fit_RE, all_contrasts = NA), m)
  expect_error(relative_effects(smk_fit_RE, all_contrasts = NULL), m)
})

test_that("trt_ref argument", {
  m <- "does not match a treatment in the network"
  expect_error(relative_effects(smk_fit_RE, trt_ref = "a"), m)
  expect_error(relative_effects(smk_fit_RE, trt_ref = 1), m)
  expect_error(relative_effects(smk_fit_RE, trt_ref = list("a")), m)
  expect_error(relative_effects(smk_fit_RE, trt_ref = NA), m)

  # expect_warning(relative_effects(smk_fit_RE, all_contrasts = TRUE, trt_ref = "Self-help"), "Ignoring `trt_ref`")
})

test_that("probs argument", {
  m <- "numeric vector of probabilities"
  expect_error(relative_effects(smk_fit_RE, probs = "a"), m)
  expect_error(relative_effects(smk_fit_RE, probs = -1), m)
  expect_error(relative_effects(smk_fit_RE, probs = 1.5), m)
  expect_error(relative_effects(smk_fit_RE, probs = Inf), m)
  expect_error(relative_effects(smk_fit_RE, probs = list()), m)
  expect_error(relative_effects(smk_fit_RE, probs = NA), m)
  expect_error(relative_effects(smk_fit_RE, probs = NULL), m)
})

test_that("summary argument", {
  m <- "should be TRUE or FALSE"
  expect_error(relative_effects(smk_fit_RE, summary = "a"), m)
  expect_error(relative_effects(smk_fit_RE, summary = 1), m)
  expect_error(relative_effects(smk_fit_RE, summary = list()), m)
  expect_error(relative_effects(smk_fit_RE, summary = NA), m)
  expect_error(relative_effects(smk_fit_RE, summary = NULL), m)
})

test_that("newdata argument", {
  m <- "not a data frame"
  expect_error(relative_effects(smk_fit_RE, newdata = "a"), m)
  expect_error(relative_effects(smk_fit_RE, newdata = 1), m)
  expect_error(relative_effects(smk_fit_RE, newdata = list()), m)
  expect_error(relative_effects(smk_fit_RE, newdata = NA), m)
})


skip_on_cran()  # Reduce CRAN check time

# Only small number of samples to test
smk_fit_RE <- suppressWarnings(nma(smk_net,
                                   trt_effects = "random",
                                   prior_intercept = normal(scale = 100),
                                   prior_trt = normal(scale = 100),
                                   prior_het = normal(scale = 5),
                                   iter = 10))

test_that(".trta, .trtb columns are correct", {
  re1 <- tibble::as_tibble(relative_effects(smk_fit_RE))
  expect_identical(paste0("d[", re1$.trtb, "]"),
                   re1$parameter)
  expect_identical(as.character(re1$.trta), rep("No intervention", times = nrow(re1)))

  re2 <- tibble::as_tibble(relative_effects(smk_fit_RE, all_contrasts = TRUE))
  expect_identical(paste0("d[", re2$.trtb, " vs. ", re2$.trta, "]"),
                   re2$parameter)

  re3 <- tibble::as_tibble(relative_effects(smk_fit_RE, trt_ref = "Self-help"))
  expect_identical(paste0("d[", re3$.trtb, "]"),
                   re3$parameter)
  expect_identical(as.character(re3$.trta), rep("Self-help", times = nrow(re3)))
})

pso_net <- set_ipd(plaque_psoriasis_ipd[complete.cases(plaque_psoriasis_ipd), ],
                   studyc, trtc,
                   r = pasi75)

# Only small number of samples to test
pso_fit <- suppressWarnings(nma(pso_net,
                                trt_effects = "fixed",
                                regression = ~(durnpso + prevsys + bsa + weight + psa)*.trt,
                                prior_intercept = normal(scale = 10),
                                prior_trt = normal(scale = 10),
                                prior_reg = normal(scale = 10),
                                init_r = 0.1,
                                iter = 10))

pso_new <- data.frame(durnpso = 10, prevsys = TRUE, bsa = 20, weight = 75, psa = FALSE, study = c("One", "Two"))

test_that("newdata validation", {
  expect_error(relative_effects(pso_fit, newdata = pso_new[-1], study = study),
               'Regression variable "durnpso" not found in `newdata`')
  expect_error(relative_effects(pso_fit, newdata = pso_new[-(1:2)], study = study),
               'Regression variables "durnpso" and "prevsys" not found in `newdata`')

  make_bad <- function(x, vars = "durnpso") {
    bad <- pso_new
    bad[vars] <- x
    return(bad)
  }

  expect_error(relative_effects(pso_fit, newdata = make_bad(NA), study = study),
               "missing or infinite values in `newdata`: durnpso")
  expect_error(relative_effects(pso_fit, newdata = make_bad(NaN), study = study),
               "missing or infinite values in `newdata`: durnpso")
  expect_error(relative_effects(pso_fit, newdata = make_bad(Inf), study = study),
               "missing or infinite values in `newdata`: durnpso")

  expect_error(relative_effects(pso_fit, newdata = make_bad(NA, c("durnpso", "psa")), study = study),
               "missing or infinite values in `newdata`: durnpso, psa")
  expect_error(relative_effects(pso_fit, newdata = make_bad(NaN, c("durnpso", "psa")), study = study),
               "missing or infinite values in `newdata`: durnpso, psa")
  expect_error(relative_effects(pso_fit, newdata = make_bad(Inf, c("durnpso", "psa")), study = study),
               "missing or infinite values in `newdata`: durnpso, psa")
})

test_that(".study, .trta, .trtb columns are correct", {
  re1 <- tibble::as_tibble(relative_effects(pso_fit))
  expect_identical(paste0("d[", re1$.study, ": ", re1$.trtb, "]"),
                   re1$parameter)
  expect_identical(as.character(re1$.trta), rep(levels(pso_net$treatments)[1], times = nrow(re1)))

  re2 <- tibble::as_tibble(relative_effects(pso_fit, all_contrasts = TRUE))
  expect_identical(paste0("d[", re2$.study, ": ", re2$.trtb, " vs. ", re2$.trta, "]"),
                   re2$parameter)

  re3 <- tibble::as_tibble(relative_effects(pso_fit, trt_ref = "ETN"))
  expect_identical(paste0("d[", re3$.study, ": ", re3$.trtb, "]"),
                   re3$parameter)
  expect_identical(as.character(re3$.trta), rep("ETN", times = nrow(re3)))

  re4 <- tibble::as_tibble(relative_effects(pso_fit, newdata = pso_new, study = study))
  expect_identical(paste0("d[", re4$.study, ": ", re4$.trtb, "]"),
                   re4$parameter)
  expect_identical(as.character(re4$.trta), rep(levels(pso_net$treatments)[1], times = nrow(re4)))

  re5 <- tibble::as_tibble(relative_effects(pso_fit, all_contrasts = TRUE, newdata = pso_new, study = study))
  expect_identical(paste0("d[", re5$.study, ": ", re5$.trtb, " vs. ", re5$.trta, "]"),
                   re5$parameter)

  re6 <- tibble::as_tibble(relative_effects(pso_fit, trt_ref = "ETN", newdata = pso_new, study = study))
  expect_identical(paste0("d[", re6$.study, ": ", re6$.trtb, "]"),
                   re6$parameter)
  expect_identical(as.character(re6$.trta), rep("ETN", times = nrow(re6)))
})