diff --git a/R/rxUiGet.R b/R/rxUiGet.R index 9912c3eb..e3396b50 100644 --- a/R/rxUiGet.R +++ b/R/rxUiGet.R @@ -8,8 +8,23 @@ rxUiGet.simulationModelIwres <- function(x, ...) { .env$.ui <- .ui .ui <- with(.env,eval(rxode2::rxCombineErrorLines(.ui, modelVars=TRUE))) DV <- sim <- iwres <- rxdv <- rx_pred_ <- rx_r_ <- NULL - .ret <- suppressMessages(rxode2::model(.ui, iwres <- (DV-rx_pred_)/sqrt(rx_r_), - append=sim, auto=FALSE)) + if (length(.ui$predDf$cond) == 1) { + .ret <- suppressMessages(rxode2::model(.ui, iwres <- (DV-rx_pred_)/sqrt(rx_r_), + append=sim, auto=FALSE)) + } else { + .ret <- suppressMessages(rxode2::as.rxUi(.ui)) + .lstExpr <- .ret$lstExpr + .l <- length(.lstExpr) + while(identical(.lstExpr[[.l]][[1]], quote(`dvid`)) || + identical(.lstExpr[[.l]][[1]], quote(`cmt`))) .l <- .l - 1 + .lstOut <- c(list(quote(`{`)), + lapply(seq_len(.l), function(i) .lstExpr[[i]]), + list(quote(iwres <- (DV-rx_pred_)/sqrt(rx_r_))), + lapply(seq(.l+1, length(.lstExpr)), function(i) .lstExpr[[i]])) + .lstOut <- as.call(list(quote(`model`), as.call(.lstOut))) + rxode2::model(.ret) <- .lstOut + .ret + } .ret <- rxode2::rxModelVars(.ret) .ret <- rxode2(.ret) .ret diff --git a/tests/testthat/test-sim-iwres.R b/tests/testthat/test-sim-iwres.R new file mode 100644 index 00000000..05548458 --- /dev/null +++ b/tests/testthat/test-sim-iwres.R @@ -0,0 +1,86 @@ +test_that("test $simulationModelIwres with multiple endpoints", { + pk.turnover.emax3 <- 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) + emax = expit(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) | pca + }) + } + + mod <- pk.turnover.emax3() + + expect_true(inherits(mod$simulationModelIwres, "rxode2")) +}) + +test_that("test $simulationModelIwres with single endpoints", { + one.cmt <- function() { + ini({ + ## You may label each parameter with a comment + tka <- 0.45 # Ka + tcl <- log(c(0, 2.7, 100)) # Log Cl + ## This works with interactive models + ## You may also label the preceding line with label("label text") + tv <- 3.45; label("log V") + ## the label("Label name") works with all models + 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) + }) + } + + mod <- one.cmt() + + expect_true(inherits(mod$simulationModelIwres, "rxode2")) +})