context("testing print methods for bbi objects")
skip_if_not_ci_or_metworx("test-print")
model_dir <- ABS_MODEL_DIR
mod_ctl_path <- file.path(model_dir, CTL_FILENAME)
PRINT_REF_DIR <- file.path(REF_DIR, "print-refs")
model_1 <- MOD1
withr::with_options(list(bbr.bbi_exe_path = read_bbi_path()), {
withr::local_envvar(c("NO_COLOR" = "true"))
test_that("print.bbi_process works with .wait = TRUE [BBR-PRNT-001]", {
proc <- bbi_exec("--help", .wait = TRUE)
res <- capture.output(print(proc))
expect_true(any(str_detect(res, fixed(PROC_HELP_STR))))
expect_true(any(str_detect(res, "Process finished.")))
})
test_that("print.bbi_process works with .wait = FALSE [BBR-PRNT-001]", {
proc <- bbi_exec("--help", .wait = FALSE)
res <- capture.output(print(proc))
expect_true(any(str_detect(res, fixed(PROC_HELP_STR))))
expect_true(any(str_detect(res, "Not waiting for process to finish.")))
})
test_that("print.bbi_process works with dry run [BBR-PRNT-001]", {
proc <- bbi_dry_run("--help", ".")
res <- capture.output(print(proc))
expect_true(any(str_detect(res, fixed(PROC_HELP_STR))))
expect_true(any(str_detect(res, "DRY RUN! Process not actually run.")))
})
test_that("print.bbi_process(.call_limit) works [BBR-PRNT-001]", {
# create a bunch of fake models
temp_dir <- file.path(get_model_working_directory(MOD1), "print-test")
fs::dir_create(temp_dir)
on.exit(fs::dir_delete(temp_dir))
withr::local_options(list(bbr.DEV_skip_system_mode_checks = TRUE))
readr::write_file("created_by: test-print", file.path(temp_dir, "bbi.yaml"))
mods <- purrr::map(1:50, ~copy_model_from(MOD1, file.path("print-test", .x)))
proc <- submit_models(mods, .dry_run = TRUE)
# Check that default has bbi path, at least two model paths, and flags.
# While the intention is to check the _default_ behavior, increase
# .call_site if needed to avoid this test failing on a system where the
# model paths are longer than expected.
args <- list(proc[[1]])
len_mod <- sum(nchar(purrr::map_chr(mods[1:2], get_model_path)),
# +1 for space in between
1)
if (len_mod > 250) {
args <- c(args, .call_limit = len_mod)
}
call_str <- capture.output(do.call(print, args))[2]
expect_true(str_detect(call_str, fixed(read_bbi_path())))
expect_true(str_detect(call_str,
paste0("\\Q", temp_dir, "\\E", "/1\\.ctl.+",
"\\Q", temp_dir, "\\E", "/2\\.ctl.+")))
expect_true(str_detect(call_str, "--overwrite --parallel --threads=4"))
# Check that passing in .call_limit=30 has bbi path, NO model paths, but
# still has flags. Note that 30 is sufficient to trigger truncation of the
# model arguments because "inst/model/nonmem/basic/print-test" alone is over
# 30 characters.
call_str <- capture.output(print(proc[[1]], .call_limit=30))[2]
expect_true(str_detect(call_str, fixed(read_bbi_path())))
expect_false(str_detect(call_str, fixed(temp_dir)))
expect_true(str_detect(call_str, "--overwrite --parallel --threads=4"))
})
test_that("print.bbi_nonmem_model contains proper fields if all present [BBR-PRNT-002]", {
model_1[[YAML_NOTES]] <- c("x", "y")
fields <- c('Status',
'Absolute Model Path',
'YAML & Model Files',
'Description',
'Tags',
'BBI Args',
'Notes')
bullets <- capture.output({ # these get thrown away, but we don't want them to print in the test output
purrr::walk(fields, ~ expect_message(print(model_1), regexp = .x))
})
})
test_that("print.bbi_nonmem_model run status functions properly [BBR-PRNT-002]", {
bullets <- capture.output({ # these get thrown away, but we don't want them to print in the test output
expect_message(print(model_1), regexp = "Finished Running")
model1_no_output_dir <- model_1
model1_no_output_dir[[ABS_MOD_PATH]] <- 'some/fake/path'
expect_message(print(model1_no_output_dir), regexp = "Not Run")
mod_no_config <- read_model(file.path(MODEL_DIR_X, "1001"))
expect_message(print(mod_no_config), regexp = "Incomplete Run")
})
})
test_that("print.bbi_nonmem_model return model type properly", {
bullets <- capture.output({ # these get thrown away, but we don't want them to print in the test output
expect_message(print(model_1), regexp = "NONMEM Model")
model1_sim <- model_1
model1_sim[[YAML_MOD_TYPE]] <- 'nmsim'
expect_message(print(model1_sim), regexp = "Simulation")
model1_boot <- model_1
model1_boot[[YAML_MOD_TYPE]] <- 'nmboot'
expect_message(print(model1_boot), regexp = "Bootstrap Run")
model1_other <- model_1
new_mod_type <- 'other_model_type'
model1_boot[[YAML_MOD_TYPE]] <- new_mod_type
expect_message(print(model1_boot), regexp = glue("{toupper(new_mod_type)} Model Status"))
})
})
test_that("print.bbi_nonmem_summary works basic FOCE model [BBR-PRNT-003]", {
.s <- file.path(MODEL_DIR, 1) %>%
read_model() %>%
model_summary()
res_str <- capture.output(print(.s))
ref_str <- readLines(file.path(PRINT_REF_DIR, "print_nmsum_1.txt"))
expect_equal(res_str, ref_str)
})
test_that("print.bbi_nonmem_summary works mixture model [BBR-PRNT-003]", {
.s <- file.path(MODEL_DIR_X, "iovmm") %>%
read_model() %>%
model_summary()
res_str <- expect_warning({
capture.output(print(.s))
}, regexp = "param_estimates.+mixture model")
ref_str <- readLines(file.path(PRINT_REF_DIR, "print_nmsum_iovmm.txt"))
expect_equal(res_str, ref_str)
})
test_that("print.bbi_nonmem_summary works Bayes model [BBR-PRNT-003]", {
.s <- file.path(MODEL_DIR_X, "1001") %>%
read_model() %>%
model_summary(.bbi_args = list(ext_file = "1001.1.TXT"))
res_str <- capture.output(print(.s))
ref_str <- readLines(file.path(PRINT_REF_DIR, "print_nmsum_1001.txt"))
expect_equal(res_str, ref_str)
})
test_that("print.bbi_nonmem_summary works SAEM-IMP model [BBR-PRNT-003]", {
.s <- file.path(MODEL_DIR_X, "example2_saemimp") %>%
read_model() %>%
model_summary()
res_str <- capture.output(print(.s))
ref_str <- readLines(file.path(PRINT_REF_DIR, "print_nmsum_example2_saemimp_noargs.txt"))
expect_equal(res_str, ref_str)
})
test_that("print.bbi_nonmem_summary works IOV model [BBR-PRNT-003]", {
# load a model summary
.s <- file.path(MODEL_DIR_X, "acop-iov") %>%
read_model() %>%
model_summary()
res_str <- capture.output(print(.s))
ref_str <- readLines(file.path(PRINT_REF_DIR, "print_nmsum_acop-iov_noargs.txt"))
expect_equal(res_str, ref_str)
})
test_that("print.bbi_nonmem_summary .fixed=TRUE [BBR-PRNT-003]", {
# check with IOV model
.s <- file.path(MODEL_DIR_X, "acop-iov") %>%
read_model() %>%
model_summary()
res_str <- capture.output(print(.s, .fixed = TRUE))
ref_str <- readLines(file.path(PRINT_REF_DIR, "print_nmsum_acop-iov_fixedTRUE.txt"))
expect_equal(res_str, ref_str)
# check with SAEM-IMP model
.s <- file.path(MODEL_DIR_X, "example2_saemimp") %>%
read_model() %>%
model_summary()
res_str <- capture.output(print(.s, .fixed = TRUE))
ref_str <- readLines(file.path(PRINT_REF_DIR, "print_nmsum_example2_saemimp_fixedTRUE.txt"))
expect_equal(res_str, ref_str)
})
test_that("print.bbi_nonmem_summary .nrow argument [BBR-PRNT-003]", {
# load a model summary
.s <- file.path(MODEL_DIR_X, "acop-iov") %>%
read_model() %>%
model_summary()
res_str <- capture.output(print(.s, .nrow = 15, .fixed = TRUE))
ref_str <- readLines(file.path(PRINT_REF_DIR, "print_nmsum_acop-iov_fixedTRUE_nrow15.txt"))
expect_equal(res_str, ref_str)
})
test_that("print.bbi_nonmem_summary .off_diag=TRUE [BBR-PRNT-003]", {
.s <- file.path(MODEL_DIR_X, "example2_saemimp") %>%
read_model() %>%
model_summary()
# check without .fixed=TRUE
res_str <- capture.output(print(.s, .off_diag = TRUE))
ref_str <- readLines(file.path(PRINT_REF_DIR, "print_nmsum_example2_saemimp_offdiagTRUE.txt"))
expect_equal(res_str, ref_str)
# check with .fixed=TRUE
res_str <- capture.output(print(.s, .off_diag = TRUE, .fixed = TRUE))
ref_str <- readLines(file.path(PRINT_REF_DIR, "print_nmsum_example2_saemimp_fixedTRUE_offdiagTRUE.txt"))
expect_equal(res_str, ref_str)
})
test_that("print.bbi_nonmem_summary ONLYSIM [BBR-PRNT-003]", {
skip_if_old_bbi("3.1.1")
.s <- file.path(MODEL_DIR_X, "acop-onlysim") %>%
read_model() %>%
model_summary()
res_str <- capture.output(print(.s))
expect_true("No Estimation Methods (ONLYSIM)" %in% res_str)
})
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.