Fix for non-mu referenced etas

nlmixr2 · Jan 9, 2025 · 9401f74 · 9401f74
1 parent 5e2c72c
commit 9401f74
Show file tree

Hide file tree

Showing 3 changed files with 29 additions and 8 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -321,6 +321,7 @@ S3method(rxUiGet,saemCovars)
 S3method(rxUiGet,saemCres)
 S3method(rxUiGet,saemEtaNames)
 S3method(rxUiGet,saemEtaTrans)
+S3method(rxUiGet,saemEtaTransPred)
 S3method(rxUiGet,saemFixed)
 S3method(rxUiGet,saemFunction)
 S3method(rxUiGet,saemFunctionModPredQuote)

diff --git a/R/saemRxUiGet.R b/R/saemRxUiGet.R
@@ -156,12 +156,14 @@ rxUiGet.saemFixed <- function(x, ...) {
 }
 #attr(rxUiGet.saemFixed, "desc") <- "Get the saem fixed parameters"
 
-#' @export
-rxUiGet.saemEtaTrans <- function(x, ...) {
+.saemEtaTrans <- function(x, ..., nonMu=FALSE) {
   .ui <- x[[1]]
   .etas <- .ui$iniDf[!is.na(.ui$iniDf$neta1), ]
   .etas <- .etas$name[.etas$neta1 == .etas$neta2]
   .thetas <- rxUiGet.saemParamsToEstimateCov(x, ...)
+  if (nonMu) {
+    .thetas <- .thetas[!(.thetas %in% .ui$nonMuEtas)]
+  }
   .muRefDataFrame <- .ui$muRefDataFrame
   vapply(.etas, function(eta) {
     .w <- which(eta == .muRefDataFrame$eta)
@@ -170,11 +172,25 @@ rxUiGet.saemEtaTrans <- function(x, ...) {
       .w <- which(.muTheta == .thetas)
       if (length(.w) == 1L) return(.w)
     }
+    if (nonMu && eta %in% .ui$nonMuEtas) {
+      .w <- which(eta == .etas)
+      if (length(.w) == 1L) return(-.w)
+    }
     .w <- which(eta == .thetas)
     if (length(.w) == 1L) return(.w)
     return(NA_integer_)
   }, integer(1), USE.NAMES=FALSE)
 }
+
+#' @export
+rxUiGet.saemEtaTrans <- function(x, ...) {
+  .saemEtaTrans(x, ...)
+}
+
+#' @export
+rxUiGet.saemEtaTransPred <- function(x, ...) {
+  .saemEtaTrans(x, ..., nonMu=TRUE)
+}
 #attr(rxUiGet.saemEtaTrans, "desc") <- "Get the saem eta to theta translation"
 #' @export
 rxUiGet.saemOmegaTrans <- function(x, ...) {

diff --git a/R/saemRxUiGetModel.R b/R/saemRxUiGetModel.R
@@ -341,12 +341,12 @@ rxUiGet.saemModelPredReplaceLst <- function(x, ...) {
   .ui <- x[[1]]
   .iniDf <- .ui$iniDf
   .thetaNames <- .iniDf[!is.na(.iniDf$ntheta) & is.na(.iniDf$err), ]
+  .etas <- .iniDf[which(.iniDf$neta1 == .iniDf$neta2),"name"]
   if (length(.thetaNames$name) == 0L) {
     .thetaValue <- character(0L)
   } else {
     .thetaValue <- setNames(paste0("THETA[", .thetaNames$ntheta, "]"), .thetaNames$name)
   }
-
   if (length(.ui$nonMuEtas) > 0) {
     .nonMuThetas <- setNames(rep("", length(.ui$nonMuEtas)), .ui$nonMuEtas)
     .thetaValue <- c(.thetaValue, .nonMuThetas)
@@ -355,15 +355,18 @@ rxUiGet.saemModelPredReplaceLst <- function(x, ...) {
 
   .thetaValueErr <- setNames(paste0("THETA[", .thetaErrNames$ntheta, "]"), .thetaErrNames$name)
   .thetaValue <- c(.thetaValue, .thetaValueErr)
-
-  .etaTrans <- rxUiGet.saemEtaTrans(x, ...)
+  .etaTrans <- rxUiGet.saemEtaTransPred(x, ...)
   for (.e in seq_along(.etaTrans)) {
     .eta <- paste0("ETA[", .e, "]")
     .tn <- .etaTrans[.e]
-    if (.thetaValue[.tn] == "") {
-      .thetaValue[.tn] <- .eta
+    if (.tn < 0) {
+      .thetaValue[.etas[-.tn]] <- .eta
     } else {
-      .thetaValue[.tn] <- paste0(.thetaValue[.tn], " + ", .eta)
+      if (.thetaValue[.tn] == "") {
+        .thetaValue[.tn] <- .eta
+      } else {
+        .thetaValue[.tn] <- paste0(.thetaValue[.tn], " + ", .eta)
+      }
     }
   }
   .muRefFinal <- rxUiGet.saemMuRefCovariateDataFrame(x, ...)
@@ -413,6 +416,7 @@ rxUiGet.saemModelPred <- function(x, ...) {
   .s <- rxUiGet.loadPruneSaemPred(x, ...)
   .saemModelEnv$symengine <- .s
   .replaceLst <- rxUiGet.saemModelPredReplaceLst(x, ...)
+
   .saemModelEnv$predSymengine <- .s
   .prd <- get("rx_pred_", envir = .s)
   .prd <- paste0("rx_pred_=", rxode2::rxFromSE(.prd))