Missing endpoint

NAMESPACE

@@ -182,8 +182,8 @@ S3method(rxUiGet,muRefTable)
 S3method(rxUiGet,multipleEndpoint)
 S3method(rxUiGet,mvFromExpression)
 S3method(rxUiGet,omega)
-S3method(rxUiGet,params)
 S3method(rxUiGet,paramsLine)
+S3method(rxUiGet,props)
 S3method(rxUiGet,simulationIniModel)
 S3method(rxUiGet,simulationModel)
 S3method(rxUiGet,simulationSigma)

NEWS.md

@@ -2,6 +2,9 @@
 
 ## Breaking Changes
 
+- The model properties was moved from `$params` to `$props` so it does
+  not conflict with the low level `rxode2` model `$params`
+
 - Error when specifying `wd` without `modName`
 
 - With Linear and midpoint of a time between two points, how `rxode2`
@@ -56,7 +59,9 @@
 
 ## Bug fixes
 
-- Fix `ui$params` when the ui is a linear compartment model without `ka` defined.
+- Fix `ui$props$endpoint` when the ui endpoint is defined in terms of the ode instead of lhs. See #754
+
+- Fix `ui$props` when the ui is a linear compartment model without `ka` defined.
 
 - Model extraction `modelExtract()` will now extract model properties.  Note that the model property of `alag(cmt)` and `lag(cmt)` will give the same value. See #745
 

R/rxUiGet.R

@@ -67,7 +67,7 @@ attr(rxUiGet.stateDf, "desc") <- "states and cmt number data.frame"
 
 #' @export
 #' @rdname rxUiGet
-rxUiGet.params <- function(x, ...) {
+rxUiGet.props <- function(x, ...) {
   .x <- x[[1]]
   .ini <- .x$iniDf
   .w <- !is.na(.ini$ntheta) & is.na(.ini$err)
@@ -106,8 +106,9 @@ rxUiGet.params <- function(x, ...) {
   .dose <- c(.doseExtra, .x$state)
   names(.var) <- .cnds
   .lhs <- .mv$lhs
+  .state <- .mv$state
   .end <- .x$predDf$var
-  .end <- .end[.end %in% .lhs]
+  .end <- .end[.end %in% c(.lhs, .state)]
   .lhs <- .lhs[!(.lhs %in% .end)]
   .varLhs <- .x$varLhs
   .primary <- .lhs[.lhs %in% .varLhs]
@@ -122,7 +123,7 @@ rxUiGet.params <- function(x, ...) {
                    endpoint=.end,
                    state=.x$state))
 }
-attr(rxUiGet.params, "desc") <- "Parameter names"
+attr(rxUiGet.props, "desc") <- "rxode2 model properties"
 
 #' @export
 #' @rdname rxUiGet

tests/testthat/test-ui-param.R → tests/testthat/test-ui-props.R

@@ -1,5 +1,5 @@
 if (!.Call(`_rxode2_isIntel`)) {
-  test_that("ui params", {
+  test_that("ui props", {
 
     fun_odes  <- function() {
       description <- "Dupilumab PK model (Kovalenko 2020)"
@@ -108,7 +108,7 @@ if (!.Call(`_rxode2_isIntel`)) {
     obj_ana = rxode2(fun_ana)
     obj_odes = rxode2(fun_odes)
 
-    expect_equal(obj_ana$params,
+    expect_equal(obj_ana$props,
                  list(pop = c("lfdepot", "lka", "lcl", "lv", "lvp", "lq", "allocl", "allov"),
                       resid = "prop.err",
                       group = list(id = c("etafdepot", "etaka", "etacl", "etav", "etavp", "etaq")),
@@ -119,7 +119,7 @@ if (!.Call(`_rxode2_isIntel`)) {
                                     endpoint = "Cc",
                                     state = character(0))))
 
-    expect_equal(obj_odes$params,
+    expect_equal(obj_odes$props,
                  list(pop = c("lvc", "lke", "lkcp", "Mpc", "lka", "lMTT", "lVm", "Km", "lfdepot", "e_wt_vc"),
                       resid = c("cppropSd", "cpaddSd"),
                       group = list(id = c("etalvc", "etalke", "etalka", "etalvm", "etamtt")),
@@ -171,7 +171,7 @@ if (!.Call(`_rxode2_isIntel`)) {
 
     tmp <- fun_ana2()
 
-    expect_equal(tmp$params,
+    expect_equal(tmp$props,
                  list(pop = c("lfdepot", "lka", "lcl", "lv", "lvp", "lq", "allocl", "allov"),
                       resid = "prop.err",
                       group = list(id = c("etafdepot", "etaka", "etacl", "etav", "etavp", "etaq")),
@@ -200,9 +200,9 @@ if (!.Call(`_rxode2_isIntel`)) {
 
     mod <- mod()
 
-    expect_error(mod$params, NA)
+    expect_error(mod$props, NA)
 
-    expect_equal(mod$params,
+    expect_equal(mod$props,
                  list(pop = c("cl", "vc"),
                       resid = "err.sd",
                       group = structure(list(), names = character(0)),
@@ -214,4 +214,43 @@ if (!.Call(`_rxode2_isIntel`)) {
                                     state = character(0))))
 
   })
+
+  test_that("state based endpoint", {
+
+    oncology_sdm_lobo_2002 <- function() {
+      description <- "Signal transduction model for delayed concentration effects on cancer cell growth"
+      reference <- "Lobo ED, Balthasar JP. Pharmacodynamic modeling of chemotherapeutic effects: Application of a transit compartment model to characterize methotrexate effects in vitro. AAPS J. 2002;4(4):212-222. doi:10.1208/ps040442"
+      depends<-"Cc"
+      units<-list(time="hr")
+      # Values for lkng, ltau, lec50, and kmax are for methotrexate from Lobo 2002,
+      # Table 2.  propErr and addErr are added as reasonable values though not from
+      # Lobo 2002 where no value is apparent in the paper.
+      ini({
+        lkng <- log(0.02) ; label("Cell net growth rate (growth minus death) (1/hr)")
+        ltau <- log(34.1) ; label("Mean transit time of each transit compartment (hr)")
+        lec50 <- log(0.1) ; label("Drug concentration reducing the cell growth by 50% (ug/mL)")
+        kmax <- 0.29 ; label("Maximum drug-related reduction in cell growth (1/hr)")
+        tumorVolpropSd <- c(0, 0.3) ; label("Proportional residual error (fraction)")
+        tumorVoladdSd <- c(0, 50, 1000) ; label("Additive residual error (tumor volume units)")
+      })
+      model({
+        # Cc is the drug concentration
+        kng <- exp(lkng)
+        tau <- exp(ltau)
+        ec50 <- exp(lec50)
+        drugEffectTumorVol <- kmax*Cc/(ec50 + Cc)
+        tumorVol(0) <- tumorVol0
+        d/dt(tumorVol) <- kng*tumorVol - transit4*tumorVol
+        d/dt(transit1) <- (drugEffectTumorVol - transit1)/tau
+        d/dt(transit2) <- (transit1 - transit2)/tau
+        d/dt(transit3) <- (transit2 - transit3)/tau
+        d/dt(transit4) <- (transit3 - transit4)/tau
+        tumorVol ~ prop(tumorVolpropSd) + add(tumorVoladdSd)
+      })
+    }
+
+    rx_obj = rxode2::rxode2(oncology_sdm_lobo_2002)
+
+    expect_equal(rx_obj$props$output$endpoint, "tumorVol")
+  })
 }