library(multinma)
library(dplyr)
test_that("set_* produces empty nma_data objects", {
empty_nma_data <- structure(
list(agd_arm = NULL,
agd_contrast = NULL,
ipd = NULL,
treatments = NULL,
classes = NULL,
studies = NULL), class = "nma_data")
expect_equal(set_ipd(smoking[0, ], "studyn", "trtc"), empty_nma_data)
expect_equal(set_agd_arm(smoking[0, ], "studyn", "trtc"), empty_nma_data)
expect_equal(set_agd_contrast(smoking[0, ], "studyn", "trtc"), empty_nma_data)
expect_equal(set_agd_surv(smoking[0, ], "studyn", "trtc"), empty_nma_data)
})
test_that("set_* error if data does not inherit data.frame", {
vec <- 1:5
msg <- "Argument `data` should be a data frame"
expect_error(set_ipd(vec), msg)
expect_error(set_agd_arm(vec), msg)
expect_error(set_agd_contrast(vec), msg)
expect_error(set_agd_surv(vec), msg)
})
test_that("set_* error if study not given, missing values, or not regular 1D column", {
expect_error(set_ipd(smoking), "Specify `study`")
expect_error(set_agd_arm(smoking), "Specify `study`")
expect_error(set_agd_contrast(smoking), "Specify `study`")
expect_error(set_agd_surv(smoking), "Specify `study`")
smk_miss <- smoking
smk_miss[1, "studyn"] <- NA
expect_error(set_ipd(smk_miss, "studyn", "trtc"), "cannot contain missing values")
expect_error(set_agd_arm(smk_miss, "studyn", "trtc"), "cannot contain missing values")
expect_error(set_agd_contrast(smk_miss, "studyn", "trtc"), "cannot contain missing values")
expect_error(set_agd_surv(smk_miss, "studyn", "trtc"), "cannot contain missing values")
expect_error(set_ipd(smoking, cbind(studyn, studyn)), "must be a regular column")
expect_error(set_ipd(smoking, list(studyn)), "must be a regular column")
expect_error(set_agd_arm(smoking, cbind(studyn, studyn)), "must be a regular column")
expect_error(set_agd_arm(smoking, list(studyn)), "must be a regular column")
expect_error(set_agd_contrast(smoking, cbind(studyn, studyn)), "must be a regular column")
expect_error(set_agd_contrast(smoking, list(studyn)), "must be a regular column")
expect_error(set_agd_surv(smoking, cbind(studyn, studyn)), "must be a regular column")
expect_error(set_agd_surv(smoking, list(studyn)), "must be a regular column")
})
test_that("set_* error if single-arm studies included", {
m <- "Single-arm studies are not supported"
s <- tibble(study = c("a", "b", "b", "c"), trt = c("A", "A", "A", "B"), r = 1, n = 2, time = 1, status = 1)
expect_error(set_ipd(s, study, trt, r = r), paste0(m, '.+studies "a", "b" and "c"'))
expect_error(set_agd_arm(s, study, trt, r = r, n = n), paste0(m, '.+studies "a" and "c"'))
expect_error(set_agd_contrast(s, study, trt, y = r, se = n), paste0(m, '.+studies "a" and "c"'))
# Allowed with message for survival outcomes
expect_message(set_ipd(s, study, trt, Surv = Surv(time, status)), 'Single-arm studies present in the network: "a", "b" and "c"')
expect_message(set_agd_surv(s, study, trt, Surv = Surv(time, status)), 'Single-arm studies present in the network: "a", "b" and "c"')
})
test_that("set_* error if trt not given, missing values, or not regular 1D column", {
expect_error(set_ipd(smoking, "studyn"), "Specify `trt`")
expect_error(set_agd_arm(smoking, "studyn"), "Specify `trt`")
expect_error(set_agd_contrast(smoking, "studyn"), "Specify `trt`")
expect_error(set_agd_surv(smoking, "studyn"), "Specify `trt`")
smk_miss <- smoking
smk_miss[1, "trtc"] <- NA
expect_error(set_ipd(smk_miss, "studyn", "trtc"), "cannot contain missing values")
expect_error(set_agd_arm(smk_miss, "studyn", "trtc"), "cannot contain missing values")
expect_error(set_agd_contrast(smk_miss, "studyn", "trtc"), "cannot contain missing values")
expect_error(set_agd_surv(smk_miss, "studyn", "trtc"), "cannot contain missing values")
expect_error(set_ipd(smoking, studyn, cbind(trtc, trtc)), "must be a regular column")
expect_error(set_ipd(smoking, studyn, list(trtc)), "must be a regular column")
expect_error(set_agd_arm(smoking, studyn, cbind(trtc, trtc)), "must be a regular column")
expect_error(set_agd_arm(smoking, studyn, list(trtc)), "must be a regular column")
expect_error(set_agd_contrast(smoking, studyn, cbind(trtc, trtc)), "must be a regular column")
expect_error(set_agd_contrast(smoking, studyn, list(trtc)), "must be a regular column")
expect_error(set_agd_surv(smoking, studyn, cbind(trtc, trtc)), "must be a regular column")
expect_error(set_agd_surv(smoking, studyn, list(trtc)), "must be a regular column")
})
# Dummy data
agd_arm <- tibble(
studyn = c(1, 1, 2, 2, 2),
studyc = letters[studyn],
studyf = factor(studyc),
studyf2 = forcats::fct_rev(studyf),
trtn = c(1, 2, 1, 2, 3),
trtc = LETTERS[trtn],
trtf = factor(trtc),
trtf2 = forcats::fct_rev(trtf),
tclassn = c(1, 2, 1, 2, 2),
tclassc = letters[tclassn],
tclassf = factor(tclassc),
tclassf2 = forcats::fct_rev(tclassf),
cont = rnorm(5),
cont_pos = abs(cont),
cont_neg = -cont_pos,
cont_inf = c(cont_pos[1:4], Inf),
cont_nan = c(cont_pos[1:4], NaN),
disc = rbinom(5, 20, 0.5) + 1,
disc_p1 = disc + 1,
disc_m1 = disc - 1,
disc_neg = -disc,
disc_inf = c(disc[1:4], Inf),
disc_nan = c(disc[1:4], NaN),
disc_na = c(disc[1:4], NA),
bin = sample(c(0,0,0,0,1,1,1,1), 5)
#Surv =
)
test_that("set_agd_arm - continuous outcome checks work", {
expect_error(set_agd_arm(agd_arm, "studyn", "trtc", y = cont), "Specify standard error")
expect_error(set_agd_arm(agd_arm, "studyn", "trtc", se = cont_pos), "Specify continuous outcome `y`")
expect_error(set_agd_arm(agd_arm, "studyn", "trtc", y = trtc, se = cont_pos), "must be numeric")
expect_error(set_agd_arm(agd_arm, "studyn", "trtc", y = as.character(trtn), se = cont_pos), "must be numeric")
expect_error(set_agd_arm(agd_arm, "studyn", "trtc", y = cont, se = trtc), "must be numeric")
expect_error(set_agd_arm(agd_arm, "studyn", "trtc", y = cont, se = as.character(trtn)), "must be numeric")
expect_error(set_agd_arm(agd_arm, "studyn", "trtc", y = cont, se = cont_neg), "must be positive")
expect_error(set_agd_arm(agd_arm, "studyn", "trtc", y = cont, se = -cont_pos), "must be positive")
expect_error(set_agd_arm(agd_arm, "studyn", "trtc", y = cont, se = cont_inf), "cannot be infinite")
expect_error(set_agd_arm(agd_arm, "studyn", "trtc", y = cont, se = cont_nan), "cannot be NaN")
expect_error(set_agd_arm(agd_arm, studyn, trtc, y = cbind(cont, cont), se = cont_pos),
"must be a regular column")
expect_error(set_agd_arm(agd_arm, studyn, trtc, y = cont, se = cbind(cont_pos, cont_pos)),
"must be a regular column")
expect_equivalent(
set_agd_arm(agd_arm, "studyn", "trtc", y = cont, se = cont_pos)$agd_arm[, c(".y", ".se")],
transmute(agd_arm, .y = cont, .se = cont_pos))
})
test_that("set_agd_arm - count outcome checks work", {
expect_error(set_agd_arm(agd_arm, "studyn", "trtc", r = disc), "Specify denominator")
expect_error(set_agd_arm(agd_arm, "studyn", "trtc", n = disc_p1), "Specify outcome count `r`")
expect_error(set_agd_arm(agd_arm, "studyn", "trtc", r = trtc, n = disc_p1), "must be numeric")
expect_error(set_agd_arm(agd_arm, "studyn", "trtc", r = disc, n = trtc), "must be numeric")
expect_error(set_agd_arm(agd_arm, "studyn", "trtc", r = cont, n = disc), "must be integer")
expect_error(set_agd_arm(agd_arm, "studyn", "trtc", r = disc, n = cont), "must be integer")
expect_error(set_agd_arm(agd_arm, "studyn", "trtc", r = disc_neg, n = disc), "must be between 0 and `n`")
expect_error(set_agd_arm(agd_arm, "studyn", "trtc", r = -disc, n = disc), "must be between 0 and `n`")
expect_error(set_agd_arm(agd_arm, "studyn", "trtc", r = disc_p1, n = disc), "must be between 0 and `n`")
expect_error(set_agd_arm(agd_arm, "studyn", "trtc", r = disc, n = disc_neg), "greater than zero")
expect_error(set_agd_arm(agd_arm, "studyn", "trtc", r = disc, n = -disc), "greater than zero")
expect_error(set_agd_arm(agd_arm, "studyn", "trtc", E = cont_pos), "Specify outcome count `r`")
expect_error(set_agd_arm(agd_arm, "studyn", "trtc", r = disc, n = disc_p1, E = cont_neg), "must be positive")
expect_error(set_agd_arm(agd_arm, "studyn", "trtc", r = disc, n = disc_p1, E = -cont_pos), "must be positive")
expect_error(set_agd_arm(agd_arm, "studyn", "trtc", r = disc, n = disc_p1, E = trtc), "must be numeric")
expect_error(set_agd_arm(agd_arm, "studyn", "trtc", r = disc, n = disc_p1, E = as.character(trtn)), "must be numeric")
expect_error(set_agd_arm(agd_arm, studyn, trtc, r = cbind(disc, disc), n = disc_p1), "must be a regular column")
expect_error(set_agd_arm(agd_arm, studyn, trtc, r = disc, n = cbind(disc_p1, disc_p1)), "must be a regular column")
expect_error(set_agd_arm(agd_arm, studyn, trtc, r = disc, E = cbind(cont_pos, cont_pos)), "must be a regular column")
expect_equivalent(
set_agd_arm(agd_arm, "studyn", "trtc", r = disc, n = disc_p1)$agd_arm[, c(".r", ".n")],
transmute(agd_arm, .r = disc, .n = disc_p1))
expect_equivalent(
set_agd_arm(agd_arm, "studyn", "trtc", r = "disc", n = "disc_p1")$agd_arm[, c(".r", ".n")],
transmute(agd_arm, .r = disc, .n = disc_p1))
expect_equivalent(
set_agd_arm(agd_arm, "studyn", "trtc", r = disc, n = disc + 1)$agd_arm[, c(".r", ".n")],
transmute(agd_arm, .r = disc, .n = disc_p1))
expect_equivalent(
set_agd_arm(agd_arm, "studyn", "trtc", r = floor(disc/2), n = disc)$agd_arm[, c(".r", ".n")],
transmute(agd_arm, .r = floor(disc/2), .n = disc))
expect_equivalent(
set_agd_arm(agd_arm, "studyn", "trtc", r = disc, E = cont_pos)$agd_arm[, c(".r", ".E")],
transmute(agd_arm, .r = disc, .E = cont_pos))
expect_equivalent(
set_agd_arm(agd_arm, "studyn", "trtc", r = "disc", E = "cont_pos")$agd_arm[, c(".r", ".E")],
transmute(agd_arm, .r = disc, .E = cont_pos))
})
multi_inclusive <- tribble(~r_a, ~r_b, ~r_c,
1, 1, 1,
5, 4, 1,
5, 2, 2,
10, 5, 0,
6, 0, 0)
agd_arm_multi_i <- bind_cols(agd_arm, multi_inclusive)
multi_exclusive <- tribble(~r_a, ~r_b, ~r_c,
0, 0, 1,
1, 3, 1,
3, 0, 2,
5, 5, 0,
6, 0, 0)
agd_arm_multi_e <- bind_cols(agd_arm, multi_exclusive)
test_that("set_agd_arm - multinomial outcome checks work", {
expect_error(set_agd_arm(agd_arm, studyn, trtc, r = multi(disc)),
"At least 2 outcomes", class = "error")
expect_error(set_agd_arm(agd_arm, studyn, trtc, r = multi(disc, disc)),
"Duplicate outcome category labels", class = "error")
expect_error(set_agd_arm(agd_arm, studyn, trtc, r = multi(disc, 1:2)),
"must be the same length", class = "error")
expect_error(set_agd_arm(agd_arm, studyn, trtc, r = multi(disc, disc_inf)),
"cannot be Inf", class = "error")
expect_error(set_agd_arm(agd_arm, studyn, trtc, r = multi(disc, disc_nan)),
"cannot be NaN", class = "error")
expect_error(set_agd_arm(agd_arm, studyn, trtc, r = multi(disc, trtc)),
"must be numeric", class = "error")
expect_error(set_agd_arm(agd_arm, studyn, trtc, r = multi(disc, cont_pos)),
"must be integer", class = "error")
expect_error(set_agd_arm(agd_arm, studyn, trtc, r = multi(disc, disc_neg)),
"must be non-negative", class = "error")
expect_error(set_agd_arm(agd_arm_multi_i, studyn, trtc, r = multi(r_c, r_b, r_a, inclusive = TRUE)),
"must be decreasing or constant", class = "error")
expect_equivalent(unclass(set_agd_arm(agd_arm_multi_i, studyn, trtc, r = multi(r_a, r_b, r_c, inclusive = TRUE))$agd_arm$.r),
as.matrix(multi_exclusive))
expect_equivalent(unclass(set_agd_arm(agd_arm_multi_e, studyn, trtc, r = multi(r_a, r_b, r_c, inclusive = FALSE))$agd_arm$.r),
as.matrix(multi_exclusive))
})
test_that("set_agd_arm - sample size checks work", {
expect_error(set_agd_arm(agd_arm, studyn, trtc, y = cont, se = cont_pos, sample_size = trtc),
"must be numeric")
expect_error(set_agd_arm(agd_arm, studyn, trtc, y = cont, se = cont_pos, sample_size = as.character(trtn)),
"must be numeric")
expect_error(set_agd_arm(agd_arm, studyn, trtc, y = cont, se = cont_pos, sample_size = cont),
"must be integer")
expect_error(set_agd_arm(agd_arm, studyn, trtc, y = cont, se = cont_pos, sample_size = disc_neg),
"must be greater than zero")
expect_error(set_agd_arm(agd_arm, studyn, trtc, y = cont, se = cont_pos, sample_size = -disc),
"must be greater than zero")
expect_error(set_agd_arm(agd_arm, studyn, trtc, y = cont, se = cont_pos, sample_size = disc_inf),
"cannot be infinite")
expect_error(set_agd_arm(agd_arm, studyn, trtc, y = cont, se = cont_pos, sample_size = disc_nan),
"cannot be NaN")
expect_error(set_agd_arm(agd_arm, studyn, trtc, y = cont, se = cont_pos, sample_size = cbind(disc, disc)),
"must be a regular column")
expect_error(set_agd_arm(agd_arm, studyn, trtc, y = cont, se = cont_pos, sample_size = list(disc)),
"must be a regular column")
expect_message(set_agd_arm(agd_arm, studyn, trtc, y = cont, se = cont_pos), "`sample_size` not provided")
expect_equal(set_agd_arm(agd_arm, studyn, trtc, r = disc, n = disc_p1)$agd_arm$.sample_size, agd_arm$disc_p1)
expect_equal(set_agd_arm(agd_arm, studyn, trtc, r = floor(disc/2), n = disc, sample_size = disc + 1)$agd_arm$.sample_size, agd_arm$disc_p1)
expect_equal(set_agd_arm(agd_arm_multi_i, studyn, trtc, r = multi(r_a, r_b, r_c, inclusive = TRUE))$agd_arm$.sample_size, multi_inclusive$r_a)
expect_equal(set_agd_arm(agd_arm_multi_e, studyn, trtc, r = multi(r_a, r_b, r_c, inclusive = FALSE))$agd_arm$.sample_size, multi_inclusive$r_a)
})
test_that("set_ipd - continuous outcome checks work", {
expect_error(set_ipd(agd_arm, "studyn", "trtc", y = trtc), "must be numeric")
expect_error(set_ipd(agd_arm, "studyn", "trtc", y = as.character(trtn)), "must be numeric")
expect_error(set_ipd(agd_arm, "studyn", "trtc", y = cbind(cont, cont)), "must be a regular column")
expect_error(set_ipd(agd_arm, "studyn", "trtc", y = list(cont)), "must be a regular column")
expect_equivalent(
set_ipd(agd_arm, "studyn", "trtc", y = cont)$ipd[, ".y"],
transmute(agd_arm, .y = cont))
expect_equivalent(
set_ipd(agd_arm, "studyn", "trtc", y = "cont")$ipd[, ".y"],
transmute(agd_arm, .y = cont))
expect_equivalent(
set_ipd(agd_arm, "studyn", "trtc", y = cont/2)$ipd[, ".y"],
transmute(agd_arm, .y = cont/2))
})
test_that("set_ipd - binary outcome checks work", {
expect_error(set_ipd(agd_arm, "studyn", "trtc", r = trtc), "must be numeric")
expect_error(set_ipd(agd_arm, "studyn", "trtc", r = as.character(trtn)), "must be numeric")
expect_error(set_ipd(agd_arm, "studyn", "trtc", r = cont), "must equal 0 or 1")
expect_error(set_ipd(agd_arm, "studyn", "trtc", r = disc_neg), "must equal 0 or 1")
expect_error(set_ipd(agd_arm, "studyn", "trtc", r = bin + 1), "must equal 0 or 1")
expect_error(set_ipd(agd_arm, "studyn", "trtc", E = cont_pos), "Specify count `r`")
expect_error(set_ipd(agd_arm, "studyn", "trtc", r = bin, E = cont_neg), "must be positive")
expect_error(set_ipd(agd_arm, "studyn", "trtc", r = bin, E = -cont_pos), "must be positive")
expect_error(set_ipd(agd_arm, "studyn", "trtc", r = bin, E = trtc), "must be numeric")
expect_error(set_ipd(agd_arm, "studyn", "trtc", r = bin, E = as.character(trtn)), "must be numeric")
expect_error(set_ipd(agd_arm, "studyn", "trtc", r = cbind(bin, bin)), "must be a regular column")
expect_error(set_ipd(agd_arm, "studyn", "trtc", r = cbind(bin, bin), E = cont_pos), "must be a regular column")
expect_error(set_ipd(agd_arm, "studyn", "trtc", r = bin, E = cbind(cont_pos, cont_pos)), "must be a regular column")
expect_equivalent(
set_ipd(agd_arm, "studyn", "trtc", r = bin, E = cont_pos)$ipd[, c(".r", ".E")],
transmute(agd_arm, .r = bin, .E = cont_pos))
expect_equivalent(
set_ipd(agd_arm, "studyn", "trtc", r = "bin", E = "cont_pos")$ipd[, c(".r", ".E")],
transmute(agd_arm, .r = bin, .E = cont_pos))
expect_equivalent(
set_ipd(agd_arm, "studyn", "trtc", r = bin, E = cont_pos/2)$ipd[, c(".r", ".E")],
transmute(agd_arm, .r = bin, .E = cont_pos/2))
})
test_that("set_ipd - multinomial outcome checks work", {
expect_error(set_ipd(agd_arm, studyn, trtc, r = multi(bin)),
"At least 2 outcomes", class = "error")
expect_error(set_ipd(agd_arm, studyn, trtc, r = multi(bin, bin)),
"Duplicate outcome category labels", class = "error")
expect_error(set_ipd(agd_arm, studyn, trtc, r = multi(bin, 1:2)),
"must be the same length", class = "error")
expect_error(set_ipd(agd_arm, studyn, trtc, r = multi(disc, disc_inf)),
"cannot be Inf", class = "error")
expect_error(set_ipd(agd_arm, studyn, trtc, r = multi(disc, disc_nan)),
"cannot be NaN", class = "error")
expect_error(set_ipd(agd_arm, studyn, trtc, r = multi(disc, trtc)),
"must be numeric", class = "error")
expect_error(set_ipd(agd_arm, studyn, trtc, r = multi(bin, bin + 1)),
"must equal 0 or 1", class = "error")
expect_error(set_ipd(agd_arm, studyn, trtc, r = multi(bin, -bin)),
"must be non-negative", class = "error")
i_multi_inclusive <- tribble(~r_a, ~r_b, ~r_c,
1, 1, 1,
1, 1, 0,
1, 0, 0,
1, 1, NA,
1, NA, 0)
ipd_multi_i <- bind_cols(agd_arm, i_multi_inclusive)
i_multi_exclusive <- tribble(~r_a, ~r_b, ~r_c,
0, 0, 1,
0, 1, 0,
1, 0, 0,
0, 1, NA,
1, NA, 0)
ipd_multi_e <- bind_cols(agd_arm, i_multi_exclusive)
expect_error(set_ipd(ipd_multi_i[-4,], study = I(1), trtc, r = multi(r_c, r_b, r_a, inclusive = TRUE)),
"must be decreasing or constant", class = "error")
expect_error(set_ipd(ipd_multi_i[-c(4,5),], study = I(1), trtc, r = multi(r_b, r_c, inclusive = TRUE)),
"Individual without outcomes in any category, row 3", class = "error")
expect_equivalent(unclass(set_ipd(ipd_multi_i, studyn, trtc, r = multi(r_a, r_b, r_c, inclusive = TRUE))$ipd$.r),
as.matrix(i_multi_exclusive))
expect_error(set_ipd(ipd_multi_e[-c(4,5),], study = I(1), trtc, r = multi(r_b, r_c, inclusive = FALSE)),
"Individual without outcomes in any category, row 3", class = "error")
expect_error(set_ipd(ipd_multi_e, studyn, trtc, r = multi(c = 1, r_a, r_b, inclusive = FALSE)),
"Individuals with outcomes in more than one category, rows 2, 3, 4 and 5", class = "error")
expect_equivalent(unclass(set_ipd(ipd_multi_e, studyn, trtc, r = multi(r_a, r_b, r_c, inclusive = FALSE))$ipd$.r),
as.matrix(i_multi_exclusive))
})
test_that("set_ipd - survival outcome checks work", {
expect_error(set_ipd(agd_arm, "studyn", "trtc", Surv = trtc), "must be a `Surv` object")
expect_equivalent(
set_ipd(agd_arm, "studyn", "trtc", Surv = Surv(cont_pos, bin))$ipd[[".Surv"]],
with(agd_arm, Surv(cont_pos, bin)))
expect_equivalent(
set_ipd(agd_arm, "studyn", "trtc", Surv = Surv(cont_pos, cont_pos + 1, bin))$ipd[[".Surv"]],
with(agd_arm, Surv(cont_pos, cont_pos + 1, bin)))
expect_equivalent(
set_ipd(agd_arm, "studyn", "trtc", Surv = Surv(cont_pos, cont_pos + 1, c(0, 1, 3, 3, 3), type = "interval"))$ipd[[".Surv"]],
with(agd_arm, Surv(cont_pos, cont_pos + 1, c(0, 1, 3, 3, 3), type = "interval")))
expect_error(set_ipd(agd_arm, "studyn", "trtc", Surv = Surv(cont_pos, bin, type = "mstate")), 'type "mright" is not supported')
expect_error(set_ipd(agd_arm, "studyn", "trtc", Surv = Surv(cont_neg, bin)), "must have strictly positive outcome times")
expect_error(set_ipd(agd_arm, "studyn", "trtc", Surv = Surv(cont_inf, bin)), "infinite times")
expect_error(set_ipd(agd_arm, "studyn", "trtc", Surv = Surv(cont_nan, bin)), "missing times")
expect_error(set_ipd(agd_arm, "studyn", "trtc", Surv = Surv(cont_neg, cont_pos, bin)), "must have non-negative start times")
expect_error(set_ipd(agd_arm, "studyn", "trtc", Surv = Surv(cont_neg, cont_pos, c(3, 3, 3, 3, 3), type = "interval")), "must have non-negative start times")
expect_error(set_ipd(agd_arm, "studyn", "trtc", Surv = Surv(cont_pos, rep_len(c(0, 1, NA), nrow(agd_arm)))), "missing event status values")
expect_error(set_ipd(agd_arm, "studyn", "trtc", Surv = Surv("a", bin)), "not numeric")
expect_error(suppressWarnings(set_ipd(agd_arm, "studyn", "trtc", Surv = Surv(cont_pos, cont_pos/2, bin))), "missing times")
expect_error(suppressWarnings(set_ipd(agd_arm, "studyn", "trtc", Surv = Surv(cont_pos, cont_pos*2, bin*5, type = "interval"))), "missing event status values")
})
test_that("set_agd_surv - survival outcome checks work", {
expect_error(set_agd_surv(agd_arm, "studyn", "trtc", Surv = trtc), "must be a `Surv` object")
expect_equivalent(
tidyr::unnest(set_agd_surv(agd_arm, "studyn", "trtc", Surv = Surv(cont_pos, bin))$agd_arm, ".Surv")$.Surv,
with(agd_arm, Surv(cont_pos, bin)))
expect_equivalent(
tidyr::unnest(set_agd_surv(agd_arm, "studyn", "trtc", Surv = Surv(cont_pos, cont_pos + 1, bin))$agd_arm, ".Surv")$.Surv,
with(agd_arm, Surv(cont_pos, cont_pos + 1, bin)))
expect_equivalent(
tidyr::unnest(set_agd_surv(agd_arm, "studyn", "trtc", Surv = Surv(cont_pos, cont_pos + 1, c(0, 1, 3, 3, 3), type = "interval"))$agd_arm, ".Surv")$.Surv,
with(agd_arm, Surv(cont_pos, cont_pos + 1, c(0, 1, 3, 3, 3), type = "interval")))
expect_equivalent(
tidyr::unnest(set_agd_surv(ndmm_agd, studyf, trtf, Surv = Surv(eventtime, status))$agd_arm, ".Surv")$.Surv,
with(ndmm_agd, Surv(eventtime, status)))
expect_equivalent(
tidyr::unnest(set_agd_surv(ndmm_agd, studyf, trtf,
Surv = Surv(eventtime, status),
covariates = ndmm_agd_covs)$agd_arm, ".Surv")$.Surv,
with(ndmm_agd, Surv(eventtime, status)))
expect_error(set_agd_surv(agd_arm, "studyn", "trtc", Surv = Surv(cont_pos, bin, type = "mstate")), 'type "mright" is not supported')
expect_error(set_agd_surv(agd_arm, "studyn", "trtc", Surv = Surv(cont_neg, bin)), "must have strictly positive outcome times")
expect_error(set_agd_surv(agd_arm, "studyn", "trtc", Surv = Surv(cont_inf, bin)), "infinite times")
expect_error(set_agd_surv(agd_arm, "studyn", "trtc", Surv = Surv(cont_nan, bin)), "missing times")
expect_error(set_agd_surv(agd_arm, "studyn", "trtc", Surv = Surv(cont_neg, cont_pos, bin)), "must have non-negative start times")
expect_error(set_agd_surv(agd_arm, "studyn", "trtc", Surv = Surv(cont_neg, cont_pos, c(3, 3, 3, 3, 3), type = "interval")), "must have non-negative start times")
expect_error(set_agd_surv(agd_arm, "studyn", "trtc", Surv = Surv(cont_pos, rep_len(c(0, 1, NA), nrow(agd_arm)))), "missing event status values")
expect_error(set_agd_surv(agd_arm, "studyn", "trtc", Surv = Surv("a", bin)), "not numeric")
expect_error(suppressWarnings(set_agd_surv(agd_arm, "studyn", "trtc", Surv = Surv(cont_pos, cont_pos/2, bin))), "missing times")
expect_error(suppressWarnings(set_agd_surv(agd_arm, "studyn", "trtc", Surv = Surv(cont_pos, cont_pos*2, bin*5, type = "interval"))), "missing event status values")
})
test_that("set_agd_surv - covariate checks work", {
expect_error(set_agd_surv(ndmm_agd, studyf, trtf, Surv = Surv(eventtime, status), covariates = list()), "should be a data frame")
expect_equivalent(
dplyr::select(set_agd_surv(ndmm_agd, studyf, trtf, Surv = Surv(eventtime, status),
covariates = ndmm_agd_covs)$agd_arm,
study, trt, sample_size = .sample_size,
age_min:male) %>%
dplyr::arrange(study, trt),
dplyr::select(ndmm_agd_covs, -studyf, -trtf))
expect_error(set_agd_surv(ndmm_agd, studyf, trtf, Surv = Surv(eventtime, status),
covariates = ndmm_agd_covs[-1,]),
"Not all study arms in `data` have matching rows in `covariates`")
})
# Dummy contrast data
agd_contrast <- agd_arm %>%
group_by(studyn) %>%
mutate(arm = 1:n(),
ydiff = if_else(arm == 1, NA_real_, cont - first(cont)),
ydiff_chr = if_else(arm == 1, NA_character_, trtc),
ydiff_multi = if_else(arm %in% 1:2, NA_real_, cont - first(cont)),
sediff = if_else(arm == 1, cont_pos, sqrt(cont_pos^2 + first(cont_pos)^2)),
sediff_miss = if_else(arm == 1, NA_real_, sqrt(cont_pos^2 + first(cont_pos)^2))) %>%
ungroup()
test_that("set_agd_contrast - continuous outcome checks work", {
expect_error(set_agd_contrast(agd_contrast, "studyn", "trtc", y = ydiff), "Specify standard error")
expect_error(set_agd_contrast(agd_contrast, "studyn", "trtc", se = sediff), "Specify continuous outcome `y`")
expect_error(set_agd_contrast(agd_contrast, "studyn", "trtc", y = ydiff_chr, se = sediff), "must be numeric")
expect_error(set_agd_contrast(agd_contrast, "studyn", "trtc", y = as.character(ydiff), se = sediff), "must be numeric")
expect_error(set_agd_contrast(agd_contrast, "studyn", "trtc", y = ydiff, se = trtc), "must be numeric")
expect_error(set_agd_contrast(agd_contrast, "studyn", "trtc", y = ydiff, se = as.character(sediff)), "must be numeric")
expect_error(set_agd_contrast(agd_contrast, "studyn", "trtc", y = ydiff, se = cont_neg), "must be positive")
expect_error(set_agd_contrast(agd_contrast, "studyn", "trtc", y = ydiff, se = -cont_pos), "must be positive")
expect_error(set_agd_contrast(agd_contrast, "studyn", "trtc", y = ydiff, se = cont_inf), "cannot be infinite")
expect_error(set_agd_contrast(agd_contrast, "studyn", "trtc", y = ydiff, se = cont_nan), "cannot be NaN")
expect_error(set_agd_contrast(agd_contrast, "studyn", "trtc", y = trtn, se = sediff), "without a specified baseline arm")
expect_error(set_agd_contrast(agd_contrast, "studyn", "trtc", y = ydiff_multi, se = sediff), "Multiple baseline arms")
expect_error(set_agd_contrast(agd_contrast, "studyn", "trtc", y = ydiff, se = sediff_miss), "Standard error.+missing values on baseline arms")
expect_error(set_agd_contrast(agd_contrast, "studyn", "trtc", y = cbind(ydiff, ydiff), se = sediff), "must be a regular column")
expect_error(set_agd_contrast(agd_contrast, "studyn", "trtc", y = ydiff, se = cbind(sediff, sediff)), "must be a regular column")
expect_equivalent(set_agd_contrast(agd_contrast, "studyn", "trtc", y = ydiff, se = sediff)$agd_contrast[, c(".y", ".se")],
transmute(agd_contrast, .y = ydiff, .se = sediff))
expect_equivalent(set_agd_contrast(agd_contrast, "studyn", "trtc", y = "ydiff", se = "sediff")$agd_contrast[, c(".y", ".se")],
transmute(agd_contrast, .y = ydiff, .se = sediff))
expect_equivalent(set_agd_contrast(agd_contrast, "studyn", "trtc", y = ydiff/2, se = sediff)$agd_contrast[, c(".y", ".se")],
transmute(agd_contrast, .y = ydiff/2, .se = sediff))
})
test_that("set_agd_contrast - sample size checks work", {
expect_error(set_agd_contrast(agd_contrast, studyn, trtc, y = ydiff, se = sediff, sample_size = trtc),
"must be numeric")
expect_error(set_agd_contrast(agd_contrast, studyn, trtc, y = ydiff, se = sediff, sample_size = as.character(trtn)),
"must be numeric")
expect_error(set_agd_contrast(agd_contrast, studyn, trtc, y = ydiff, se = sediff, sample_size = cont),
"must be integer")
expect_error(set_agd_contrast(agd_contrast, studyn, trtc, y = ydiff, se = sediff, sample_size = cont/2),
"must be integer")
expect_error(set_agd_contrast(agd_contrast, studyn, trtc, y = ydiff, se = sediff, sample_size = disc_neg),
"must be greater than zero")
expect_error(set_agd_contrast(agd_contrast, studyn, trtc, y = ydiff, se = sediff, sample_size = -disc),
"must be greater than zero")
expect_error(set_agd_contrast(agd_contrast, studyn, trtc, y = ydiff, se = sediff, sample_size = disc_inf),
"cannot be infinite")
expect_error(set_agd_contrast(agd_contrast, studyn, trtc, y = ydiff, se = sediff, sample_size = disc_nan),
"cannot be NaN")
expect_error(set_agd_contrast(agd_contrast, studyn, trtc, y = ydiff, se = sediff, sample_size = cbind(disc, disc)),
"must be a regular column")
expect_error(set_agd_contrast(agd_contrast, studyn, trtc, y = ydiff, se = sediff, sample_size = list(disc)),
"must be a regular column")
expect_message(set_agd_contrast(agd_contrast, studyn, trtc, y = ydiff, se = sediff), "`sample_size` not provided")
})
test_that("set_agd_contrast - positive definite check", {
agd_contrast_nonpd <- agd_contrast %>%
group_by(studyn) %>%
mutate(sediff = if_else(arm == 1, max(cont_pos)*2, sqrt(cont_pos^2 + first(cont_pos)^2))) %>%
ungroup()
expect_error(set_agd_contrast(agd_contrast_nonpd, studyn, trtc, y = ydiff, se = sediff),
'not positive definite for study "2"')
expect_error(set_agd_contrast(agd_contrast_nonpd, studyc, trtc, y = ydiff, se = sediff),
'not positive definite for study "b"')
agd_contrast_nonpd2 <- bind_rows(agd_contrast_nonpd,
filter(agd_contrast_nonpd, studyn == 2) %>% mutate(studyn = 3, studyc = "c"))
expect_error(set_agd_contrast(agd_contrast_nonpd2, studyn, trtc, y = ydiff, se = sediff),
'not positive definite for studies "2" and "3"')
expect_error(set_agd_contrast(agd_contrast_nonpd2, studyc, trtc, y = ydiff, se = sediff),
'not positive definite for studies "b" and "c"')
})
test_that("set_* - take one and only one outcome", {
m <- "specify one and only one outcome"
expect_error(set_ipd(agd_arm, "studyn", "trtc", r = bin, y = cont), m)
expect_error(set_agd_arm(agd_arm, "studyn", "trtc", r = disc, n = disc_p1, y = cont, se = cont_pos), m)
# expect_error(set_agd_contrast(agd_contrast, "studyn", "trtc"), m)
})
# Reference treatment for survival outcomes tie-breaks by longest follow-up
bmax <- max(subset(agd_arm$cont_pos, agd_arm$trtf == "B")) > max(subset(agd_arm$cont_pos, agd_arm$trtf == "A"))
test_that("set_* `.trt` column is correct", {
expect_equal(set_ipd(agd_arm, studyc, trtc, y = cont)$ipd$.trt,
agd_arm$trtf)
expect_equal(set_agd_arm(agd_arm, studyc, trtc, y = cont, se = cont_pos)$agd_arm$.trt,
agd_arm$trtf)
expect_equal(set_agd_contrast(agd_contrast, studyc, trtc, y = ydiff, se = sediff)$agd_contrast$.trt,
agd_contrast$trtf)
expect_equal(set_agd_surv(agd_arm, studyc, trtc, Surv = Surv(cont_pos, bin))$agd_arm$.trt,
if (bmax) forcats::fct_relevel(agd_arm$trtf, "B", "A", "C") else agd_arm$trtf)
expect_equal(set_ipd(agd_arm, studyc, 6, y = cont)$ipd$.trt,
agd_arm$trtf)
expect_equal(set_agd_arm(agd_arm, studyc, 6, y = cont, se = cont_pos)$agd_arm$.trt,
agd_arm$trtf)
expect_equal(set_agd_contrast(agd_contrast, studyc, 6, y = ydiff, se = sediff)$agd_contrast$.trt,
agd_contrast$trtf)
expect_equal(set_agd_surv(agd_arm, studyc, 6, Surv = Surv(cont_pos, bin))$agd_arm$.trt,
if (bmax) forcats::fct_relevel(agd_arm$trtf, "B", "A", "C") else agd_arm$trtf)
expect_equal(set_ipd(agd_arm, studyc, "trtc", y = cont)$ipd$.trt,
agd_arm$trtf)
expect_equal(set_agd_arm(agd_arm, studyc, "trtc", y = cont, se = cont_pos)$agd_arm$.trt,
agd_arm$trtf)
expect_equal(set_agd_contrast(agd_contrast, studyc, "trtc", y = ydiff, se = sediff)$agd_contrast$.trt,
agd_contrast$trtf)
expect_equal(set_agd_surv(agd_arm, studyc, "trtc", Surv = Surv(cont_pos, bin))$agd_arm$.trt,
if (bmax) forcats::fct_relevel(agd_arm$trtf, "B", "A", "C") else agd_arm$trtf)
expect_equal(set_ipd(agd_arm, studyc, factor(trtc), y = cont)$ipd$.trt,
agd_arm$trtf)
expect_equal(set_agd_arm(agd_arm, studyc, factor(trtc), y = cont, se = cont_pos)$agd_arm$.trt,
agd_arm$trtf)
expect_equal(set_agd_contrast(agd_contrast, studyc, factor(trtc), y = ydiff, se = sediff)$agd_contrast$.trt,
agd_contrast$trtf)
expect_equal(set_agd_surv(agd_arm, studyc, factor(trtc), Surv = Surv(cont_pos, bin))$agd_arm$.trt,
if (bmax) forcats::fct_relevel(agd_arm$trtf, "B", "A", "C") else agd_arm$trtf)
expect_equal(set_ipd(agd_arm, studyc, trtf, y = cont)$ipd$.trt,
agd_arm$trtf)
expect_equal(set_agd_arm(agd_arm, studyc, trtf, y = cont, se = cont_pos)$agd_arm$.trt,
agd_arm$trtf)
expect_equal(set_agd_contrast(agd_contrast, studyf, trtf, y = ydiff, se = sediff)$agd_contrast$.trt,
agd_contrast$trtf)
expect_equal(set_agd_surv(agd_arm, studyc, trtf, Surv = Surv(cont_pos, bin))$agd_arm$.trt,
if (bmax) forcats::fct_relevel(agd_arm$trtf, "B", "A", "C") else agd_arm$trtf)
expect_equal(set_ipd(agd_arm, studyc, trtf2, y = cont, trt_ref = "C")$ipd$.trt,
agd_arm$trtf2)
expect_equal(set_agd_arm(agd_arm, studyc, trtf2, y = cont, se = cont_pos, trt_ref = "C")$agd_arm$.trt,
agd_arm$trtf2)
expect_equal(set_agd_contrast(agd_contrast, studyf, trtf2, y = ydiff, se = sediff, trt_ref = "C")$agd_contrast$.trt,
agd_contrast$trtf2)
expect_equal(set_agd_surv(agd_arm, studyc, trtf2, Surv = Surv(cont_pos, bin), trt_ref = "C")$agd_arm$.trt,
agd_arm$trtf2)
# Check that unused factor levels are dropped
expect_equal(set_ipd(agd_arm, studyc, forcats::fct_expand(trtf, "zzz"), y = cont)$ipd$.trt,
agd_arm$trtf)
expect_equal(set_agd_arm(agd_arm, studyc, forcats::fct_expand(trtf, "zzz"), y = cont, se = cont_pos)$agd_arm$.trt,
agd_arm$trtf)
expect_equal(set_agd_contrast(agd_contrast, studyf, forcats::fct_expand(trtf, "zzz"), y = ydiff, se = sediff)$agd_contrast$.trt,
agd_contrast$trtf)
expect_equal(set_agd_surv(agd_arm, studyc, forcats::fct_expand(trtf, "zzz"), Surv = Surv(cont_pos, bin))$agd_arm$.trt,
if (bmax) forcats::fct_relevel(agd_arm$trtf, "B", "A", "C") else agd_arm$trtf)
expect_equal(set_ipd(agd_arm, studyc, forcats::fct_expand(trtf2, "zzz"), y = cont, trt_ref = "C")$ipd$.trt,
agd_arm$trtf2)
expect_equal(set_agd_arm(agd_arm, studyc, forcats::fct_expand(trtf2, "zzz"), y = cont, se = cont_pos, trt_ref = "C")$agd_arm$.trt,
agd_arm$trtf2)
expect_equal(set_agd_contrast(agd_contrast, studyf, forcats::fct_expand(trtf2, "zzz"), y = ydiff, se = sediff, trt_ref = "C")$agd_contrast$.trt,
agd_contrast$trtf2)
expect_equal(set_agd_surv(agd_arm, studyc, forcats::fct_expand(trtf2, "zzz"), Surv = Surv(cont_pos, bin), trt_ref = "C")$agd_arm$.trt,
agd_arm$trtf2)
})
test_that("set_* `.study` column is correct", {
expect_equal(set_ipd(agd_arm, studyc, trtc, y = cont)$ipd$.study,
agd_arm$studyf)
expect_equal(set_agd_arm(agd_arm, studyc, trtc, y = cont, se = cont_pos)$agd_arm$.study,
agd_arm$studyf)
expect_equal(set_agd_contrast(agd_contrast, studyc, trtc, y = ydiff, se = sediff)$agd_contrast$.study,
agd_contrast$studyf)
expect_equal(set_agd_surv(agd_arm, studyc, trtc, Surv = Surv(cont_pos, bin))$agd_arm$.study,
agd_arm$studyf)
expect_equal(set_ipd(agd_arm, 2, trtc, y = cont)$ipd$.study,
agd_arm$studyf)
expect_equal(set_agd_arm(agd_arm, 2, trtc, y = cont, se = cont_pos)$agd_arm$.study,
agd_arm$studyf)
expect_equal(set_agd_contrast(agd_contrast, 2, trtc, y = ydiff, se = sediff)$agd_contrast$.study,
agd_contrast$studyf)
expect_equal(set_agd_surv(agd_arm, 2, trtc, Surv = Surv(cont_pos, bin))$agd_arm$.study,
agd_arm$studyf)
expect_equal(set_ipd(agd_arm, "studyc", trtc, y = cont)$ipd$.study,
agd_arm$studyf)
expect_equal(set_agd_arm(agd_arm, "studyc", trtc, y = cont, se = cont_pos)$agd_arm$.study,
agd_arm$studyf)
expect_equal(set_agd_contrast(agd_contrast, "studyc", trtc, y = ydiff, se = sediff)$agd_contrast$.study,
agd_contrast$studyf)
expect_equal(set_agd_surv(agd_arm, "studyc", trtc, Surv = Surv(cont_pos, bin))$agd_arm$.study,
agd_arm$studyf)
expect_equal(set_ipd(agd_arm, factor(studyc), trtc, y = cont)$ipd$.study,
agd_arm$studyf)
expect_equal(set_agd_arm(agd_arm, factor(studyc), trtc, y = cont, se = cont_pos)$agd_arm$.study,
agd_arm$studyf)
expect_equal(set_agd_contrast(agd_contrast, factor(studyc), trtc, y = ydiff, se = sediff)$agd_contrast$.study,
agd_contrast$studyf)
expect_equal(set_agd_surv(agd_arm, factor(studyc), trtc, Surv = Surv(cont_pos, bin))$agd_arm$.study,
agd_arm$studyf)
expect_equal(set_ipd(agd_arm, studyf, trtc, y = cont)$ipd$.study,
agd_arm$studyf)
expect_equal(set_agd_arm(agd_arm, studyf, trtc, y = cont, se = cont_pos)$agd_arm$.study,
agd_arm$studyf)
expect_equal(set_agd_contrast(agd_contrast, studyf, trtc, y = ydiff, se = sediff)$agd_contrast$.study,
agd_contrast$studyf)
expect_equal(set_agd_surv(agd_arm, studyf, trtc, Surv = Surv(cont_pos, bin))$agd_arm$.study,
agd_arm$studyf)
expect_equal(set_ipd(agd_arm, studyf2, trtc, y = cont)$ipd$.study,
agd_arm$studyf2)
expect_equal(set_agd_arm(agd_arm, studyf2, trtc, y = cont, se = cont_pos)$agd_arm$.study,
agd_arm$studyf2)
expect_equal(set_agd_contrast(agd_contrast, studyf2, trtc, y = ydiff, se = sediff)$agd_contrast$.study,
agd_contrast$studyf2)
expect_equal(set_agd_surv(agd_arm, studyf2, trtc, Surv = Surv(cont_pos, bin))$agd_arm$.study,
agd_arm$studyf2)
# Check that unused levels are dropped
expect_equal(set_ipd(agd_arm, forcats::fct_expand(studyf, "zzz"), trtc, y = cont)$ipd$.study,
agd_arm$studyf)
expect_equal(set_agd_arm(agd_arm, forcats::fct_expand(studyf, "zzz"), trtc, y = cont, se = cont_pos)$agd_arm$.study,
agd_arm$studyf)
expect_equal(set_agd_contrast(agd_contrast, forcats::fct_expand(studyf, "zzz"), trtc, y = ydiff, se = sediff)$agd_contrast$.study,
agd_contrast$studyf)
expect_equal(set_agd_surv(agd_arm, forcats::fct_expand(studyf, "zzz"), trtc, Surv = Surv(cont_pos, bin))$agd_arm$.study,
agd_arm$studyf)
expect_equal(set_ipd(agd_arm, forcats::fct_expand(studyf2, "zzz"), trtc, y = cont)$ipd$.study,
agd_arm$studyf2)
expect_equal(set_agd_arm(agd_arm, forcats::fct_expand(studyf2, "zzz"), trtc, y = cont, se = cont_pos)$agd_arm$.study,
agd_arm$studyf2)
expect_equal(set_agd_contrast(agd_contrast, forcats::fct_expand(studyf2, "zzz"), trtc, y = ydiff, se = sediff)$agd_contrast$.study,
agd_contrast$studyf2)
expect_equal(set_agd_surv(agd_arm, forcats::fct_expand(studyf2, "zzz"), trtc, Surv = Surv(cont_pos, bin))$agd_arm$.study,
agd_arm$studyf2)
# Check reserved column names handled correctly
aa <- mutate(agd_arm, .study = studyc)
ac <- mutate(agd_contrast, .study = studyc)
expect_equal(set_ipd(aa, .study, trtc, y = cont)$ipd$.study,
agd_arm$studyf)
expect_equal(set_agd_arm(aa, .study, trtc, y = cont, se = cont_pos)$agd_arm$.study,
agd_arm$studyf)
expect_equal(set_agd_contrast(ac, .study, trtc, y = ydiff, se = sediff)$agd_contrast$.study,
agd_contrast$studyf)
expect_equal(set_agd_surv(aa, .study, trtc, Surv = Surv(cont_pos, bin))$agd_arm$.study,
agd_arm$studyf)
expect_equal(set_agd_surv(aa, .study, trtc, Surv = Surv(cont_pos, bin), covariates = aa)$agd_arm$.study,
agd_arm$studyf)
expect_equal(set_ipd(aa, 26, trtc, y = cont)$ipd$.study,
agd_arm$studyf)
expect_equal(set_agd_arm(aa, 26, trtc, y = cont, se = cont_pos)$agd_arm$.study,
agd_arm$studyf)
expect_equal(set_agd_contrast(ac, 32, trtc, y = ydiff, se = sediff)$agd_contrast$.study,
agd_contrast$studyf)
expect_equal(set_agd_surv(aa, 26, trtc, Surv = Surv(cont_pos, bin))$agd_arm$.study,
agd_arm$studyf)
expect_equal(set_agd_surv(aa, 26, trtc, Surv = Surv(cont_pos, bin), covariates = aa)$agd_arm$.study,
agd_arm$studyf)
})
test_that("set_* return default `treatments` factor", {
expect_equal(set_ipd(agd_arm, studyc, trtc, y = cont)$treatments,
.default(factor(LETTERS[1:3])))
expect_equal(set_agd_arm(agd_arm, studyc, trtc, y = cont, se = cont_pos)$treatments,
.default(factor(LETTERS[1:3])))
expect_equal(set_agd_contrast(agd_contrast, studyc, trtc, y = ydiff, se = sediff)$treatments,
.default(factor(LETTERS[1:3])))
expect_equal(set_agd_surv(agd_arm, studyc, trtc, Surv = Surv(cont_pos, bin))$treatments,
if (bmax) .default(factor(c("B", "A", "C"), levels = c("B", "A", "C"))) else .default(factor(LETTERS[1:3])))
})
test_that("set_* can set `trt_ref`", {
f_BAC <- factor(LETTERS[c(2,1,3)], levels = LETTERS[c(2,1,3)])
expect_equal(set_ipd(agd_arm, studyc, trtc, y = cont, trt_ref = "B")$treatments,
f_BAC)
expect_equal(set_agd_arm(agd_arm, studyc, trtc, y = cont, se = cont_pos, trt_ref = "B")$treatments,
f_BAC)
expect_equal(set_agd_contrast(agd_contrast, studyc, trtc, y = ydiff, se = sediff, trt_ref = "B")$treatments,
f_BAC)
expect_equal(set_agd_surv(agd_arm, studyc, trtc, Surv = Surv(cont_pos, bin), trt_ref = "B")$treatments,
f_BAC)
expect_equal(set_ipd(agd_arm, studyc, trtc, y = cont, trt_ref = factor("B"))$treatments,
f_BAC)
expect_equal(set_agd_arm(agd_arm, studyc, trtc, y = cont, se = cont_pos, trt_ref = factor("B"))$treatments,
f_BAC)
expect_equal(set_agd_contrast(agd_contrast, studyc, trtc, y = ydiff, se = sediff, trt_ref = factor("B"))$treatments,
f_BAC)
expect_equal(set_agd_surv(agd_arm, studyc, trtc, Surv = Surv(cont_pos, bin), trt_ref = factor("B"))$treatments,
f_BAC)
# Using trtf sets original_levels attribute
attr(f_BAC, "original_levels") <- LETTERS[1:3]
expect_equal(set_ipd(agd_arm, studyc, trtf, y = cont, trt_ref = "B")$treatments,
f_BAC)
expect_equal(set_agd_arm(agd_arm, studyc, trtf, y = cont, se = cont_pos, trt_ref = "B")$treatments,
f_BAC)
expect_equal(set_agd_contrast(agd_contrast, studyc, trtf, y = ydiff, se = sediff, trt_ref = "B")$treatments,
f_BAC)
expect_equal(set_agd_surv(agd_arm, studyc, trtf, Surv = Surv(cont_pos, bin), trt_ref = "B")$treatments,
f_BAC)
expect_equal(set_ipd(agd_arm, studyc, trtf, y = cont, trt_ref = factor("B"))$treatments,
f_BAC)
expect_equal(set_agd_arm(agd_arm, studyc, trtf, y = cont, se = cont_pos, trt_ref = factor("B"))$treatments,
f_BAC)
expect_equal(set_agd_contrast(agd_contrast, studyc, trtf, y = ydiff, se = sediff, trt_ref = factor("B"))$treatments,
f_BAC)
expect_equal(set_agd_surv(agd_arm, studyc, trtf, Surv = Surv(cont_pos, bin), trt_ref = factor("B"))$treatments,
f_BAC)
f_213 <- factor(c(2, 1, 3), levels = c(2, 1, 3))
expect_equal(set_ipd(agd_arm, studyc, trtn, y = cont, trt_ref = 2)$treatments,
f_213)
expect_equal(set_agd_arm(agd_arm, studyc, trtn, y = cont, se = cont_pos, trt_ref = 2)$treatments,
f_213)
expect_equal(set_agd_contrast(agd_contrast, studyc, trtn, y = ydiff, se = sediff, trt_ref = 2)$treatments,
f_213)
expect_equal(set_agd_surv(agd_arm, studyc, trtn, Surv = Surv(cont_pos, bin), trt_ref = 2)$treatments,
f_213)
f_BCA <- factor(LETTERS[c(2,3,1)], levels = LETTERS[c(2,3,1)])
attr(f_BCA, "original_levels") <- LETTERS[3:1]
expect_equal(set_ipd(agd_arm, studyc, trtf2, y = cont, trt_ref = "B")$treatments,
f_BCA)
expect_equal(set_agd_arm(agd_arm, studyc, trtf2, y = cont, se = cont_pos, trt_ref = "B")$treatments,
f_BCA)
expect_equal(set_agd_contrast(agd_contrast, studyc, trtf2, y = ydiff, se = sediff, trt_ref = "B")$treatments,
f_BCA)
expect_equal(set_agd_surv(agd_arm, studyc, trtf2, Surv = Surv(cont_pos, bin), trt_ref = "B")$treatments,
f_BCA)
expect_equal(set_ipd(agd_arm, studyc, trtf2, y = cont, trt_ref = factor("B"))$treatments,
f_BCA)
expect_equal(set_agd_arm(agd_arm, studyc, trtf2, y = cont, se = cont_pos, trt_ref = factor("B"))$treatments,
f_BCA)
expect_equal(set_agd_contrast(agd_contrast, studyc, trtf2, y = ydiff, se = sediff, trt_ref = factor("B"))$treatments,
f_BCA)
expect_equal(set_agd_surv(agd_arm, studyc, trtf2, Surv = Surv(cont_pos, bin), trt_ref = factor("B"))$treatments,
f_BCA)
# Check that unused levels are dropped
attr(f_BAC, "original_levels") <- c("A", "B", "C", "zzz")
expect_equal(set_ipd(agd_arm, studyc, forcats::fct_expand(trtf, "zzz"), y = cont, trt_ref = "B")$treatments,
f_BAC)
expect_equal(set_agd_arm(agd_arm, studyc, forcats::fct_expand(trtf, "zzz"), y = cont, se = cont_pos, trt_ref = "B")$treatments,
f_BAC)
expect_equal(set_agd_contrast(agd_contrast, studyc, forcats::fct_expand(trtf, "zzz"), y = ydiff, se = sediff, trt_ref = "B")$treatments,
f_BAC)
expect_equal(set_agd_surv(agd_arm, studyc, forcats::fct_expand(trtf, "zzz"), Surv = Surv(cont_pos, bin), trt_ref = "B")$treatments,
f_BAC)
m <- "`trt_ref` does not match a treatment in the data.+Suitable values are:"
expect_error(set_ipd(agd_arm, studyc, trtc, y = cont, trt_ref = 2), m)
expect_error(set_agd_arm(agd_arm, studyc, trtc, y = cont, se = cont_pos, trt_ref = 2), m)
expect_error(set_agd_contrast(agd_contrast, studyc, trtc, y = ydiff, se = sediff, trt_ref = 2), m)
expect_error(set_agd_surv(agd_arm, studyc, trtc, Surv = Surv(cont_pos, bin), trt_ref = 2), m)
})
# Check classes when default reference treatment is not first in sort order
# Add new study to make B the default trt_ref
newstudy <- tibble(studyc = "c", trtc = c("B", "C"), tclassc = "b",
cont = rnorm(2), cont_pos = runif(2, 0, 1), bin = c(0, 1),
ydiff = c(NA, cont[2]), sediff = 1)
aa <- bind_rows(agd_arm, newstudy)
ac <- bind_rows(agd_contrast, newstudy)
test_that("set_* returns correct .trtclass column", {
expect_equal(set_ipd(agd_arm, studyc, trtc, y = cont,
trt_class = tclassc)$ipd$.trtclass,
agd_arm$tclassf)
expect_equal(set_agd_arm(agd_arm, studyc, trtc, y = cont, se = cont_pos,
trt_class = tclassc)$agd_arm$.trtclass,
agd_arm$tclassf)
expect_equal(set_agd_contrast(agd_contrast, studyc, trtc, y = ydiff, se = sediff,
trt_class = tclassc)$agd_contrast$.trtclass,
agd_contrast$tclassf)
expect_equal(set_agd_surv(agd_arm, studyc, trtc, Surv = Surv(cont_pos, bin),
trt_class = tclassc)$agd_arm$.trtclass,
if (bmax) forcats::fct_relevel(agd_arm$tclassf, "b") else agd_arm$tclassf)
expect_equal(combine_network(set_ipd(agd_arm, studyc, trtc, y = cont,
trt_class = tclassc))$ipd$.trtclass,
agd_arm$tclassf)
expect_equal(combine_network(set_agd_arm(agd_arm, studyc, trtc, y = cont, se = cont_pos,
trt_class = tclassc))$agd_arm$.trtclass,
agd_arm$tclassf)
expect_equal(combine_network(set_agd_contrast(agd_contrast, studyc, trtc, y = ydiff, se = sediff,
trt_class = tclassc))$agd_contrast$.trtclass,
agd_contrast$tclassf)
expect_equal(combine_network(set_agd_surv(agd_arm, studyc, trtc, Surv = Surv(cont_pos, bin),
trt_class = tclassc))$agd_arm$.trtclass,
if (bmax) forcats::fct_relevel(agd_arm$tclassf, "b") else agd_arm$tclassf)
expect_equal(set_ipd(agd_arm, studyc, trtc, y = cont,
trt_class = 11)$ipd$.trtclass,
agd_arm$tclassf)
expect_equal(set_agd_arm(agd_arm, studyc, trtc, y = cont, se = cont_pos,
trt_class = 11)$agd_arm$.trtclass,
agd_arm$tclassf)
expect_equal(set_agd_contrast(agd_contrast, studyc, trtc, y = ydiff, se = sediff,
trt_class = 11)$agd_contrast$.trtclass,
agd_contrast$tclassf)
expect_equal(set_agd_surv(agd_arm, studyc, trtc, Surv = Surv(cont_pos, bin),
trt_class = 11)$agd_arm$.trtclass,
if (bmax) forcats::fct_relevel(agd_arm$tclassf, "b") else agd_arm$tclassf)
expect_equal(combine_network(set_ipd(agd_arm, studyc, trtc, y = cont,
trt_class = 11))$ipd$.trtclass,
agd_arm$tclassf)
expect_equal(combine_network(set_agd_arm(agd_arm, studyc, trtc, y = cont, se = cont_pos,
trt_class = 11))$agd_arm$.trtclass,
agd_arm$tclassf)
expect_equal(combine_network(set_agd_contrast(agd_contrast, studyc, trtc, y = ydiff, se = sediff,
trt_class = 11))$agd_contrast$.trtclass,
agd_contrast$tclassf)
expect_equal(combine_network(set_agd_surv(agd_arm, studyc, trtc, Surv = Surv(cont_pos, bin),
trt_class = 11))$agd_arm$.trtclass,
if (bmax) forcats::fct_relevel(agd_arm$tclassf, "b") else agd_arm$tclassf)
expect_equal(set_ipd(agd_arm, studyc, trtc, y = cont,
trt_class = tclassf)$ipd$.trtclass,
agd_arm$tclassf)
expect_equal(set_agd_arm(agd_arm, studyc, trtc, y = cont, se = cont_pos,
trt_class = tclassf)$agd_arm$.trtclass,
agd_arm$tclassf)
expect_equal(set_agd_contrast(agd_contrast, studyc, trtc, y = ydiff, se = sediff,
trt_class = tclassf)$agd_contrast$.trtclass,
agd_contrast$tclassf)
expect_equal(set_agd_surv(agd_arm, studyc, trtc, Surv = Surv(cont_pos, bin),
trt_class = tclassf)$agd_arm$.trtclass,
if (bmax) forcats::fct_relevel(agd_arm$tclassf, "b") else agd_arm$tclassf)
expect_equal(combine_network(set_ipd(agd_arm, studyc, trtc, y = cont,
trt_class = tclassf))$ipd$.trtclass,
agd_arm$tclassf)
expect_equal(combine_network(set_agd_arm(agd_arm, studyc, trtc, y = cont, se = cont_pos,
trt_class = tclassf))$agd_arm$.trtclass,
agd_arm$tclassf)
expect_equal(combine_network(set_agd_contrast(agd_contrast, studyc, trtc, y = ydiff, se = sediff,
trt_class = tclassf))$agd_contrast$.trtclass,
agd_contrast$tclassf)
expect_equal(combine_network(set_agd_surv(agd_arm, studyc, trtc, Surv = Surv(cont_pos, bin),
trt_class = tclassf))$agd_arm$.trtclass,
if (bmax) forcats::fct_relevel(agd_arm$tclassf, "b") else agd_arm$tclassf)
expect_equal(set_ipd(agd_arm, studyc, trtc, y = cont, trt_ref = "B",
trt_class = tclassf2)$ipd$.trtclass,
agd_arm$tclassf2)
expect_equal(set_agd_arm(agd_arm, studyc, trtc, y = cont, se = cont_pos, trt_ref = "B",
trt_class = tclassf2)$agd_arm$.trtclass,
agd_arm$tclassf2)
expect_equal(set_agd_contrast(agd_contrast, studyc, trtc, y = ydiff, se = sediff, trt_ref = "B",
trt_class = tclassf2)$agd_contrast$.trtclass,
agd_contrast$tclassf2)
expect_equal(set_agd_surv(agd_arm, studyc, trtc, Surv = Surv(cont_pos, bin), trt_ref = "B",
trt_class = tclassf2)$agd_arm$.trtclass,
agd_arm$tclassf2)
expect_equal(combine_network(set_ipd(agd_arm, studyc, trtc, y = cont,
trt_class = tclassf2), trt_ref = "B")$ipd$.trtclass,
agd_arm$tclassf2)
expect_equal(combine_network(set_agd_arm(agd_arm, studyc, trtc, y = cont, se = cont_pos,
trt_class = tclassf2), trt_ref = "B")$agd_arm$.trtclass,
agd_arm$tclassf2)
expect_equal(combine_network(set_agd_contrast(agd_contrast, studyc, trtc, y = ydiff, se = sediff,
trt_class = tclassf2), trt_ref = "B")$agd_contrast$.trtclass,
agd_contrast$tclassf2)
expect_equal(combine_network(set_agd_surv(agd_arm, studyc, trtc, Surv = Surv(cont_pos, bin),
trt_class = tclassf2), trt_ref = "B")$agd_arm$.trtclass,
agd_arm$tclassf2)
# Check that unused factor levels are dropped
expect_equal(set_ipd(agd_arm, studyc, trtc, y = cont,
trt_class = forcats::fct_expand(tclassf, "zzz"))$ipd$.trtclass,
agd_arm$tclassf)
expect_equal(set_agd_arm(agd_arm, studyc, trtc, y = cont, se = cont_pos,
trt_class = forcats::fct_expand(tclassf, "zzz"))$agd_arm$.trtclass,
agd_arm$tclassf)
expect_equal(set_agd_contrast(agd_contrast, studyc, trtc, y = ydiff, se = sediff,
trt_class = forcats::fct_expand(tclassf, "zzz"))$agd_contrast$.trtclass,
agd_contrast$tclassf)
expect_equal(set_agd_surv(agd_arm, studyc, trtc, Surv = Surv(cont_pos, bin),
trt_class = forcats::fct_expand(tclassf, "zzz"))$agd_arm$.trtclass,
if (bmax) forcats::fct_relevel(agd_arm$tclassf, "b") else agd_arm$tclassf)
expect_equal(combine_network(set_ipd(agd_arm, studyc, trtc, y = cont,
trt_class = forcats::fct_expand(tclassf, "zzz")))$ipd$.trtclass,
agd_arm$tclassf)
expect_equal(combine_network(set_agd_arm(agd_arm, studyc, trtc, y = cont, se = cont_pos,
trt_class = forcats::fct_expand(tclassf, "zzz")))$agd_arm$.trtclass,
agd_arm$tclassf)
expect_equal(combine_network(set_agd_contrast(agd_contrast, studyc, trtc, y = ydiff, se = sediff,
trt_class = forcats::fct_expand(tclassf, "zzz")))$agd_contrast$.trtclass,
agd_contrast$tclassf)
expect_equal(combine_network(set_agd_surv(agd_arm, studyc, trtc, Surv = Surv(cont_pos, bin),
trt_class = forcats::fct_expand(tclassf, "zzz")))$agd_arm$.trtclass,
if (bmax) forcats::fct_relevel(agd_arm$tclassf, "b") else agd_arm$tclassf)
# Checks when default trt_ref not first in sort order
expect_equal(set_ipd(aa, studyc, trtc, y = cont,
trt_class = tclassc)$ipd$.trtclass,
factor(aa$tclassc, levels = c("b", "a")))
expect_equal(set_agd_arm(aa, studyc, trtc, y = cont, se = cont_pos,
trt_class = tclassc)$agd_arm$.trtclass,
factor(aa$tclassc, levels = c("b", "a")))
expect_equal(set_agd_contrast(ac, studyc, trtc, y = ydiff, se = sediff,
trt_class = tclassc)$agd_contrast$.trtclass,
factor(ac$tclassc, levels = c("b", "a")))
expect_equal(set_agd_surv(aa, studyc, trtc, Surv = Surv(cont_pos, bin),
trt_class = tclassc)$agd_arm$.trtclass,
factor(aa$tclassc, levels = c("b", "a")))
expect_equal(combine_network(set_ipd(aa, studyc, trtc, y = cont,
trt_class = tclassc))$ipd$.trtclass,
factor(aa$tclassc, levels = c("b", "a")))
expect_equal(combine_network(set_agd_arm(aa, studyc, trtc, y = cont, se = cont_pos,
trt_class = tclassc))$agd_arm$.trtclass,
factor(aa$tclassc, levels = c("b", "a")))
expect_equal(combine_network(set_agd_contrast(ac, studyc, trtc, y = ydiff, se = sediff,
trt_class = tclassc))$agd_contrast$.trtclass,
factor(ac$tclassc, levels = c("b", "a")))
expect_equal(combine_network(set_agd_surv(aa, studyc, trtc, Surv = Surv(cont_pos, bin),
trt_class = tclassc))$agd_arm$.trtclass,
factor(aa$tclassc, levels = c("b", "a")))
})
test_that("set_* returns classes factor variable", {
f_class <- factor(c("a", "b", "b"))
expect_equal(set_ipd(agd_arm, studyc, trtc, y = cont, trt_class = tclassc)$classes,
f_class)
expect_equal(set_agd_arm(agd_arm, studyc, trtc, y = cont, se = cont_pos, trt_class = tclassc)$classes,
f_class)
expect_equal(set_agd_contrast(agd_contrast, studyc, trtc, y = ydiff, se = sediff, trt_class = tclassc)$classes,
f_class)
expect_equal(set_agd_surv(agd_arm, studyc, trtc, Surv = Surv(cont_pos, bin), trt_class = tclassc)$classes,
if (bmax) factor(c("b", "a", "b"), levels = c("b", "a")) else f_class)
expect_equal(combine_network(set_ipd(agd_arm, studyc, trtc, y = cont, trt_class = tclassc))$classes,
f_class)
expect_equal(combine_network(set_agd_arm(agd_arm, studyc, trtc, y = cont, se = cont_pos, trt_class = tclassc))$classes,
f_class)
expect_equal(combine_network(set_agd_contrast(agd_contrast, studyc, trtc, y = ydiff, se = sediff, trt_class = tclassc))$classes,
f_class)
expect_equal(combine_network(set_agd_surv(agd_arm, studyc, trtc, Surv = Surv(cont_pos, bin), trt_class = tclassc))$classes,
if (bmax) factor(c("b", "a", "b"), levels = c("b", "a")) else f_class)
# Using tclassf sets original_levels attribute
attr(f_class, "original_levels") <- c("a", "b")
if (bmax) {
f_classs <- factor(c("b", "a", "b"), levels = c("b", "a"))
attr(f_classs, "original_levels") <- c("a", "b")
}
expect_equal(set_ipd(agd_arm, studyc, trtc, y = cont,
trt_class = recode_factor(trtc, A = "a", B = "b", C = "b"))$classes,
f_class)
expect_equal(set_agd_arm(agd_arm, studyc, trtc, y = cont, se = cont_pos,
trt_class = recode_factor(trtc, A = "a", B = "b", C = "b"))$classes,
f_class)
expect_equal(set_agd_contrast(agd_contrast, studyc, trtc, y = ydiff, se = sediff,
trt_class = recode_factor(trtc, A = "a", B = "b", C = "b"))$classes,
f_class)
expect_equal(set_agd_surv(agd_arm, studyc, trtc, Surv = Surv(cont_pos, bin),
trt_class = recode_factor(trtc, A = "a", B = "b", C = "b"))$classes,
if (bmax) f_classs else f_class)
expect_equal(combine_network(set_ipd(agd_arm, studyc, trtc, y = cont,
trt_class = recode_factor(trtc, A = "a", B = "b", C = "b")))$classes,
f_class)
expect_equal(combine_network(set_agd_arm(agd_arm, studyc, trtc, y = cont, se = cont_pos,
trt_class = recode_factor(trtc, A = "a", B = "b", C = "b")))$classes,
f_class)
expect_equal(combine_network(set_agd_contrast(agd_contrast, studyc, trtc, y = ydiff, se = sediff,
trt_class = recode_factor(trtc, A = "a", B = "b", C = "b")))$classes,
f_class)
expect_equal(combine_network(set_agd_surv(agd_arm, studyc, trtc, Surv = Surv(cont_pos, bin),
trt_class = recode_factor(trtc, A = "a", B = "b", C = "b")))$classes,
if (bmax) f_classs else f_class)
f_class2 <- factor(c("b", "a", "b"), levels = c("b", "a"))
expect_equal(set_ipd(agd_arm, studyc, trtc, y = cont,
trt_class = tclassc, trt_ref = "B")$classes,
f_class2)
expect_equal(set_agd_arm(agd_arm, studyc, trtc, y = cont, se = cont_pos,
trt_class = tclassc, trt_ref = "B")$classes,
f_class2)
expect_equal(set_agd_contrast(agd_contrast, studyc, trtc, y = ydiff, se = sediff,
trt_class = tclassc, trt_ref = "B")$classes,
f_class2)
expect_equal(set_agd_surv(agd_arm, studyc, trtc, Surv = Surv(cont_pos, bin),
trt_class = tclassc, trt_ref = "B")$classes,
f_class2)
expect_equal(combine_network(set_ipd(agd_arm, studyc, trtc, y = cont,
trt_class = tclassc), trt_ref = "B")$classes,
f_class2)
expect_equal(combine_network(set_agd_arm(agd_arm, studyc, trtc, y = cont, se = cont_pos,
trt_class = tclassc), trt_ref = "B")$classes,
f_class2)
expect_equal(combine_network(set_agd_contrast(agd_contrast, studyc, trtc, y = ydiff, se = sediff,
trt_class = tclassc), trt_ref = "B")$classes,
f_class2)
expect_equal(combine_network(set_agd_surv(agd_arm, studyc, trtc, Surv = Surv(cont_pos, bin),
trt_class = tclassc), trt_ref = "B")$classes,
f_class2)
# Checks when default trt_ref not first in sort order
expect_equal(set_ipd(aa, studyc, trtc, y = cont,
trt_class = tclassc)$classes,
f_class2)
expect_equal(set_agd_arm(aa, studyc, trtc, y = cont, se = cont_pos,
trt_class = tclassc)$classes,
f_class2)
expect_equal(set_agd_contrast(ac, studyc, trtc, y = ydiff, se = sediff,
trt_class = tclassc)$classes,
f_class2)
expect_equal(set_agd_surv(aa, studyc, trtc, Surv = Surv(cont_pos, bin),
trt_class = tclassc)$classes,
f_class2)
expect_equal(combine_network(set_ipd(aa, studyc, trtc, y = cont,
trt_class = tclassc))$classes,
f_class2)
expect_equal(combine_network(set_agd_arm(aa, studyc, trtc, y = cont, se = cont_pos,
trt_class = tclassc))$classes,
f_class2)
expect_equal(combine_network(set_agd_contrast(ac, studyc, trtc, y = ydiff, se = sediff,
trt_class = tclassc))$classes,
f_class2)
expect_equal(combine_network(set_agd_surv(aa, studyc, trtc, Surv = Surv(cont_pos, bin),
trt_class = tclassc))$classes,
f_class2)
attr(f_class2, "original_levels") <- c("a", "b")
expect_equal(set_ipd(agd_arm, studyc, trtc, y = cont,
trt_class = recode_factor(trtc, A = "a", B = "b", C = "b"),
trt_ref = "B")$classes,
f_class2)
expect_equal(set_agd_arm(agd_arm, studyc, trtc, y = cont, se = cont_pos,
trt_class = recode_factor(trtc, A = "a", B = "b", C = "b"),
trt_ref = "B")$classes,
f_class2)
expect_equal(set_agd_contrast(agd_contrast, studyc, trtc, y = ydiff, se = sediff,
trt_class = recode_factor(trtc, A = "a", B = "b", C = "b"),
trt_ref = "B")$classes,
f_class2)
expect_equal(set_agd_surv(agd_arm, studyc, trtc, Surv = Surv(cont_pos, bin),
trt_class = recode_factor(trtc, A = "a", B = "b", C = "b"),
trt_ref = "B")$classes,
f_class2)
expect_equal(combine_network(set_ipd(agd_arm, studyc, trtc, y = cont,
trt_class = recode_factor(trtc, A = "a", B = "b", C = "b")),
trt_ref = "B")$classes,
f_class2)
expect_equal(combine_network(set_agd_arm(agd_arm, studyc, trtc, y = cont, se = cont_pos,
trt_class = recode_factor(trtc, A = "a", B = "b", C = "b")),
trt_ref = "B")$classes,
f_class2)
expect_equal(combine_network(set_agd_contrast(agd_contrast, studyc, trtc, y = ydiff, se = sediff,
trt_class = recode_factor(trtc, A = "a", B = "b", C = "b")),
trt_ref = "B")$classes,
f_class2)
expect_equal(combine_network(set_agd_surv(agd_arm, studyc, trtc, Surv = Surv(cont_pos, bin),
trt_class = recode_factor(trtc, A = "a", B = "b", C = "b")),
trt_ref = "B")$classes,
f_class2)
# Checks when default trt_ref not first in sort order
expect_equal(set_ipd(aa, studyc, trtc, y = cont,
trt_class = recode_factor(trtc, A = "a", B = "b", C = "b"),
trt_ref = "B")$classes,
f_class2)
expect_equal(set_agd_arm(aa, studyc, trtc, y = cont, se = cont_pos,
trt_class = recode_factor(trtc, A = "a", B = "b", C = "b"),
trt_ref = "B")$classes,
f_class2)
expect_equal(set_agd_contrast(ac, studyc, trtc, y = ydiff, se = sediff,
trt_class = recode_factor(trtc, A = "a", B = "b", C = "b"),
trt_ref = "B")$classes,
f_class2)
expect_equal(set_agd_surv(aa, studyc, trtc, Surv = Surv(cont_pos, bin),
trt_class = recode_factor(trtc, A = "a", B = "b", C = "b"),
trt_ref = "B")$classes,
f_class2)
expect_equal(combine_network(set_ipd(aa, studyc, trtc, y = cont,
trt_class = recode_factor(trtc, A = "a", B = "b", C = "b")),
trt_ref = "B")$classes,
f_class2)
expect_equal(combine_network(set_agd_arm(aa, studyc, trtc, y = cont, se = cont_pos,
trt_class = recode_factor(trtc, A = "a", B = "b", C = "b")),
trt_ref = "B")$classes,
f_class2)
expect_equal(combine_network(set_agd_contrast(ac, studyc, trtc, y = ydiff, se = sediff,
trt_class = recode_factor(trtc, A = "a", B = "b", C = "b")),
trt_ref = "B")$classes,
f_class2)
expect_equal(combine_network(set_agd_surv(aa, studyc, trtc, Surv = Surv(cont_pos, bin),
trt_class = recode_factor(trtc, A = "a", B = "b", C = "b")),
trt_ref = "B")$classes,
f_class2)
f_class3 <- factor(c("B", "A", "C"), levels = c("B", "C", "A"))
attr(f_class3, "original_levels") <- c("C", "B", "A")
expect_equal(set_ipd(agd_arm, studyc, trtc, y = cont,
trt_class = trtf2,
trt_ref = "B")$classes,
f_class3)
expect_equal(set_agd_arm(agd_arm, studyc, trtc, y = cont, se = cont_pos,
trt_class = trtf2,
trt_ref = "B")$classes,
f_class3)
expect_equal(set_agd_contrast(agd_contrast, studyc, trtc, y = ydiff, se = sediff,
trt_class = trtf2,
trt_ref = "B")$classes,
f_class3)
expect_equal(set_agd_surv(agd_arm, studyc, trtc, Surv = Surv(cont_pos, bin),
trt_class = trtf2,
trt_ref = "B")$classes,
f_class3)
expect_equal(combine_network(set_ipd(agd_arm, studyc, trtc, y = cont,
trt_class = trtf2),
trt_ref = "B")$classes,
f_class3)
expect_equal(combine_network(set_agd_arm(agd_arm, studyc, trtc, y = cont, se = cont_pos,
trt_class = trtf2),
trt_ref = "B")$classes,
f_class3)
expect_equal(combine_network(set_agd_contrast(agd_contrast, studyc, trtc, y = ydiff, se = sediff,
trt_class = trtf2),
trt_ref = "B")$classes,
f_class3)
expect_equal(combine_network(set_agd_surv(agd_arm, studyc, trtc, Surv = Surv(cont_pos, bin),
trt_class = trtf2),
trt_ref = "B")$classes,
f_class3)
# Check that unused levels are dropped
attr(f_class, "original_levels") <- c("a", "b", "zzz")
if (bmax) attr(f_classs, "original_levels") <- c("a", "b", "zzz")
expect_equal(set_ipd(agd_arm, studyc, trtc, y = cont,
trt_class = forcats::fct_expand(tclassf, "zzz"))$classes,
f_class)
expect_equal(set_agd_arm(agd_arm, studyc, trtc, y = cont, se = cont_pos,
trt_class = forcats::fct_expand(tclassf, "zzz"))$classes,
f_class)
expect_equal(set_agd_contrast(agd_contrast, studyc, trtc, y = ydiff, se = sediff,
trt_class = forcats::fct_expand(tclassf, "zzz"))$classes,
f_class)
expect_equal(set_agd_surv(agd_arm, studyc, trtc, Surv = Surv(cont_pos, bin),
trt_class = forcats::fct_expand(tclassf, "zzz"))$classes,
if (bmax) f_classs else f_class)
expect_equal(combine_network(set_ipd(agd_arm, studyc, trtc, y = cont,
trt_class = forcats::fct_expand(tclassf, "zzz")))$classes,
f_class)
expect_equal(combine_network(set_agd_arm(agd_arm, studyc, trtc, y = cont, se = cont_pos,
trt_class = forcats::fct_expand(tclassf, "zzz")))$classes,
f_class)
expect_equal(combine_network(set_agd_contrast(agd_contrast, studyc, trtc, y = ydiff, se = sediff,
trt_class = forcats::fct_expand(tclassf, "zzz")))$classes,
f_class)
expect_equal(combine_network(set_agd_surv(agd_arm, studyc, trtc, Surv = Surv(cont_pos, bin),
trt_class = forcats::fct_expand(tclassf, "zzz")))$classes,
if (bmax) f_classs else f_class)
})
test_that("set_* checks for bad class variable work", {
aa2 <- agd_arm
aa2$tclassn <- c(1, 2, 2, 1, 2) # Trt 2 and 3 in two classes
aa2$tclassc[1] <- NA
ac2 <- agd_contrast
ac2$tclassn <- c(1, 2, 2, 1, 2) # Trt 2 and 3 in two classes
ac2$tclassc[1] <- NA
m <- "Treatment present in more than one class"
expect_error(set_ipd(aa2, studyc, trtc, y = cont, trt_class = tclassn), m)
expect_error(set_agd_arm(aa2, studyc, trtc, y = cont, se = cont_pos, trt_class = tclassn), m)
expect_error(set_agd_contrast(ac2, studyc, trtc, y = ydiff, se = sediff, trt_class = tclassn), m)
expect_error(set_agd_surv(aa2, studyc, trtc, Surv = Surv(cont_pos, bin), trt_class = tclassn), m)
m2 <- "cannot contain missing values"
expect_error(set_ipd(aa2, studyc, trtc, y = cont, trt_class = tclassc), m2)
expect_error(set_agd_arm(aa2, studyc, trtc, y = cont, se = cont_pos, trt_class = tclassc), m2)
expect_error(set_agd_contrast(ac2, studyc, trtc, y = ydiff, se = sediff, trt_class = tclassc), m2)
expect_error(set_agd_surv(aa2, studyc, trtc, Surv = Surv(cont_pos, bin), trt_class = tclassc), m2)
m3 <- "must be a regular column"
expect_error(set_ipd(agd_arm, studyc, trtc, y = cont, trt_class = cbind(trtc, trtc)), m3)
expect_error(set_agd_arm(agd_arm, studyc, trtc, y = cont, se = cont_pos, trt_class = cbind(trtc, trtc)), m3)
expect_error(set_agd_contrast(agd_contrast, studyc, trtc, y = cont, se = cont_pos, trt_class = cbind(trtc, trtc)), m3)
expect_error(set_agd_surv(agd_arm, studyc, trtc, Surv = Surv(cont_pos, bin), trt_class = cbind(trtc, trtc)), m3)
})
test_that("set_* return `studies` factor", {
expect_equal(set_ipd(agd_arm, studyc, trtc, y = cont)$studies,
factor(letters[1:2]))
expect_equal(set_agd_arm(agd_arm, studyc, trtc, y = cont, se = cont_pos)$studies,
factor(letters[1:2]))
expect_equal(set_agd_contrast(agd_contrast, studyc, trtc, y = ydiff, se = sediff)$studies,
factor(letters[1:2]))
expect_equal(set_agd_surv(agd_arm, studyc, trtc, Surv = Surv(cont_pos, bin))$studies,
factor(letters[1:2]))
})
make_na <- function(x, n) {
x[sample.int(length(x), n)] <- NA
return(x)
}
test_that("set_* error if outcomes contain missing values", {
agd_arm_miss <- agd_arm %>% mutate_at(vars(cont:bin), ~make_na(., 1))
m <- "contains missing values"
expect_error(set_agd_arm(agd_arm_miss, studyn, trtn, y = cont, se = cont_pos), m)
expect_error(set_agd_arm(agd_arm_miss, studyn, trtn, r = disc, n = disc_p1), m)
expect_error(set_agd_arm(agd_arm_miss, studyn, trtn, r = disc, E = cont_pos), m)
expect_error(set_ipd(agd_arm_miss, studyn, trtn, y = cont), m)
expect_error(set_ipd(agd_arm_miss, studyn, trtn, r = disc), m)
expect_error(set_ipd(agd_arm_miss, studyn, trtn, r = disc, E = cont_pos), m)
# For set_agd_contrast, multiple missing y will trigger multiple baselines error
# Missing se on baseline arm will trigger covariance error if >2 arms (otherwise fine)
agd_contrast_miss <- agd_contrast %>% mutate(sediff = if_else(arm > 1, NA_real_, sediff))
expect_error(set_agd_contrast(agd_contrast_miss, studyn, trtn, y = ydiff, se = sediff), m)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.