tests/testthat/test-hist.R

In mapbayr: MAP-Bayesian Estimation of PK Parameters

code_hist <- "
$PARAM
ETA1 = 0, ETA2 = 0, ETA3= 0, ETA4 = 0, ETA5 = 0, ETA6 = 0,
ETA7 = 0, ETA8 = 0, ETA9 = 0, ETA10 = 0, ETA11 = 0, ETA12 = 0
$OMEGA .1 .2 .3 .4 .1 .1 .1 .1 .1 .11 .11 .11
$CMT CENT GUT
$SIGMA 1 0
$TABLE
double DV = 100.0 ;
$CAPTURE DV
"

mod_hist <- mrgsolve::mcode("mod12", code_hist)
dat_hist <- exdata()
est_hist <- mapbayest(mod_hist, dat_hist, reset = 0, verbose = FALSE)
hist_hist <- hist(est_hist)

fetch_facet_names <- function(x){
  layout <- ggplot2::ggplot_build(x)$layout
  layout$layout[names(layout$facet$params$facets)]$name
}

fetch_facet_labels <- function(x){
  eval(quote(pairlist(...)), envir = environment(x[["facet"]][["params"]][["labeller"]]))
}

test_that("hist.mapbayests works", {
  expect_s3_class(hist_hist$layers[[1]]$geom, "GeomArea")
  expect_s3_class(hist_hist$layers[[2]]$geom, "GeomLine")
  expect_s3_class(hist_hist$layers[[3]]$geom, "GeomSegment")
  expect_s3_class(hist_hist$layers[[4]]$geom, "GeomSegment")
  expect_s3_class(hist_hist$layers[[5]]$geom, "GeomRug")
  expect_s3_class(hist_hist$layers[[6]]$geom, "GeomBar")
})

test_that("ID percentile is shown if n ID == 1", {
  label_hist <- fetch_facet_labels(hist_hist)[["name"]][["ETA1"]]
  expect_true(str_detect(label_hist, "ID percentile"))
})

test_that("SHK is shown if n ID > 1", {
  hist001 <- hist(est001)
  labelhist001 <- fetch_facet_labels(hist001)[["name"]]
  expect_true(all(!str_detect(labelhist001, "ID percentile")))

  # Default = based on SD
  expect_true(str_detect(labelhist001["ETA1"], "SHK = 23%"))

  # SD based
  hist_shk_sd <- hist(est001, shk = "sd")
  label_sd <- fetch_facet_labels(hist_shk_sd)[["name"]]
  expect_true(str_detect(label_sd["ETA1"], "SHK = 23%"))

  # VAR based
  hist_shk_var <- hist(est001, shk = "var")
  label_var <- fetch_facet_labels(hist_shk_var)[["name"]]
  expect_true(str_detect(label_var["ETA1"], "SHK = 40%"))

  # NA
  hist_shk_na <- hist(est001, shk = NA)
  label_na <- fetch_facet_labels(hist_shk_na)[["name"]]
  expect_equal(label_na["ETA1"], c(ETA1 = "CL\nIIV = 45%"))

})

test_that("ID percentile is not shown if n ID > 1", {
  label_hist <- eval(quote(pairlist(...)), envir = environment(hist_hist[["facet"]][["params"]][["labeller"]]))[["name"]][["ETA1"]]
  expect_true(str_detect(label_hist,  "ID percentile"))

  hist001 <- hist(est001)
  labelhist001 <- eval(quote(pairlist(...)), envir = environment(hist001[["facet"]][["params"]][["labeller"]]))[["name"]][["ETA1"]]
  expect_true(!str_detect(labelhist001, "ID percentile"))
})

test_that("facetting order is ok if nETA >= 10", {
  expected_names <- c("ETA1", "ETA2", "ETA3", "ETA4", "ETA5", "ETA6", "ETA7", "ETA8", "ETA9", "ETA10", "ETA11", "ETA12")
  expected_names <- factor(x = expected_names, levels = expected_names)
  expect_equal(fetch_facet_names(hist_hist), expected_names)
})

test_that("select_eta argument works", {
  expect_equal(
    fetch_facet_names(hist(est_hist, select_eta = c(1,3,5))),
    factor(x = make_eta_names(c(1,3,5)), levels = make_eta_names(c(1,3,5)))
  )

  # Even if estimation on a subset of ETAs
  est135 <- mapbayest(mod_hist, dat_hist, reset = 0, verbose = FALSE, select_eta = c(1,3,5))

  # Default to estimated ETAs
  expect_equal(
    fetch_facet_names(hist(est135)),
    factor(x = make_eta_names(c(1,3,5)), levels = make_eta_names(c(1,3,5)))
  )

  expect_equal(
    fetch_facet_names(hist(est135, select_eta = c(1,3))),
    factor(x = make_eta_names(c(1,3)), levels = make_eta_names(c(1,3)))
  )

  # Even if none are common
  expect_equal(
    fetch_facet_names(hist(est135, select_eta = c(2,4,6))),
    factor(x = make_eta_names(c(2,4,6)), levels = make_eta_names(c(2,4,6)))
  )

  # Error if select > max ETA
  expect_error(
    fetch_facet_names(hist(est135, select_eta = c(13, 14))),
    "Cannot select ETA13 ETA14: maximum 12 ETAs defined in \\$PARAM."
  )
})