610 auto variable promotion in model piping append isnt working correctly

R/piping-model.R

@@ -117,18 +117,27 @@ model.rxModelVars <- model.rxode2
   }
   if (.doAppend) {
     # in pre-pending or appending, lines are only added
-    .lhs <- character()
-    .rhs <- character()
+    .lhs <- character(0)
+    .rhs <- character(0)
+    .lhs0 <- c(rxui$mv0$lhs, rxui$mv0$state, rxui$allCovs, rxui$iniDf$name)
     for (x in modelLines) {
       .isTilde <- .isEndpoint(x)
       if (.isTilde || .isAssignment(x)) {
         .rhs <- unique(c(.getVariablesFromExpression(.getRhs(x), ignorePipe=.isTilde), .rhs))
         .lhs <- unique(c(.getVariablesFromExpression(.getLhs(x)), .lhs))
       }
-      .rhs <- setdiff(.rhs, c(.lhs, rxui$mv0$lhs, rxui$mv0$state, rxui$allCovs, rxui$iniDf$name))
+      .rhs <- setdiff(.rhs, c(.lhs, .lhs0))
       if (isTRUE(auto)) {
         for (v in .rhs) {
-          .addVariableToIniDf(v, rxui, promote=ifelse(.isTilde,NA, TRUE))
+          .isCov <- grepl(.varSelect$covariateExceptions, tolower(v))
+          .isTheta <- !.isCov && grepl(.varSelect$thetaModelReg, v)
+          .isEta <- !.isCov && grepl(.varSelect$etaModelReg, v)
+          if (.isTilde || .isTheta || .isEta) {
+            .addVariableToIniDf(v, rxui,
+                                promote=ifelse(.isTilde,NA,
+                                               TRUE))
+            .lhs <- c(.lhs, v)
+          }
         }
       }
     }
@@ -693,7 +702,7 @@ attr(rxUiGet.errParams, "desc") <- "Get the error-associated variables"
 #'
 rxSetPipingAuto <- function(thetamodelVars=rex::rex(or("tv", "t", "pop", "POP", "Pop",
                                                      "TV", "T", "cov", "err", "eff")),
-                          covariateExceptions = rex::rex(start, or("wt", "sex", "crcl"), end),
+                          covariateExceptions = rex::rex(start, or("wt", "sex", "crcl", "kout"), end),
                           etaParts=c("eta", "ETA", "Eta", "ppv", "PPV", "Ppv", "iiv", "Iiv",
                                      "bsv", "Bsv", "BSV","bpv", "Bpv", "BPV", "psv", "PSV",
                                      "Psv")
@@ -902,7 +911,6 @@ rxSetCovariateNamesForPiping <- function(covariates=NULL) {
         }
       }
     }
-
     if (all(is.na(.iniDf$ntheta))) {
       .theta <- 1
     } else {

R/rxode2.R

@@ -1244,13 +1244,13 @@ rxDllLoaded <- rxIsLoaded
 #'
 #' @return An rxDll object that has the following components
 #'
-#' * `dll`{DLL path}
-#' * `model`{model specification}
-#' * `.c`{A function to call C code in the correct context from the DLL
-#'          using the [.C()] function.}
-#' * `.call`{A function to call C code in the correct context from the DLL
-#'          using the [.Call()] function.}
-#' * `args`{A list of the arguments used to create the rxDll object.}
+#' * `dll` DLL path
+#' * `model` model specification
+#' * `.c` A function to call C code in the correct context from the DLL
+#'          using the [.C()] function.
+#' * `.call` A function to call C code in the correct context from the DLL
+#'          using the [.Call()] function.
+#' * `args` A list of the arguments used to create the rxDll object.
 #' @inheritParams rxode2
 #' @seealso [rxode2()]
 #' @author Matthew L.Fidler
@@ -1776,17 +1776,17 @@ rxModels_ <- # nolint
 #'
 #' @return A list of rxode2 model properties including:
 #'
-#' * `params`{ a character vector of names of the model parameters}
-#' * `lhs`{ a character vector of the names of the model calculated parameters}
-#' * `state`{ a character vector of the compartments in rxode2 object}
-#' * `trans`{ a named vector of translated model properties
+#' * `params`  a character vector of names of the model parameters
+#' * `lhs` a character vector of the names of the model calculated parameters
+#' * `state` a character vector of the compartments in rxode2 object
+#' * `trans` a named vector of translated model properties
 #'       including what type of jacobian is specified, the `C` function prefixes,
-#'       as well as the `C` functions names to be called through the compiled model.}
-#' * `md5`{a named vector that gives the digest of the model (`file_md5`) and the parsed model
-#'      (`parsed_md5`)}
-#' * `model`{ a named vector giving the input model (`model`),
+#'       as well as the `C` functions names to be called through the compiled model.
+#' * `md5` a named vector that gives the digest of the model (`file_md5`) and the parsed model
+#'      (`parsed_md5`)
+#' * `model`  a named vector giving the input model (`model`),
 #'    normalized model (no comments and standard syntax for parsing, `normModel`),
-#'    and interim code that is used to generate the final C file `parseModel`}
+#'    and interim code that is used to generate the final C file `parseModel`
 #'
 #' @keywords internal
 #' @family Query model information

tests/testthat/test-ui-piping.R

@@ -1984,3 +1984,61 @@ test_that("off-diagonal piping issue #518", {
   expect_error(modNew$omega, NA)
 
 })
+
+test_that("piping append", {
+
+  mod <- function() {
+    ini({
+      tka <- 0.45
+      label("Ka")
+      tcl <- 1
+      label("Cl")
+      tv <- 3.45
+      label("V")
+      add.sd <- c(0, 0.7)
+      eta.cl ~ 0.3
+      eta.v ~ 0.1
+    })
+    model({
+      ka <- exp(tka)
+      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)
+    })
+  }
+
+  mod5 <- mod |>
+    model({
+      PD <- 1-emax*cp/(ec50+cp)
+      ##
+      effect(0) <- e0
+      kin <- e0*kout
+      d/dt(effect) <- kin*PD -kout*effect
+    }, append=d/dt(center))
+
+  expect_equal(mod5$theta, c(tka = 0.45, tcl = 1, tv = 3.45, add.sd = 0.7))
+
+  mod6 <- mod5 |>
+    model({
+      emax <- exp(temax)
+      e0 <- exp(te0 + eta.e0)
+      ec50 <- exp(tec50)
+      kin <- exp(tkin)
+      kout <- exp(tkout)
+    }, append=NA)
+
+  expect_equal(mod6$theta,
+               c(tka = 0.45, tcl = 1, tv = 3.45, add.sd = 0.7, temax = 1, te0 = 1, tec50 = 1, tkin = 1, tkout = 1))
+
+  expect_equal(
+    mod6$omega,
+    lotri({
+      eta.cl ~ 0.3
+      eta.v ~ 0.1
+      eta.e0 ~ 1
+    }))
+
+})