From d17dc2b0529d6e75255aa98f0ff2a0034227f7c6 Mon Sep 17 00:00:00 2001 From: "Matthew L. Fidler" Date: Sat, 3 Aug 2024 14:15:36 -0500 Subject: [PATCH 1/3] Add test/assert for linCmt() --- NAMESPACE | 2 ++ R/RcppExports.R | 2 +- R/assert.R | 54 ++++++++++++++++++++++++++++++++++++ man/assertRxUi.Rd | 8 ++++++ man/etTrans.Rd | 4 +++ man/reexports.Rd | 1 + man/rxode2.Rd | 4 +-- src/etTran.cpp | 2 +- tests/testthat/test-assert.R | 42 ++++++++++++++++++++++++++++ 9 files changed, 115 insertions(+), 4 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index e56afffe1..b4f615d18 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -311,6 +311,7 @@ export(assertCompartmentName) export(assertCompartmentNew) export(assertExists) export(assertParameterValue) +export(assertRxLinCmt) export(assertRxUi) export(assertRxUiEstimatedResiduals) export(assertRxUiMixedOnly) @@ -568,6 +569,7 @@ export(stat_cens) export(swapMatListWithCube) export(testCompartmentExists) export(testExists) +export(testRxLinCmt) export(testVariableExists) export(toTrialDuration) export(uppergamma) diff --git a/R/RcppExports.R b/R/RcppExports.R index 949bc3a5a..4a18abbb0 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -187,7 +187,7 @@ etTransEvidIsObs <- function(isObsSexp) { #' steady concentration at the actual time of dose, otherwise when #' `FALSE` the doses are shifted #' -#' @inheritParams rxSolve::rxSolve +#' @inheritParams rxSolve #' #' @return Object for solving in rxode2 #' diff --git a/R/assert.R b/R/assert.R index 338d0ce47..e20dbfc73 100644 --- a/R/assert.R +++ b/R/assert.R @@ -85,6 +85,60 @@ assertRxUi <- function(ui, extra="", .var.name=.vname(ui)) { } invisible(ui) } +#' Test if rxode2 uses linear solved systems +#' +#' @param ui rxode2 model +#' @inheritParams assertRxUi +#' @return TRUE if the model uses linear solved systems, FALSE otherwise +#' @export +#' @author Matthew L. Fidler +#' @examples +#' +#' one.cmt <- function() { +#' ini({ +#' ## You may label each parameter with a comment +#' tka <- 0.45 # Log 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) +#' }) +#'} +#' +#' testRxLinCmt(one.cmt) +#' +testRxLinCmt <- function(ui, extra="", .var.name=.vname(ui)) { + .ui <- assertRxUi(ui, extra=extra, .var.name=.var.name) + if (!is.null(.ui$.linCmtM)) { + return(TRUE) + } + .predDf <- .ui$predDf + if (any(.predDf$linCmt)) { + return(TRUE) + } + FALSE +} + +#' @describeIn assertRxUi Assert that the rxode2 uses linear solved systems +#' @export +assertRxLinCmt <- function(ui, extra="", .var.name=.vname(ui)) { + .ui <- assertRxUi(ui, extra=extra, .var.name=.var.name) + if (testRxLinCmt(.ui)) { + return(invisible(.ui)) + } + stop("'", .var.name, "' needs to have 'linCmt()'", extra, call.=FALSE) +} #' @export #' @rdname assertRxUi diff --git a/man/assertRxUi.Rd b/man/assertRxUi.Rd index e422d7efa..9e167376f 100644 --- a/man/assertRxUi.Rd +++ b/man/assertRxUi.Rd @@ -2,6 +2,7 @@ % Please edit documentation in R/assert.R \name{assertRxUi} \alias{assertRxUi} +\alias{assertRxLinCmt} \alias{assertRxUiPrediction} \alias{assertRxUiSingleEndpoint} \alias{assertRxUiTransformNormal} @@ -15,6 +16,8 @@ \usage{ assertRxUi(ui, extra = "", .var.name = .vname(ui)) +assertRxLinCmt(ui, extra = "", .var.name = .vname(ui)) + assertRxUiPrediction(ui, extra = "", .var.name = .vname(ui)) assertRxUiSingleEndpoint(ui, extra = "", .var.name = .vname(ui)) @@ -69,6 +72,11 @@ population effect, only) \item \code{assertRxUiRandomOnIdOnly} -- Make sure there are only random effects at the ID level } } +\section{Functions}{ +\itemize{ +\item \code{assertRxLinCmt()}: Assert that the rxode2 uses linear solved systems + +}} \examples{ \donttest{ diff --git a/man/etTrans.Rd b/man/etTrans.Rd index 33298d740..cac3ac7d3 100644 --- a/man/etTrans.Rd +++ b/man/etTrans.Rd @@ -52,6 +52,10 @@ doses (when \code{TRUE}) or retained (when \code{FALSE})} \item{ssAtDoseTime}{Boolean that when \code{TRUE} back calculates the steady concentration at the actual time of dose, otherwise when \code{FALSE} the doses are shifted} + +\item{iCov}{A data frame of individual non-time varying covariates +to combine with the \code{events} dataset. The \code{iCov} dataset has one +covariate per ID and should match the event table} } \value{ Object for solving in rxode2 diff --git a/man/reexports.Rd b/man/reexports.Rd index 8cba3d62e..2857ff16d 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -38,3 +38,4 @@ below to see their documentation. \item{magrittr}{\code{\link[magrittr:pipe]{\%>\%}}} }} +\value{ Inherited from parent routine } diff --git a/man/rxode2.Rd b/man/rxode2.Rd index f6c77ce45..d9087a41f 100644 --- a/man/rxode2.Rd +++ b/man/rxode2.Rd @@ -333,7 +333,7 @@ compilation model. \if{html}{\out{
}}\preformatted{## using C compiler: ‘gcc (Ubuntu 11.4.0-1ubuntu1~22.04) 11.4.0’ -## rxode2 2.1.3.9000 model named rx_f286e2ac84606f0a7fb7f7dbc29b33a8 model (ready). +## rxode2 2.1.3.9000 model named rx_04dd3261889a5923841c5efb07e08793 model (ready). ## x$state: depot, center ## x$stateExtra: cp ## x$params: tka, tcl, tv, add.sd, eta.ka, eta.cl, eta.v, rxerr.cp @@ -346,7 +346,7 @@ mod$simulationIniModel \if{html}{\out{
}}\preformatted{## using C compiler: ‘gcc (Ubuntu 11.4.0-1ubuntu1~22.04) 11.4.0’ -## rxode2 2.1.3.9000 model named rx_d2c9887afabffb922c91402f800196ce model (ready). +## rxode2 2.1.3.9000 model named rx_62f54331f25e5915469a2cdf45d5983f model (ready). ## x$state: depot, center ## x$stateExtra: cp ## x$params: tka, tcl, tv, add.sd, eta.ka, eta.cl, eta.v, rxerr.cp diff --git a/src/etTran.cpp b/src/etTran.cpp index def2f17a4..6d0148944 100644 --- a/src/etTran.cpp +++ b/src/etTran.cpp @@ -554,7 +554,7 @@ List rxModelVars_(const RObject &obj); // model variables section //' steady concentration at the actual time of dose, otherwise when //' `FALSE` the doses are shifted //' -//' @inheritParams rxSolve::rxSolve +//' @inheritParams rxSolve //' //' @return Object for solving in rxode2 //' diff --git a/tests/testthat/test-assert.R b/tests/testthat/test-assert.R index 16c910c13..96c66bcbb 100644 --- a/tests/testthat/test-assert.R +++ b/tests/testthat/test-assert.R @@ -1,4 +1,46 @@ if (!.Call(`_rxode2_isIntel`)) { + test_that("assert or testRxLinCmt", { + one.cmt <- function() { + ini({ + tka <- 0.45; label("Ka") + tcl <- log(c(0, 2.7, 100)); label("Cl") + tv <- 3.45; label("V") + 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) + }) + } + + expect_error(assertRxLinCmt(one.cmt), NA) + expect_true(testRxLinCmt(one.cmt)) + + mod <- function() { + ini({ + cl <- 1.1 + v <- 20 + ka <- 1.5 + }) + model({ + d/dt(depot) <- -ka*depot + d/dt(central) <- ka*depot - (cl/v)*central + f(central) <- bioav + if (mode == 1) rate(central) <- rat2 + if (mode == 2) dur(central) <- dur2 + cp <- central/(v/1000) + }) + } + + expect_error(assertRxLinCmt(mod)) + expect_false(testRxLinCmt(mod)) + + }) test_that("assertRxUiRandomOnIdOnly", { one.cmt <- function() { ini({ From f689381a0f001c16a181e31a76fb070f456c4c1d Mon Sep 17 00:00:00 2001 From: "Matthew L. Fidler" Date: Sat, 3 Aug 2024 15:06:13 -0500 Subject: [PATCH 2/3] ::document() update --- R/assert.R | 2 +- man/assertRxUi.Rd | 8 -------- man/reexports.Rd | 1 - 3 files changed, 1 insertion(+), 10 deletions(-) diff --git a/R/assert.R b/R/assert.R index e20dbfc73..0335a0660 100644 --- a/R/assert.R +++ b/R/assert.R @@ -130,7 +130,7 @@ testRxLinCmt <- function(ui, extra="", .var.name=.vname(ui)) { FALSE } -#' @describeIn assertRxUi Assert that the rxode2 uses linear solved systems +#' @describeIn testRxLinCmt Assert that the rxode2 uses linear solved systems #' @export assertRxLinCmt <- function(ui, extra="", .var.name=.vname(ui)) { .ui <- assertRxUi(ui, extra=extra, .var.name=.var.name) diff --git a/man/assertRxUi.Rd b/man/assertRxUi.Rd index 9e167376f..e422d7efa 100644 --- a/man/assertRxUi.Rd +++ b/man/assertRxUi.Rd @@ -2,7 +2,6 @@ % Please edit documentation in R/assert.R \name{assertRxUi} \alias{assertRxUi} -\alias{assertRxLinCmt} \alias{assertRxUiPrediction} \alias{assertRxUiSingleEndpoint} \alias{assertRxUiTransformNormal} @@ -16,8 +15,6 @@ \usage{ assertRxUi(ui, extra = "", .var.name = .vname(ui)) -assertRxLinCmt(ui, extra = "", .var.name = .vname(ui)) - assertRxUiPrediction(ui, extra = "", .var.name = .vname(ui)) assertRxUiSingleEndpoint(ui, extra = "", .var.name = .vname(ui)) @@ -72,11 +69,6 @@ population effect, only) \item \code{assertRxUiRandomOnIdOnly} -- Make sure there are only random effects at the ID level } } -\section{Functions}{ -\itemize{ -\item \code{assertRxLinCmt()}: Assert that the rxode2 uses linear solved systems - -}} \examples{ \donttest{ diff --git a/man/reexports.Rd b/man/reexports.Rd index 2857ff16d..8cba3d62e 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -38,4 +38,3 @@ below to see their documentation. \item{magrittr}{\code{\link[magrittr:pipe]{\%>\%}}} }} -\value{ Inherited from parent routine } From 492b3c5ccd4dc49fd0039ac1998eaf7484dc0bb0 Mon Sep 17 00:00:00 2001 From: "Matthew L. Fidler" Date: Sat, 3 Aug 2024 20:23:08 -0500 Subject: [PATCH 3/3] commit doc --- man/testRxLinCmt.Rd | 62 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 62 insertions(+) create mode 100644 man/testRxLinCmt.Rd diff --git a/man/testRxLinCmt.Rd b/man/testRxLinCmt.Rd new file mode 100644 index 000000000..99bc3c65b --- /dev/null +++ b/man/testRxLinCmt.Rd @@ -0,0 +1,62 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/assert.R +\name{testRxLinCmt} +\alias{testRxLinCmt} +\alias{assertRxLinCmt} +\title{Test if rxode2 uses linear solved systems} +\usage{ +testRxLinCmt(ui, extra = "", .var.name = .vname(ui)) + +assertRxLinCmt(ui, extra = "", .var.name = .vname(ui)) +} +\arguments{ +\item{ui}{rxode2 model} + +\item{extra}{Extra text to append to the error message (like +"for focei")} + +\item{.var.name}{[\code{character(1)}]\cr +Name of the checked object to print in assertions. Defaults to +the heuristic implemented in \code{\link[checkmate]{vname}}.} +} +\value{ +TRUE if the model uses linear solved systems, FALSE otherwise +} +\description{ +Test if rxode2 uses linear solved systems +} +\section{Functions}{ +\itemize{ +\item \code{assertRxLinCmt()}: Assert that the rxode2 uses linear solved systems + +}} +\examples{ + +one.cmt <- function() { + ini({ + ## You may label each parameter with a comment + tka <- 0.45 # Log 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) + }) +} + +testRxLinCmt(one.cmt) + +} +\author{ +Matthew L. Fidler +}