rxTest({ test_that("model properties after are parsed OK", { one.compartment <- function() { ini({ tka <- 0.45 tcl <- 1 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) d/dt(depot) = -ka * depot d/dt(center) = ka * depot - cl / v * center cp = center / v cp ~ add(add.sd) }) keep = "WT" drop = "depot" } expect_warning(rxode2(one.compartment)) expect_s3_class(suppressWarnings(rxode2(one.compartment)), "rxUi") expect_true(inherits(one.compartment(), "character")) }) test_that("This model parses k0 as a covariate", { one.compartment.saem <- function() { ini({ tka <- .5 ; label("Log Ka") tcl <- -3.2 ; label("Log Cl") tv <- -1 ; label("Log V") eta.ka ~ 1 eta.cl ~ 2 eta.v ~ 1 add.err <- 0.1 }) model({ ka <- exp(tka + eta.ka) cl <- exp(tcl + eta.cl) v <- exp(tv + eta.v) d / dt(depot) <- -ka * depot + exp(-k0 * t) d / dt(center) <- ka * depot - cl / v * center cp <- center / v cp ~ add(add.err) }) } mod <- rxode2(one.compartment.saem) expect_equal(mod$covariates, "k0") expect_equal(mod$all.covs, "k0") # backward compatible }) test_that("complex models that used to raise errors but should not", { two.cmt.pd <- function() { ini({ tKa <- log(0.64) tCl <- log(5.22) tV2 <- log(41.3) tV3 <- log(115) tQ <- log(11.96) BWef <- log(1.87) tSlope <- log(10) ; label("add for PD estimation") tIntercept <- log(1) ; label("add for PD estimation") eta.Ka ~ 1.18 eta.Cl ~ 0.09 eta.V2 ~ 0.2 eta.V3 ~ 0.12 eta.Q ~ 0.12 eta.Slope ~ 0.1 ; label("add for PD estimation") eta.Intercept ~ 0.1 ; label("add for PD estimation") prop.err1 <- 0.1 ; label("Cp") prop.err2 <- 0.3 ; label("Ef") }) model({ Ka <- exp(tKa + eta.Ka) Cl <- exp(tCl + BWef * log.BW.70 + eta.Cl) V2 <- exp(tV2 + eta.V2) V3 <- exp(tV3 + eta.V3) Q <- exp(tQ + eta.Q) Slope <- exp(tSlope + eta.Slope) ## add for PD estimation Intercept <- exp(tIntercept + eta.Intercept) ## add for PD estimation d / dt(depot) <- -Ka * depot d / dt(center) <- Ka * depot - Cl / V2 * center + Q / V3 * periph - Q / V2 * center d / dt(periph) <- Q / V2 * center - Q / V3 * periph Cp <- center / V2 Ef <- Cp * Slope + Intercept ## add for PD estimation Cp ~ prop(prop.err1) | center Ef ~ prop(prop.err2) ## add for PD estimation }) } expect_s3_class(rxode2(two.cmt.pd), "rxUi") one.compartment.IV.model <- function() { ini({ # Where initial conditions/variables are specified # '<-' or '=' defines population parameters # Simple numeric expressions are supported Cl <- 1.6 # Cl (L/hr) Vc <- 4.5 # V (L) # Bounds may be specified by c(lower, est, upper), like NONMEM: # Residuals errors are assumed to be population parameters prop.err <- c(0, 0.3, 1) # Between subject variability estimates are specified by '~' # Semicolons are optional # eta.Vc ~ 0.1 #IIV V # eta.Cl ~ 0.1 #IIV Cl }) model({ # Where the model is specified # The model uses the ini-defined variable names # Vc <- exp(lVc + eta.Vc) # Cl <- exp(lCl + eta.Cl) # RxODE-style differential equations are supported d / dt(centr) <- -(Cl / Vc) * centr ## Concentration is calculated cp <- centr / Vc # And is assumed to follow proportional error estimated by prop.err cp ~ prop(prop.err) }) } expect_s3_class(suppressMessages(rxode2(one.compartment.IV.model)), "rxUi") model1 <- function() { ini({ CL <- 2.2 V <- 65 add.err <- 0.01 prop.err <- 0.01 }) model({ kel <- CL / V X(0) <- 0 d / dt(X) <- -kel * X cp <- X / V cp ~ add(add.err) + prop(prop.err) }) } f <- rxode2(model1) expect_s3_class(f, "rxUi") }) test_that("modeled expressions don't have to be in the model if non-normal", { ocmt <- function() { ini({ tka <- exp(0.45) tcl <- exp(1) eta.v ~ 0.01 lower <- 0.1 upper <- 0.9 prop.eta ~ 0.01 }) model({ ka <- tka cl <- tcl v <- eta.v d/dt(depot) = -ka * depot d/dt(center) = ka * depot - cl / v * center cp = center / v prop.sd <- exp(tprop + prop.eta) cp2 ~ dunif(lower, upper) }) } expect_warning( expect_error(ocmt(), NA), regexp = "some etas defaulted to non-mu referenced" ) }) test_that("only specifying residual error", { one.cmt <- function() { ini({ add.sd <- 4 }) model({ ka <- exp(tka + eta.ka) cl <- exp(tcl + eta.cl) v <- exp(tv + eta.v) linCmt() ~ add(add.sd) }) } expect_error(one.cmt(), NA) }) test_that("one cmt noeta", { one.cmt.ll.noeta <- function() { ini({ tka <- 0.45 tcl <- log(c(0, 2.7, 100)) tv <- 3.45 add.sd <- 0.7 }) model({ ka <- exp(tka) cl <- exp(tcl) v <- exp(tv) cp <- linCmt() ll(err) ~ -log(add.sd) - 0.5*log(2*pi) - 0.5*((DV-cp)/add.sd)^2 }) } expect_error(one.cmt.ll.noeta(), NA) }) test_that("no theta, but eta (rxode2#433)", { fun <- function() { ini({ eta1 ~ 0.2 eta2 ~ 0.2 eta3 ~ 0.2 }) model({ IETA1 <- 0 IETA2 <- 0 IETA3 <- 0 ETCL <- eta1 + IETA1 ETVC <- eta2 + IETA2 ETKA <- eta3 + IETA3 TVCL <- 4.0 TVVC <- 70.0 TVKA <- 1.0 CL <- TVCL * exp(ETCL) VC <- TVVC * exp(ETVC) KA <- TVKA * exp(ETKA) K20 <- CL / VC scale2 <- VC d/dt(rxddta1) <- - KA * rxddta1 d/dt(rxddta2) <- KA * rxddta1 - K20 * rxddta2 DEL <- 0 if (F == 0) DEL <- 1 W <- F + DEL Y <- F + W * eps1 IPRED <- F IRES <- DV - IPRED IWRES <- IRES / W })} expect_error(fun(), NA) }) })