Nothing
if (helper_skip() && requireNamespace("nlmixr2", quietly = TRUE)) {
context("Test pmx_nlmixr controller")
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)
)
#------------------- pmx_nlmixr - start ---------------------------------------
test_that("pmx_nlmixr: params: result: equal inherits", {
ctr <- pmx_nlmixr(fit, conts = c("cl", "v"))
p1 <- ctr %>% pmx_plot_individual()
p2 <- ctr %>% pmx_plot_dv_ipred()
p3 <- ctr %>% pmx_plot_dv_pred()
p4 <- ctr %>% pmx_plot_abs_iwres_ipred()
p5 <- ctr %>% pmx_plot_individual(1)
p6 <- ctr %>% pmx_plot_iwres_dens()
p7 <- ctr %>% pmx_plot_npde_qq()
p8 <- ctr %>% pmx_plot_npde_pred()
p9 <- ctr %>% pmx_plot_npde_time()
p10 <- ctr %>% pmx_plot_eta_qq()
p11 <- ctr %>% pmx_plot_vpc()
p12 <- ctr %>% pmx_plot_vpc(strat.facet = "SEX", facets = list(nrow = 2), type = "scatter")
p13 <- ctr %>% pmx_plot_eta_box()
p14 <- ctr %>% pmx_plot_eta_hist()
p15 <- ctr %>% pmx_plot_eta_matrix()
expect_true(inherits(p1, c("gg", "ggplot")))
expect_true(inherits(p2, c("gg", "ggplot")))
expect_true(inherits(p3, c("gg", "ggplot")))
expect_true(inherits(p4, c("gg", "ggplot")))
expect_true(inherits(p5, c("gg", "ggplot")))
expect_true(inherits(p6, c("gg", "ggplot")))
expect_true(inherits(p7, c("gg", "ggplot")))
expect_true(inherits(p8, c("gg", "ggplot")))
expect_true(inherits(p9, c("gg", "ggplot")))
expect_true(inherits(p10, c("gg", "ggplot")))
expect_true(inherits(p11, "NULL"))
expect_true(inherits(p12, "NULL"))
expect_true(inherits(p13, c("gg", "ggplot")))
expect_true(inherits(p14, c("gg", "ggplot")))
expect_true(inherits(p15, c("gg", "ggplot")))
})
test_that("pmx_nlmixr: params result: elements in the list", {
configNames <- c("sys", "plots", "omega", "finegrid", "eta")
ctr <- pmx_nlmixr(fit, conts = c("cl", "v"))
expect_true(all(configNames %in% names(ctr$config)))
})
test_that("pmx_nlmixr: params result: identical names", {
pmxNames <- c(
".__enclos_env__", "sim_blq", "time", "id", "bloq", "sim", "plot_file_name", "report_n",
"report_queue", "save_dir", "footnote", "warnings", "endpoint", "abbrev", "re", "has_re",
"settings", "strats", "occ", "conts", "cats", "dvid", "dv", "input_file",
"input", "config", "data", "clone", "post_load", "plots", "get_plot", "set_config",
"get_config", "remove_plot", "update_plot", "add_plot", "dequeue_plot", "enqueue_plot", "print", "initialize"
)
ctr <- pmx_nlmixr(fit, conts = c("cl", "v"))
expect_equal(pmxNames, names(ctr))
})
test_that("pmx_nlmixr: params: fit, dvid, conts, cats, strats, ect.
result: identical value", {
ep <- pmx_endpoint(
code = "1",
file.code = "1"
)
ctr <- pmx_nlmixr(fit, dvid = "TIME", conts = c("cl", "v"), endpoint = ep)
expect_identical(ctr$endpoint$code, "1")
expect_identical(ctr$dvid, "TIME")
})
test_that("pmx_nlmixr: params: fit, dvid, conts, cats, strats, ect.
result: identical value", {
ep <- pmx_endpoint(
code = "1",
file.code = "1"
)
ctr <- pmx_nlmixr(fit, dvid = "TIME", conts = c("cl", "v"), endpoint = ep)
expect_identical(ctr$endpoint$code, "1")
expect_identical(ctr$dvid, "TIME")
})
test_that("pmx_nlmixr: params: fit, dvid, conts, cats, strats, ect.
result: identical by default", {
ctr <- pmx_nlmixr(fit, conts = c("cl", "v"), vpc = FALSE)
expect_identical(ctr$config$sys, "nlmixr")
expect_true(inherits(ctr$config, "pmxConfig"))
expect_true(is.null(ctr$endpoint))
expect_true(is.null(ctr$sim))
})
test_that("pmx_nlmixr: params: fit, dvid, conts, cats, strats, ect.
result: identical conts", {
ctr <- pmx_nlmixr(fit, conts = c("cl", "v"))
expect_identical(ctr$conts, c("cl", "v"))
})
test_that("pmx_nlmixr: params: fit, dvid, conts, cats, strats, ect.
result: pmxClass, R6", {
ctr <- pmx_nlmixr(fit, conts = c("cl", "v"))
expect_true(inherits(ctr, c("pmxClass", "R6")))
})
test_that("pmx_nlmixr: params: NULL result: error is_pmxclass(ctr) not TRUE", {
ctr <- pmx_nlmixr()
expect_error(ctr %>% pmx_plot_individual())
})
test_that("pmx_nlmixr: params: NULL result: NULL", {
ctr <- pmx_nlmixr()
expect_true(is.null(ctr))
})
test_that("pmx_nlmixr: params: conts result: NULL (fit is missing)", {
ctr <- pmx_nlmixr(conts = c("cl", "v"))
expect_true(is.null(ctr))
})
test_that("pmx_nlmixr: params: fit result: default values of the arguments ", {
ctr <- pmx_nlmixr(fit)
settings <- pmx_settings()
expect_identical(ctr$cats, "")
expect_identical(ctr$conts, "")
expect_identical(ctr$strats, "")
expect_identical(ctr$dvid, "")
expect_identical(ctr$endpoint, NULL)
expect_identical(ctr$settings, settings)
expect_identical(ctr$sim, NULL)
})
test_that("pmx_nlmixr: class settings is not a pmxSettingsClass result: settings by default", {
ctr <- pmx_nlmixr(fit, settings <- list(is.draft = FALSE))
p_settings <- pmx_settings()
expect_identical(ctr$settings, p_settings)
})
test_that("pmx_nlmixr: params: fit result: sim by default", {
ctr <- pmx_nlmixr(fit)
expect_identical(ctr$sim, NULL)
})
test_that("pmx_nlmixr: params: fit, endpoint result: error can not filter by endpoint 1
is not a valid column", {
ep <- pmx_endpoint(
code = "1",
file.code = "1"
)
expect_error(pmx_nlmixr(fit, endpoint = ep))
})
test_that("pmx_nlmixr: fit, dvid, endpoint = NULL(by default); result: error
select a single endpoint", {
expect_error(pmx_nlmixr(fit, dvid = "TIME"))
})
test_that("pmx_nlmixr: fit, dvid, endpoint; result: error
No observations data for endpoint 3", {
ep <- pmx_endpoint(
code = "3",
file.code = "1"
)
expect_error(ctr <- pmx_nlmixr(fit, dvid = "TIME", endpoint = ep))
})
}
#------------------- pmx_nlmixr - end ---------------------------------------
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.