tests/testthat/test-compute_ofv.R

In mapbayr: MAP-Bayesian Estimation of PK Parameters

est <- mapbayest(exmodel())
dat <- get_data(est)
arg.ofv <- c(est$arg.ofv.fix, est$arg.ofv.id[[1]])

test_that("f works", {

  # tweak because of the "etasrc = data"
  etatest <- eta(runif(3))
  arg.ofv$idvaliddata_eta <- merge_validdata_eta(arg.ofv$idvaliddata, etatest)
  dat_eta <- merge_datadf_etavec(dat, etatest/2)

  #on validated data
  expect_length(f(qmod = arg.ofv$qmod, data = arg.ofv$idvaliddata_eta), 4)

  #on non-validated data
  expect_length(f(qmod = arg.ofv$qmod, data = dat_eta), 4)
  expect_equal(
    f(qmod = arg.ofv$qmod, data = arg.ofv$idvaliddata_eta),
    f(qmod = arg.ofv$qmod, data = dat_eta)
  )

  #mdv != 0 are dealed ok
  validddatabis <- arg.ofv$idvaliddata_eta
  validddatabis[5,"mdv"] <- 1
  expect_length(f(qmod = arg.ofv$qmod, data = validddatabis), 4-1)
  expect_equal(
    f(qmod = arg.ofv$qmod, data = arg.ofv$idvaliddata_eta)[1:3],
    f(qmod = arg.ofv$qmod, data = validddatabis)
  )
})

test_that("h matrix computation works", {
  expectmat <- matrix(c(400, 0, 200, 0, 1, 0, 1, 0, 0, 40, 0, 20, 0, 1, 0, 1), ncol = 4, nrow = 4)

  expect_equal(h(pred = c(400, 40, 200, 20), cmt = c(2, 3, 2, 3), all_cmt = c(2, 3)), expectmat)

  expectmat[1,1] <- 1
  expect_equal(h(pred = c(0, 40, 200, 20), cmt = c(2, 3, 2, 3), all_cmt = c(2, 3)), expectmat)

  # e.g. time = 0 with oral drug
  est <- exmodel(add_exdata = F) %>%
    adm_rows(amt = 100) %>%
    obs_rows(time = c(0, 10), DV = c(.1, 1)) %>%
    mapbayest(output = "df")

  expect_equal(est$IPRED, c(0, 0, 0.9244), tolerance = 0.001)

})

test_that("compute basic ofv", {
  expecteta <- c(
    ETA1 = 0.4050570108131819058,
    ETA2 = 0.07285029212110255559,
    ETA3 = -0.07495339444174362042
    )

  expectofv <- 22.29351276398179493

  of_value1 <- compute_ofv(
    eta = expecteta,

    qmod = arg.ofv$qmod, idvaliddata = arg.ofv$idvaliddata,
    sigma = arg.ofv$sigma, log_transformation = arg.ofv$log_transformation,
    idDV = arg.ofv$idDV, idcmt = arg.ofv$idcmt,
    omega_inv = arg.ofv$omega_inv, all_cmt = arg.ofv$all_cmt)

  expect_equal(of_value1, expectofv)

  of_value2 <- compute_ofv(
    eta = as.list(expecteta),

    qmod = arg.ofv$qmod, idvaliddata = arg.ofv$idvaliddata,
    sigma = arg.ofv$sigma, log_transformation = arg.ofv$log_transformation,
    idDV = arg.ofv$idDV, idcmt = arg.ofv$idcmt,
    omega_inv = arg.ofv$omega_inv, all_cmt = arg.ofv$all_cmt)

  expect_equal(of_value2, expectofv)

  do_ofv1 <- do_compute_ofv(eta = expecteta, argofv = arg.ofv)
  expect_equal(do_ofv1, expectofv)

  do_ofv2 <- do_compute_ofv(eta = expecteta, argofv = arg.ofv)
  expect_equal(do_ofv2, expectofv)

})

test_that("small negative values are fixed", {
  #see #140

  code408 <- "$PROB Reference model

$PARAM @annotated
TVCL   : 4.00 : Clearance (L/h)
TVVC   : 70.0 : Central volume of distribution (L)
TVKA   : 1.00 : Absorption rate (h-1)

ETA1 : 0 : CL
ETA2 : 0 : VC
ETA3 : 0 : KA

$OMEGA
0.2 // CL
0.2 // VC
0.2 // KA

$SIGMA
0 // err prop
.05 //  err log additive


$CMT @annotated
DEPOT   : Depot () []
CENTRAL : Central () [ADM, OBS]

$TABLE
double DV = (CENTRAL / VC) * exp(EPS(2)) ;

$MAIN
double CL  = TVCL  * exp(ETA(1) + ETA1 ) ;
double VC  = TVVC  * exp(ETA(2) + ETA2 ) ;
double KA  = TVKA  * exp(ETA(3) + ETA3 ) ;

double K20 = CL / VC ;

$ODE
dxdt_DEPOT   = - KA * DEPOT ;
dxdt_CENTRAL = - K20 * CENTRAL + KA * DEPOT ;

$CAPTURE DV"


  mod408 <- mcode("mod408", code408, quiet = TRUE)
  dat408 <- data.frame(
    ID = 1405,
    time = c(0, 1.2, 4.6, 8.8, 26.5),
    evid = c(1, 0, 0, 0, 0),
    amt = c(30000, 0,0,0,0),
    cmt = 2,
    rate = c(30000, 0,0,0,0),
    mdv = c(1, 0, 0, 0, 0),
    DV =  c(NA, 1703, 669, 216, 0.806)
  )

  argofv <- c(
    preprocess.ofv.fix(mod408, dat408),
    preprocess.ofv.id(mod408, dat408)
  )
  testparam <- c(ETA1 = 1.6, ETA2 = -1.6, ETA3 = 0)
  pred <- mapbayr:::f(argofv$qmod, data = merge_datadf_etavec(dat408, testparam))
  expect_true(any(pred < 0))
  expect_true(any(is.nan(suppressWarnings(log(pred)))))
  expect_false(is.nan(do_compute_ofv(eta = testparam, argofv)))
})

test_that("dose-related parameters > II", {

  code141 <- "
$PARAM ETA1 = 0, ETA2 = 0
$CMT GUT CENT
$OMEGA .5 .5
$SIGMA .04 0
$MAIN
double KA = 1 ;
double CL = 1 ;
double V = 30 ;
double ALAG1 = 5.0 * exp(ETA(1) + ETA1) ;
double D1 = 5.0 * exp(ETA(2) + ETA2) ;
ALAG_GUT = ALAG1 ;
D_GUT = D1 ;
$PKMODEL ncmt = 1, depot = TRUE
$ERROR
double DV = CENT/V *(1 + EPS(1)) ;
$CAPTURE DV ALAG1 D1
"
  mod141 <- mcode("mod141",code141, quiet = TRUE)

  dat141 <- mod141 %>%
    adm_rows(amt = 1000, cmt = 1, ss = 1, ii = 24) %>%
    obs_rows(time = c(1,4), DV = c(26, 52), cmt = 2) %>%
    get_data()

  argofv141 <- c(
    preprocess.ofv.fix(mod141, dat141),
    preprocess.ofv.id(mod141, dat141)
  )

  ofv1 <- do_compute_ofv(eta = c(ETA1 = -2, ETA2 = -2), argofv141)
  expect_true(all(ofv1 > 20, ofv1 < 30))

  ofv2 <- do_compute_ofv(eta = c(ETA1 = 2, ETA2 = 2), argofv141)
  expect_equal(ofv2, 1E10)
})

test_that("lambda argument works", {
  par <- eta(runif(3))
  ofv_ref <- do_compute_ofv(par, argofv = arg.ofv)

  arg.ofv2 <- arg.ofv
  arg.ofv2$lambda <- NULL

  expect_lt(do_compute_ofv(par, argofv = arg.ofv2, lambda = 0.01), ofv_ref)
  expect_gt(do_compute_ofv(par, argofv = arg.ofv2, lambda = 10), ofv_ref)
})

test_that("merge_validdata_eta() works", {
  val <- mrgsolve::valid_data_set(exdata(1), exmodel(1))
  eta <- eta(runif(3))

  merged <- merge_validdata_eta(val, eta)

  expect_true(mrgsolve:::is.valid_data_set(merged))
  expect_equal(ncol(merged), ncol(val)+length(eta))
})