context("Test param_table() with theophylline controller") ctr <- theophylline() test_that("can make param_table()", { # Creating "pmxClass" controllers: ctr <- theophylline() nonmem_dir <- file.path(system.file(package = "ggPMX"), "testdata", "extdata") ctr_nm <- pmx_nm(directory = nonmem_dir, runno = "001") ctr_nm <- pmx_nm( directory = file.path(system.file(package = "ggPMX"), "testdata", "extdata"), runno = "001" ) # Creating kable outputs for testing: p_ctr <- param_table(ctr, digits = 2, scientific = FALSE) p_ctr_nm <- param_table(ctr_nm, digits = 2, scientific = FALSE) p_ctr_sci <- param_table(ctr, digits = 2, scientific = TRUE) # Check headers expect_true( "|Parameter |Value |RSE |Shrinkage |" %in% trimws(p_ctr) ) expect_true( "|Parameter |Value |RSE |Shrinkage |" %in% trimws(p_ctr_nm) ) # check a random row (here 5) of param_table expect_true( "|Cl |0.31 |8% | |" %in% trimws(p_ctr), ) expect_true( "|THETA1 |26 |3% | |" %in% trimws(p_ctr_nm), ) # Check class: expect_s3_class(p_ctr, "knitr_kable") expect_s3_class(p_ctr_nm, "knitr_kable") # Check output lengths: expect_length(p_ctr, 23L) expect_length(p_ctr_nm, 23L) expect_length(p_ctr_sci, 23L) # Check scientific notation: p_ctr_sci <- param_table(ctr, digits = 2, scientific = TRUE) expect_true(any(grepl("\\de\\+\\d", p_ctr_sci))) expect_true(any(grepl("\\de\\-\\d", p_ctr_sci))) }) test_that("param_table: params return: equal tables, identical names", { p_ctr <- ctr %>% param_table(return_table = TRUE) pop_pars <- ctr %>% get_data("estimates") Names <- c("PARAM", "VALUE", "SE", "RSE", "PVALUE") expect_equal(p_ctr, pop_pars) expect_identical(names(p_ctr), Names) }) test_that("param_table: params return: identical sys in config", { p_t <- ctr %>% param_table(return_table = TRUE) expect_identical(ctr$config$sys, "mlx") }) test_that("param_table: params: fun return: message `var` was used for shrinkage calculation", { p_t <- ctr %>% param_table(fun = "var") expect_message(ctr %>% param_table()) }) test_that("param_table: params NULL return: identical inherits", { expect_s3_class(ctr %>% param_table, "knitr_kable") }) #------------------- param_table with nlmixr start ----------------------------- context("Test param_table() with nlmixr controller") if (requireNamespace("nlmixr2", quiet=TRUE)) { test_that("param_table: params return: kable", { one.compartment <- function() { ini({ tka <- 0.45 # Log Ka tcl <- 1 # Log Cl tv <- 3.45 # Log V eta.ka ~ 0.6 eta.cl ~ 0.3 eta.v ~ 0.1 add.sd <- 0.7 }) model({ ka <- exp(tka + eta.ka) cl <- exp(tcl + eta.cl) v <- exp(tv + eta.v) d / dt(depot) <- -ka * depot d / dt(center) <- ka * depot - cl / v * center cp <- center / v cp ~ add(add.sd) }) } fit <- nlmixr2::nlmixr(one.compartment, nlmixr2data::theo_sd, "saem", control = list(print = 0) ) ctr <- pmx_nlmixr(fit, conts = c("cl", "v")) expect_s3_class(param_table(ctr), "knitr_kable") }) } #------------------- param_table with nlmixr start -----------------------------