rxTest({ test_that("assert properties of rxUi models", { one.cmt <- function() { ini({ tka <- 0.45 tcl <- log(c(0, 2.7, 100)) tv <- 3.45 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) linCmt() ~ add(add.sd) }) } pk.turnover.emax <- function() { ini({ tktr <- log(1) tka <- log(1) tcl <- log(0.1) tv <- log(10) eta.ktr ~ 1 eta.ka ~ 1 eta.cl ~ 2 eta.v ~ 1 prop.err <- 0.1 pkadd.err <- 0.1 temax <- logit(0.8) tec50 <- log(0.5) tkout <- log(0.05) te0 <- log(100) eta.emax ~ .5 eta.ec50 ~ .5 eta.kout ~ .5 eta.e0 ~ .5 pdadd.err <- 10 }) model({ ktr <- exp(tktr + eta.ktr) ka <- exp(tka + eta.ka) cl <- exp(tcl + eta.cl) v <- exp(tv + eta.v) ## #poplogit = log(temax/(1-temax)) emax=expit(temax+eta.emax) #logit=temax+eta.emax ec50 = exp(tec50 + eta.ec50) kout = exp(tkout + eta.kout) e0 = exp(te0 + eta.e0) ## DCP = center/v PD=1-emax*DCP/(ec50+DCP) ## effect(0) = e0 kin = e0*kout ## d/dt(depot) = -ktr * depot d/dt(gut) = ktr * depot -ka * gut d/dt(center) = ka * gut - cl / v * center d/dt(effect) = kin*PD -kout*effect ## cp = center / v cp ~ prop(prop.err) + add(pkadd.err) effect ~ add(pdadd.err) }) } suppressMessages( expect_error( assertRxUi(rnorm), "needs to be a rxUi model" ) ) expect_error(assertRxUi(one.cmt), NA) expect_error(assertRxUiSingleEndpoint(pk.turnover.emax)) expect_error(assertRxUiSingleEndpoint(one.cmt), NA) expect_error(assertRxUiNormal(one.cmt), NA) expect_error(assertRxUiTransformNormal(one.cmt), NA) one.cmt.t <- function() { ini({ tka <- 0.45 tcl <- log(c(0, 2.7, 100)) tv <- 3.45 eta.ka ~ 0.6 eta.cl ~ 0.3 eta.v ~ 0.1 add.sd <- 0.7 nu <- 3 }) model({ ka <- exp(tka + eta.ka) cl <- exp(tcl + eta.cl) v <- exp(tv + eta.v) linCmt() ~ add(add.sd) + dt(nu) }) } expect_error(assertRxUiNormal(one.cmt.t)) expect_error(assertRxUiTransformNormal(one.cmt.t)) expect_error(assertRxUiEstimatedResiduals(one.cmt.t), NA) one.cmt.t.est <- function() { ini({ tka <- 0.45 tcl <- log(c(0, 2.7, 100)) tv <- 3.45 eta.ka ~ 0.6 eta.cl ~ 0.3 eta.v ~ 0.1 nu <- 3 }) model({ ka <- exp(tka + eta.ka) cl <- exp(tcl + eta.cl) v <- exp(tv + eta.v) add.sd <- 3 + ka linCmt() ~ add(add.sd) + dt(nu) }) } expect_error(assertRxUiEstimatedResiduals(one.cmt.t.est)) expect_error(assertRxUiEstimatedResiduals(one.cmt.t), NA) expect_error(assertRxUiMixedOnly(one.cmt.t), NA) expect_error(assertRxUiPopulationOnly(one.cmt.t)) one.cmt.pop <- function() { ini({ tka <- 0.45 tcl <- log(c(0, 2.7, 100)) tv <- 3.45 add.sd <- 0.7 nu <- 3 }) model({ ka <- exp(tka) cl <- exp(tcl) v <- exp(tv) linCmt() ~ add(add.sd) + dt(nu) }) } expect_error(assertRxUiMixedOnly(one.cmt.pop)) expect_error(assertRxUiPopulationOnly(one.cmt.pop), NA) }) test_that("There must be at least one prediction assertion", { uif <- function() { ini({ tka <- 4 tcl <- exp(-3.2) tv <- exp(1) eta.ka ~ 0.1 eta.cl ~ 0.2 }) model({ ka <- tka + eta.ka cl <- tcl + eta.cl v <- tv d / dt(depot) <- -ka * depot d / dt(center) <- ka * depot - cl / v * center cp <- center / v }) } tmp <- rxode2(uif) expect_error( assertRxUiPrediction(tmp), regexp="there must be at least one prediction" ) }) test_that("Transformably and non-transformably normal", { one.cmt <- function() { ini({ tka <- 0.45 tcl <- log(c(0, 2.7, 100)) tv <- 3.45 eta.ka ~ 0.6 eta.cl ~ 0.3 eta.v ~ 0.1 add.sd <- 0.7 lambda <- c(-2, 1, 2) }) model({ ka <- exp(tka + eta.ka) cl <- exp(tcl + eta.cl) v <- exp(tv + eta.v) linCmt() ~ add(add.sd) + boxCox(lambda) }) } expect_error(assertRxUiNormal(one.cmt)) expect_error(assertRxUiTransformNormal(one.cmt), NA) }) test_that("mu ref only", { one.cmt <- function() { ini({ tka <- 0.45 tcl <- log(c(0, 2.7, 100)) tv <- 3.45 eta.ka ~ 0.6 eta.cl ~ 0.3 eta.v ~ 0.1 add.sd <- 0.7 lambda <- c(-2, 1, 2) }) model({ ka <- exp(tka + eta.ka) cl <- exp(tcl + eta.cl) v <- exp(tv + eta.v) linCmt() ~ add(add.sd) + boxCox(lambda) }) } expect_error(assertRxUiMuRefOnly(one.cmt), NA) one.cmt <- function() { ini({ tka <- 0.45 tcl <- log(c(0, 2.7, 100)) tv <- 3.45 eta.ka ~ 0.6 eta.cl ~ 0.3 eta.v ~ 0.1 add.sd <- 0.7 lambda <- c(-2, 1, 2) }) model({ ka <- tka * exp(eta.ka) cl <- exp(tcl + eta.cl) v <- exp(tv + eta.v) linCmt() ~ add(add.sd) + boxCox(lambda) }) } expect_error(assertRxUiMuRefOnly(one.cmt)) one.cmt <- function() { ini({ tka <- 0.45 tcl <- log(c(0, 2.7, 100)) tv <- 3.45 eta.ka ~ 0.6 | occ 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) linCmt() ~ add(add.sd) }) } expect_warning( expect_error( assertRxUiRandomOnIdOnly(one.cmt), regexp = "can only have random effects on ID" ), regexp = "some etas defaulted to non-mu referenced" ) }) })