tests/testthat/test-add_integration.R

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

library(multinma)
library(dplyr)
library(purrr)

test_that("expects nma_data object", {
  expect_error(add_integration("uh oh"), "No add_integration method defined")
})

test_that("error on empty network", {
  expect_error(add_integration(set_ipd(data.frame())), "Empty network")
})

test_that("error if no AgD", {
  expect_error(add_integration(set_ipd(smoking, studyn, trtc, y = r)), "No aggregate data")
})

# Make dummy covariate data for smoking network
ns_agd <- max(smoking$studyn)
smkdummy <-
  smoking %>%
  group_by(studyn) %>%
  mutate(x1_mean = rnorm(1), x1_sd = runif(1, 0.5, 2),
         x2 = rbeta(1, 5, 10),
         x3_mean = rnorm(1), x3_sd = runif(1, 0.5, 2),
         x4 = rbeta(1, 10, 5)) %>%
  ungroup()

smkdummy_contrast <- smkdummy %>%
  group_by(studyn) %>%
  mutate(arm = 1:n(),
         cc = if_else(any(r == 0), 0.5, 0),
         r = r + cc,
         n = n + cc,
         lor = if_else(arm == 1, NA_real_, log(r * (first(n) - first(r)) / ((n - r) * first(r)))),
         se = sqrt(if_else(arm == 1, 1 / r + 1 / (n - r), 1 / r + 1 / (n - r) + 1 / first(r) + 1 / (first(n) - first(r))))) %>%
  ungroup()

ns_ipd <- 2

xall_cor <- 0.25
n_i <- 200
cormat <- matrix(xall_cor, nrow = 4, ncol = 4)
diag(cormat) <- 1

cop <- copula::normalCopula(copula::P2p(cormat), dim = 4, dispstr = "un")
u <- matrix(runif(n_i * 4 * ns_ipd), ncol = 4)
u_cor <- as.data.frame(copula::cCopula(u, cop, inverse = TRUE))

ipddummy <-
  tibble(studyn = rep(ns_agd, n_i * ns_ipd) + rep(1:ns_ipd, each = n_i),
         trtn = sample(1:2, n_i * ns_ipd, TRUE)) %>%
  mutate(x1 = qnorm(u_cor[,1]),
         x2 = qbinom(u_cor[,2], 1, 0.6),
         x3 = qnorm(u_cor[,3], 1, 0.5),
         x4 = qbinom(u_cor[,4], 1, 0.4),
         r = rbinom(n(), 1, 0.2))

smknet_agd <- set_agd_arm(smkdummy, studyn, trtn, r = r, n = n)
smknet_ipd <- set_ipd(ipddummy, studyn, trtn, r = r)
smknet <- combine_network(smknet_agd, smknet_ipd)

test_that("n_int should be a positive integer", {
  m <- "should be a positive integer"

  expect_error(add_integration(smknet, x1 = distr(qnorm, mean = x1_mean, sd = x1_sd), n_int = "oh dear"), m)
  expect_error(add_integration(smknet, x1 = distr(qnorm, mean = x1_mean, sd = x1_sd), n_int = 1.1), m)
  expect_error(add_integration(smknet, x1 = distr(qnorm, mean = x1_mean, sd = x1_sd), n_int = -5), m)
  expect_error(add_integration(smknet, x1 = distr(qnorm, mean = x1_mean, sd = x1_sd), n_int = 0), m)
  expect_error(add_integration(smknet, x1 = distr(qnorm, mean = x1_mean, sd = x1_sd), n_int = 1:2), m)

  expect_error(add_integration(smkdummy, x1 = distr(qnorm, mean = x1_mean, sd = x1_sd), n_int = "oh dear"), m)
  expect_error(add_integration(smkdummy, x1 = distr(qnorm, mean = x1_mean, sd = x1_sd), n_int = 1.1), m)
  expect_error(add_integration(smkdummy, x1 = distr(qnorm, mean = x1_mean, sd = x1_sd), n_int = -5), m)
  expect_error(add_integration(smkdummy, x1 = distr(qnorm, mean = x1_mean, sd = x1_sd), n_int = 0), m)
  expect_error(add_integration(smkdummy, x1 = distr(qnorm, mean = x1_mean, sd = x1_sd), n_int = 1:2), m)
})

test_that("int_args is named list", {
  m <- "should be a named list"

  expect_error(add_integration(smknet, x1 = distr(qnorm, mean = x1_mean, sd = x1_sd), int_args = "oh dear"), m)
  expect_error(add_integration(smknet, x1 = distr(qnorm, mean = x1_mean, sd = x1_sd), int_args = 1.1), m)
  expect_error(add_integration(smknet, x1 = distr(qnorm, mean = x1_mean, sd = x1_sd), int_args = NULL), m)
  expect_error(add_integration(smknet, x1 = distr(qnorm, mean = x1_mean, sd = x1_sd), int_args = list(a = 1, 2)), m)

  expect_error(add_integration(smkdummy, x1 = distr(qnorm, mean = x1_mean, sd = x1_sd), int_args = "oh dear"), m)
  expect_error(add_integration(smkdummy, x1 = distr(qnorm, mean = x1_mean, sd = x1_sd), int_args = 1.1), m)
  expect_error(add_integration(smkdummy, x1 = distr(qnorm, mean = x1_mean, sd = x1_sd), int_args = NULL), m)
  expect_error(add_integration(smkdummy, x1 = distr(qnorm, mean = x1_mean, sd = x1_sd), int_args = list(a = 1, 2)), m)
})

test_that("cor should be correlation matrix or NULL", {
  m <- "should be a correlation matrix or NULL"

  expect_error(add_integration(smknet, x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                               x2 = distr(qbinom, 1, x2),
                               cor = "a"), m)
  expect_error(add_integration(smknet, x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                               x2 = distr(qbinom, 1, x2),
                               cor = list()), m)
  expect_error(add_integration(smknet, x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                               x2 = distr(qbinom, 1, x2),
                               cor = 2), m)
  expect_error(add_integration(smknet, x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                               x2 = distr(qbinom, 1, x2),
                               cor = matrix(1:4)), m)
  expect_error(add_integration(smknet, x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                               x2 = distr(qbinom, 1, x2),
                               cor = matrix(1:4, nrow = 2)), m)

  expect_error(add_integration(smkdummy, x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                               x2 = distr(qbinom, 1, x2),
                               cor = "a"), m)
  expect_error(add_integration(smkdummy, x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                               x2 = distr(qbinom, 1, x2),
                               cor = list()), m)
  expect_error(add_integration(smkdummy, x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                               x2 = distr(qbinom, 1, x2),
                               cor = 2), m)
  expect_error(add_integration(smkdummy, x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                               x2 = distr(qbinom, 1, x2),
                               cor = matrix(1:4)), m)
  expect_error(add_integration(smkdummy, x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                               x2 = distr(qbinom, 1, x2),
                               cor = matrix(1:4, nrow = 2)), m)
})

test_that("cor must be specified if no IPD", {
  expect_error(add_integration(smknet_agd,
                               x1 = distr(qnorm, mean = 1, sd = 1),
                               x2 = distr(qbinom, 1, x2),
                               cor = NULL),
               "Specify a correlation matrix")

  expect_error(add_integration(smkdummy,
                               x1 = distr(qnorm, mean = 1, sd = 1),
                               x2 = distr(qbinom, 1, x2),
                               cor = NULL),
               "Specify a correlation matrix")
})

test_that("cor is not required if only one covariate", {
  expect_s3_class(add_integration(smknet_agd, x1 = distr(qnorm, mean = 1, sd = 1), cor = NULL),
                  "mlnmr_data")

  s <- add_integration(smkdummy, x1 = distr(qnorm, mean = 1, sd = 1), cor = NULL)
  expect_s3_class(s, "data.frame")
  expect_true(rlang::has_name(s, ".int_x1"))
})

test_that("covariate arguments should be named distr", {
  m <- "should be specified as named arguments using the function `distr`"

  expect_error(add_integration(smknet, cor = cormat, x1 = "a"), m)
  expect_error(add_integration(smknet, cor = cormat, x1 = list()), m)
  expect_error(add_integration(smknet, cor = cormat, "a"), m)
  expect_error(add_integration(smknet, cor = cormat,
                               x1 = distr(qnorm, mean = 1, sd = 1), x2 = list(), m))
  expect_error(add_integration(smknet, cor = cormat,
                               x1 = distr(qnorm, mean = 1, sd = 1), distr(qnorm, mean = 1, sd = 1), m))
  expect_error(add_integration(smknet, cor = cormat), paste("No covariate distributions specified.+", m))

  expect_error(add_integration(smkdummy, cor = cormat, x1 = "a"), m)
  expect_error(add_integration(smkdummy, cor = cormat, x1 = list()), m)
  expect_error(add_integration(smkdummy, cor = cormat, "a"), m)
  expect_error(add_integration(smkdummy, cor = cormat,
                               x1 = distr(qnorm, mean = 1, sd = 1), x2 = list(), m))
  expect_error(add_integration(smkdummy, cor = cormat,
                               x1 = distr(qnorm, mean = 1, sd = 1), distr(qnorm, mean = 1, sd = 1), m))
  expect_error(add_integration(smkdummy, cor = cormat), paste("No covariate distributions specified.+", m))
})

test_that("covariate names must match IPD if provided", {
  m <- "Covariate name\\(s\\) not found in IPD: aaa"

  expect_error(add_integration(smknet, aaa = distr(qnorm, mean = x1_mean, sd = x1_sd)), m)
  expect_error(add_integration(smknet,
                               x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                               aaa = distr(qbinom, size = 1, prob = x2)), m)
  expect_error(add_integration(smknet,
                               x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                               aaa = distr(qbinom, size = 1, prob = x2),
                               cor = cormat), m)
})

test_that("warning if missing covariate values when calculating correlations from IPD", {
  smknet_miss <- combine_network(smknet_ipd,
                                 set_agd_arm(smkdummy, studyn, trtn, r = r, n = n))
  smknet_miss$ipd[5, "x1"] <- NA
  expect_warning(add_integration(smknet_miss,
                                 x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                                 x2 = distr(qbinom, size = 1, prob = x2)),
                 "Missing values.+complete cases")
})

test_that("replaces already present integration points with warning", {
  smknet_int <- add_integration(smknet, x1 = distr(qnorm, mean = x1_mean, sd = x1_sd))
  m <- "Replacing integration points already present in network"

  expect_warning(add_integration(smknet_int, x1 = distr(qnorm, mean = x1_mean, sd = x1_sd)), m)
  expect_warning(add_integration(smknet_int, x3 = distr(qnorm, mean = x3_mean, sd = x3_sd)), m)

  smkdummy_int <- add_integration(smkdummy, x1 = distr(qnorm, mean = x1_mean, sd = x1_sd))
  m2 <- "Replacing integration points already present in data frame"

  expect_warning(add_integration(smkdummy_int, x1 = distr(qnorm, mean = x1_mean, sd = x1_sd)), m2)
  expect_warning(add_integration(smkdummy_int, x3 = distr(qnorm, mean = x3_mean, sd = x3_sd)), m2)
})

make_sub <- function(x, n, sub) {
  x[sample.int(length(x), n)] <- sub
  return(x)
}

test_that("error if qfun produces NaN, NA, NULL, Inf", {
  m <- "Invalid integration points were generated"

  smkdummy_miss <- smkdummy %>% mutate(x1_mean = make_sub(x1_mean, 5, NA),
                                       x3_mean = make_sub(x3_mean, 5, NA))

  smkdummy_miss_contrast <- smkdummy_contrast %>%
    mutate(x1_mean = make_sub(x1_mean, 5, NA), x3_mean = make_sub(x3_mean, 5, NA))

  smknet_miss <- set_agd_arm(smkdummy_miss, studyn, trtn, r = r, n = n) %>%
    combine_network(smknet_ipd)
  smknet_missc <- set_agd_contrast(smkdummy_miss_contrast, studyn, trtn, y = lor, se = se) %>%
    combine_network(smknet_ipd)

  expect_error(suppressWarnings(
    add_integration(smknet_miss,
                    x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                    x2 = distr(qbinom, 1, x2),
                    x3 = distr(qnorm, x3_mean, x3_sd))),
               m)

  expect_error(suppressWarnings(
    add_integration(smknet_missc,
                    x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                    x2 = distr(qbinom, 1, x2),
                    x3 = distr(qnorm, x3_mean, x3_sd))),
               m)

  smkdummy_bad <- smkdummy %>% mutate(x1_sd = make_sub(x1_sd, 5, -1),
                                      x3_sd = make_sub(x3_sd, 5, -1))

  smkdummy_bad_contrast <- smkdummy_contrast %>%
    mutate(x1_sd = make_sub(x1_sd, 5, -1), x3_sd = make_sub(x3_sd, 5, -1))

  smknet_bad <- set_agd_arm(smkdummy_bad, studyn, trtn, r = r, n = n) %>%
    combine_network(smknet_ipd)
  smknet_badc <- set_agd_contrast(smkdummy_bad_contrast, studyn, trtn, y = lor, se = se) %>%
    combine_network(smknet_ipd)

  expect_error(suppressWarnings(
    add_integration(smknet_bad,
                    x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                    x3 = distr(qnorm, mean = x3_mean, sd = x3_sd))),
               m)

  expect_error(suppressWarnings(
    add_integration(smknet_badc,
                    x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                    x3 = distr(qnorm, mean = x3_mean, sd = x3_sd))),
               m)

})

test_that("correctly assess type of marginal distributions", {
  dtype <- get_distribution_type(
             x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
             x2 = distr(qgamma, mean = x3_mean, sd = x3_sd),
             x3 = distr(qbern, prob = x2),
             x4 = distr(qbinom, size = 1, prob = x2),
             x5 = distr(qbinom, size = n, prob = x2),
             x6 = distr(qbinom, 1, x2),
             x7 = distr(qpois, lambda = x3_sd),
             x8 = distr(function(p, ...) qnorm(p, ...), mean = x1_mean, sd = x1_sd),
             x9 = distr(function(p, ...) qpois(p, ...), lambda = 0.5),
             x10 = distr(function(p, ...) qbern(p, ...), prob = x2),
             data = smkdummy)
  expect_identical(dtype,
                   c(x1 = "continuous",
                     x2 = "continuous",
                     x3 = "binary",
                     x4 = "binary",
                     x5 = "discrete",
                     x6 = "binary",
                     x7 = "discrete",
                     x8 = "continuous",
                     x9 = "discrete",
                     x10 = "binary"))
})

test_that("cor_adjust logic is correct", {
  expect_error(add_integration(smknet,
                               x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                               x2 = distr(qbern, x2),
                               cor_adjust = "bad"),
               "`cor_adjust` must be one of")

  # Spearman should be the default for cor = NULL
  expect_identical(attr(add_integration(smknet,
                                        x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                                        x2 = distr(qbern, x2))$int_cor, "cor_adjust"),
                   "spearman")
  expect_equal(attr(add_integration(smknet,
                                    x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                                    x2 = distr(qbern, x2),
                                    cor_adjust = "spearman")$int_cor, "copula_cor"),
               cor_adjust_spearman(
                 add_integration(smknet,
                                 x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                                 x2 = distr(qbern, x2),
                                 cor_adjust = "spearman")$int_cor,
                 types = c("continuous", "binary")),
               check.attributes = FALSE,
               tolerance = 0)

  expect_identical(attr(add_integration(smknet,
                                        x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                                        x2 = distr(qbern, x2),
                                        cor_adjust = "pearson")$int_cor, "cor_adjust"),
                   "pearson")
  expect_equal(attr(add_integration(smknet,
                                    x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                                    x2 = distr(qbern, x2),
                                    cor_adjust = "pearson")$int_cor, "copula_cor"),
               cor_adjust_pearson(
                 add_integration(smknet,
                                 x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                                 x2 = distr(qbern, x2),
                                 cor_adjust = "pearson")$int_cor,
                 types = c("continuous", "binary")),
               check.attributes = FALSE,
               tolerance = 0)

  expect_identical(attr(add_integration(smknet,
                                        x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                                        x2 = distr(qbern, x2),
                                        cor_adjust = "legacy")$int_cor, "cor_adjust"),
                   "legacy")
  # Check that "legacy" does the right (wrong) thing (Spearman cor with no adjustment)
  expect_equal(attr(add_integration(smknet,
                                        x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                                        x2 = distr(qbern, x2),
                                        cor_adjust = "legacy")$int_cor, "copula_cor"),
               add_integration(smknet,
                               x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                               x2 = distr(qbern, x2),
                               cor_adjust = "spearman")$int_cor,
               check.attributes = FALSE,
               tolerance = 0)
  expect_equal(attr(add_integration(smknet,
                                    x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                                    x2 = distr(qbern, x2),
                                    cor_adjust = "legacy")$int_cor, "copula_cor"),
               add_integration(smknet,
                               x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                               x2 = distr(qbern, x2),
                               cor_adjust = "legacy")$int_cor,
               check.attributes = FALSE,
               tolerance = 0)

  expect_error(add_integration(smknet,
                               x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                               x2 = distr(qbern, x2),
                               cor_adjust = "none"),
               'Cannot specify cor_adjust = "none"')

  # Pearson should be the default for user-provided cor
  cmat <- matrix(c(1, 0.4, 0.4, 1), nrow = 2)
  expect_identical(attr(add_integration(smknet,
                                        x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                                        x2 = distr(qbern, x2),
                                        cor = cmat)$int_cor, "cor_adjust"),
                   "pearson")
  expect_equal(attr(add_integration(smknet,
                                    x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                                    x2 = distr(qbern, x2),
                                    cor = cmat)$int_cor, "copula_cor"),
               cor_adjust_pearson(cmat, types = c("continuous", "binary")),
               check.attributes = FALSE,
               tolerance = 0)

  expect_identical(attr(add_integration(smknet,
                                        x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                                        x2 = distr(qbern, x2),
                                        cor_adjust = "spearman",
                                        cor = cmat)$int_cor, "cor_adjust"),
                   "spearman")
  expect_equal(attr(add_integration(smknet,
                                    x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                                    x2 = distr(qbern, x2),
                                    cor_adjust = "spearman",
                                    cor = cmat)$int_cor, "copula_cor"),
               cor_adjust_spearman(cmat, types = c("continuous", "binary")),
               check.attributes = FALSE,
               tolerance = 0)

  expect_identical(attr(add_integration(smknet,
                                        x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                                        x2 = distr(qbern, x2),
                                        cor_adjust = "none",
                                        cor = cmat)$int_cor, "cor_adjust"),
                   "none")
  expect_equal(attr(add_integration(smknet,
                                    x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                                    x2 = distr(qbern, x2),
                                    cor_adjust = "none",
                                    cor = cmat)$int_cor, "copula_cor"),
               add_integration(smknet,
                               x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                               x2 = distr(qbern, x2),
                               cor_adjust = "none",
                               cor = cmat)$int_cor,
               check.attributes = FALSE,
               tolerance = 0)
  expect_equal(add_integration(smknet,
                               x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                               x2 = distr(qbern, x2),
                               cor_adjust = "none",
                               cor = cmat)$int_cor,
               cmat,
               check.attributes = FALSE,
               tolerance = 0)

  expect_identical(attr(add_integration(smknet,
                                        x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                                        x2 = distr(qbern, x2),
                                        cor_adjust = "legacy",
                                        cor = cmat)$int_cor, "cor_adjust"),
                   "legacy")

  # Check that "legacy" does the right thing - same as "none" with user cor
  expect_equal(attr(add_integration(smknet,
                                    x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                                    x2 = distr(qbern, x2),
                                    cor_adjust = "legacy",
                                    cor = cmat)$int_cor, "copula_cor"),
               add_integration(smknet,
                               x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                               x2 = distr(qbern, x2),
                               cor_adjust = "legacy",
                               cor = cmat)$int_cor,
               check.attributes = FALSE,
               tolerance = 0)

  # Pearson should be the default for user-provided cor
  expect_identical(attr(add_integration(smkdummy,
                                        x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                                        x2 = distr(qbern, x2),
                                        cor = cmat), "cor_adjust"),
                   "pearson")
  expect_equal(attr(add_integration(smkdummy,
                                    x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                                    x2 = distr(qbern, x2),
                                    cor = cmat), "copula_cor"),
               cor_adjust_pearson(cmat, types = c("continuous", "binary")),
               check.attributes = FALSE,
               tolerance = 0)

  expect_identical(attr(add_integration(smkdummy,
                                        x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                                        x2 = distr(qbern, x2),
                                        cor_adjust = "spearman",
                                        cor = cmat), "cor_adjust"),
                   "spearman")
  expect_equal(attr(add_integration(smkdummy,
                                    x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                                    x2 = distr(qbern, x2),
                                    cor = cmat,
                                    cor_adjust = "spearman"), "copula_cor"),
               cor_adjust_spearman(cmat, types = c("continuous", "binary")),
               check.attributes = FALSE,
               tolerance = 0)

  expect_identical(attr(add_integration(smkdummy,
                                        x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                                        x2 = distr(qbern, x2),
                                        cor_adjust = "none",
                                        cor = cmat), "cor_adjust"),
                   "none")
  expect_equal(attr(add_integration(smkdummy,
                                    x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                                    x2 = distr(qbern, x2),
                                    cor_adjust = "none",
                                    cor = cmat), "copula_cor"),
               cmat,
               check.attributes = FALSE,
               tolerance = 0)

  expect_identical(attr(add_integration(smkdummy,
                                        x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                                        x2 = distr(qbern, x2),
                                        cor_adjust = "legacy",
                                        cor = cmat), "cor_adjust"),
                   "legacy")

  # Check that "legacy" does the right thing - same as "none" with user cor
  expect_equal(attr(add_integration(smkdummy,
                                    x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                                    x2 = distr(qbern, x2),
                                    cor_adjust = "legacy",
                                    cor = cmat), "copula_cor"),
               cmat,
               check.attributes = FALSE,
               tolerance = 0)

  # Check that reusing $int_cor from a network works automatically
  s1 <- add_integration(smknet,
                        x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                        x2 = distr(qbinom, size = 1, prob = x2),
                        x3 = distr(qnorm, mean = x3_mean, sd = x3_sd),
                        x4 = distr(qbern, prob = x4))

  expect_identical(add_integration(smknet,
                                   x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                                   x2 = distr(qbinom, size = 1, prob = x2),
                                   x3 = distr(qnorm, mean = x3_mean, sd = x3_sd),
                                   x4 = distr(qbern, prob = x4),
                                   cor = s1$int_cor),
                   s1)

  s2 <- add_integration(smknet,
                        x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                        x2 = distr(qbinom, size = 1, prob = x2),
                        x3 = distr(qnorm, mean = x3_mean, sd = x3_sd),
                        x4 = distr(qbern, prob = x4),
                        cor_adjust = "pearson")

  expect_identical(add_integration(smknet,
                                   x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                                   x2 = distr(qbinom, size = 1, prob = x2),
                                   x3 = distr(qnorm, mean = x3_mean, sd = x3_sd),
                                   x4 = distr(qbern, prob = x4),
                                   cor = s2$int_cor),
                   s2)
})

test_that("integration point marginals and correlations are correct", {
  skip_on_cran()
  tol <- 0.005
  cor_tol <- 0.05
  n_int <- 2^14

  # 1 covariate
  s1 <- add_integration(smknet, x1 = distr(qnorm, mean = x1_mean, sd = x1_sd), n_int = n_int)
  expect_equal(map_dbl(s1$agd_arm$.int_x1, mean), s1$agd_arm$x1_mean, tolerance = tol)
  expect_equal(map_dbl(s1$agd_arm$.int_x1, sd), s1$agd_arm$x1_sd, tolerance = tol)

  # Multiple covariates, IPD cor matrix
  s2_spearman <- add_integration(smknet,
                       x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                       x2 = distr(qbinom, size = 1, prob = x2),
                       x3 = distr(qnorm, mean = x3_mean, sd = x3_sd),
                       x4 = distr(qbern, prob = x4),
                       n_int = n_int)

  # Mean, SD, proportion should match
  expect_equal(map_dbl(s2_spearman$agd_arm$.int_x1, mean), s2_spearman$agd_arm$x1_mean, tolerance = tol)
  expect_equal(map_dbl(s2_spearman$agd_arm$.int_x1, sd), s2_spearman$agd_arm$x1_sd, tolerance = tol)
  expect_equal(map_dbl(s2_spearman$agd_arm$.int_x2, mean), s2_spearman$agd_arm$x2, tolerance = tol)

  # Cont-cont correlations should match exactly for Spearman correlation
  expect_equal(map2_dbl(s2_spearman$agd_arm$.int_x1, s2_spearman$agd_arm$.int_x3, cor, method = "spearman"),
               rep(s2_spearman$int_cor[1, 3], nrow(s2_spearman$agd_arm)), tolerance = tol)

  # Other correlations should be approximate
  int_cors <- s2_spearman$agd_arm %>% rowwise() %>%
    mutate(int_cors = list(cor(cbind(.int_x1, .int_x2, .int_x3, .int_x4), method = "spearman"))) %>%
    pull(int_cors)
  # expect_equal(unlist(map(int_cors, ~.[upper.tri(.)])),
  #              rep(s2_spearman$int_cor[upper.tri(s2_spearman$int_cor)], times = nrow(s2_spearman$agd_arm)),
  #              tolerance = cor_tol)
  expect_lt(median(abs(unlist(map(int_cors, ~.[upper.tri(.)])) -
                   rep(s2_spearman$int_cor[upper.tri(s2_spearman$int_cor)], times = nrow(s2_spearman$agd_arm)))),
            cor_tol)

  s2_pearson <- add_integration(smknet,
                                 x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                                 x2 = distr(qbinom, size = 1, prob = x2),
                                 x3 = distr(qnorm, mean = x3_mean, sd = x3_sd),
                                x4 = distr(qbern, prob = x4),
                                cor_adjust = "pearson",
                                 n_int = n_int)
  expect_equal(map_dbl(s2_pearson$agd_arm$.int_x1, mean), s2_pearson$agd_arm$x1_mean, tolerance = tol)
  expect_equal(map_dbl(s2_pearson$agd_arm$.int_x1, sd), s2_pearson$agd_arm$x1_sd, tolerance = tol)
  expect_equal(map_dbl(s2_pearson$agd_arm$.int_x2, mean), s2_pearson$agd_arm$x2, tolerance = tol)

  # Normal-Normal correlations should match exactly for Pearson correlation
  expect_equal(map2_dbl(s2_pearson$agd_arm$.int_x1, s2_pearson$agd_arm$.int_x3, cor, method = "pearson"),
               rep(s2_pearson$int_cor[1, 3], nrow(s2_pearson$agd_arm)), tolerance = tol)

  # Other correlations should be approximate
  int_cors <- s2_pearson$agd_arm %>% rowwise() %>%
    mutate(int_cors = list(cor(cbind(.int_x1, .int_x2, .int_x3, .int_x4), method = "pearson"))) %>%
    pull(int_cors)
  # expect_equal(unlist(map(int_cors, ~.[upper.tri(.)])),
  #              rep(s2_pearson$int_cor[upper.tri(s2_pearson$int_cor)], times = nrow(s2_pearson$agd_arm)),
  #              tolerance = cor_tol)
  expect_lt(median(abs(unlist(map(int_cors, ~.[upper.tri(.)])) -
                         rep(s2_pearson$int_cor[upper.tri(s2_pearson$int_cor)], times = nrow(s2_pearson$agd_arm)))),
            cor_tol)

  # Multiple covariates, user cor matrix
  s3_pearson <- add_integration(smknet,
                       x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                       x2 = distr(qbinom, size = 1, prob = x2),
                       x3 = distr(qnorm, mean = x3_mean, sd = x3_sd),
                       x4 = distr(qbern, prob = x4),
                       cor = cormat,
                       n_int = n_int)
  expect_equal(map_dbl(s3_pearson$agd_arm$.int_x1, mean), s3_pearson$agd_arm$x1_mean, tolerance = tol)
  expect_equal(map_dbl(s3_pearson$agd_arm$.int_x1, sd), s3_pearson$agd_arm$x1_sd, tolerance = tol)
  expect_equal(map_dbl(s3_pearson$agd_arm$.int_x2, mean), s3_pearson$agd_arm$x2, tolerance = tol)

  # Normal-Normal correlations should match exactly for Pearson correlation
  expect_equal(map2_dbl(s3_pearson$agd_arm$.int_x1, s3_pearson$agd_arm$.int_x3, cor, method = "pearson"),
               rep(cormat[1, 3], nrow(s3_pearson$agd_arm)), tolerance = tol)

  # Other correlations should be approximate
  int_cors <- s3_pearson$agd_arm %>% rowwise() %>%
    mutate(int_cors = list(cor(cbind(.int_x1, .int_x2, .int_x3, .int_x4), method = "pearson"))) %>%
    pull(int_cors)
  # expect_equal(unlist(map(int_cors, ~.[upper.tri(.)])),
  #              rep(s3_pearson$int_cor[upper.tri(s3_pearson$int_cor)], times = nrow(s3_pearson$agd_arm)),
  #              tolerance = cor_tol)
  expect_lt(median(abs(unlist(map(int_cors, ~.[upper.tri(.)])) -
                         rep(s3_pearson$int_cor[upper.tri(s3_pearson$int_cor)], times = nrow(s3_pearson$agd_arm)))),
            cor_tol)


  s3_spearman <- add_integration(smknet,
                                x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                                x2 = distr(qbinom, size = 1, prob = x2),
                                x3 = distr(qnorm, mean = x3_mean, sd = x3_sd),
                                x4 = distr(qbern, prob = x4),
                                cor = cormat, cor_adjust = "spearman",
                                n_int = n_int)
  expect_equal(map_dbl(s3_spearman$agd_arm$.int_x1, mean), s3_spearman$agd_arm$x1_mean, tolerance = tol)
  expect_equal(map_dbl(s3_spearman$agd_arm$.int_x1, sd), s3_spearman$agd_arm$x1_sd, tolerance = tol)
  expect_equal(map_dbl(s3_spearman$agd_arm$.int_x2, mean), s3_spearman$agd_arm$x2, tolerance = tol)

  # Cont-cont correlations should match exactly for Spearman correlation
  expect_equal(map2_dbl(s3_spearman$agd_arm$.int_x1, s3_spearman$agd_arm$.int_x3, cor, method = "spearman"),
               rep(cormat[1, 3], nrow(s3_spearman$agd_arm)), tolerance = tol)

  # Other correlations should be approximate
  int_cors <- s3_spearman$agd_arm %>% rowwise() %>%
    mutate(int_cors = list(cor(cbind(.int_x1, .int_x2, .int_x3, .int_x4), method = "spearman"))) %>%
    pull(int_cors)
  # expect_equal(unlist(map(int_cors, ~.[upper.tri(.)])),
  #              rep(s3_spearman$int_cor[upper.tri(s3_spearman$int_cor)], times = nrow(s3_spearman$agd_arm)),
  #              tolerance = cor_tol)
  expect_lt(median(abs(unlist(map(int_cors, ~.[upper.tri(.)])) -
                         rep(s3_spearman$int_cor[upper.tri(s3_spearman$int_cor)], times = nrow(s3_spearman$agd_arm)))),
            cor_tol)
})

test_that("non positive definite cor matrices are fixed up", {
  badcor <- matrix(0.99, nrow = 4, ncol = 4)
  diag(badcor) <- 1

  expect_warning(
    add_integration(smknet,
                    x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                    x2 = distr(qbinom, size = 1, prob = x2),
                    x3 = distr(qnorm, mean = x3_mean, sd = x3_sd),
                    x4 = distr(qbern, prob = x4),
                    cor = badcor,
                    n_int = 10),
    "Adjusted correlation matrix not positive definite; using Matrix::nearPD()."
  )

  expect_warning(
    add_integration(smknet,
                    x1 = distr(qnorm, mean = x1_mean, sd = x1_sd),
                    x2 = distr(qbinom, size = 1, prob = x2),
                    x3 = distr(qnorm, mean = x3_mean, sd = x3_sd),
                    x4 = distr(qbern, prob = x4),
                    cor = badcor, cor_adjust = "spearman",
                    n_int = 10),
    "Adjusted correlation matrix not positive definite; using Matrix::nearPD()."
  )
})