Remove zero and over-limit items in thetaMat, omega and sigma mats

nlmixr2 · Sep 14, 2024 · 7785f04 · 7785f04
1 parent d47b860
commit 7785f04
Showing 1 changed file with 17 additions and 0 deletions.
diff --git a/R/rxsolve.R b/R/rxsolve.R
@@ -1772,7 +1772,20 @@ rxSolve.default <- function(object, params = NULL, events = NULL, inits = NULL,
     if (length(.ignore)>0) {
       .minfo(paste0("thetaMat has too many items, ignored: '", paste(.ignore, collapse="', '"), "'"))
     }
+    .ctl$thetaMat <-.ctl$thetaMat[.col[.w], .col[.w], drop=FALSE]
+    if (dim(.ctl$thetaMat)[1] == 0) .ctl$thetaMat <- NULL
     .names <- c(.names, .col[.w])
+
+    # now look for zero diagonals
+    .col <- colnames(.ctl$thetaMat)
+    .d <- diag(.ctl$thetaMat)
+    .w <- which(.d == 0)
+    if (length(.w) > 0) {
+      .minfo(paste0("thetaMat has zero diagonal items, ignored: '", paste(.col[.w], collapse="', '"), "'"))
+      .ctl$thetaMat <-.ctl$thetaMat[.col[-.w], .col[-.w], drop=FALSE]
+      if (dim(.ctl$thetaMat)[1] == 0) .ctl$thetaMat <- NULL
+      .names <- c(.names, .col[-.w])
+    }
   }
   if (inherits(.ctl$omega, "matrix")) {
     .mv <- rxModelVars(object)
@@ -1782,6 +1795,8 @@ rxSolve.default <- function(object, params = NULL, events = NULL, inits = NULL,
     if (length(.ignore)>0) {
       .minfo(paste0("omega has too many items, ignored: '", paste(.ignore, collapse="', '"), "'"))
     }
+    .ctl$omega <-.ctl$omega[.col[.w], .col[.w], drop=FALSE]
+    if (dim(.ctl$omega)[1] == 0) .ctl$omega <- NULL
     .names <- c(.names, .col[.w])
   } else if ( inherits(.ctl$omega, "character")) {
     .mv <- rxModelVars(object)
@@ -1801,6 +1816,8 @@ rxSolve.default <- function(object, params = NULL, events = NULL, inits = NULL,
     if (length(.ignore)>0) {
       .minfo(paste0("sigma has too many items, ignored: '", paste(.ignore, collapse="', '"), "'"))
     }
+    .ctl$sigma <-.ctl$sigma[.col[.w], .col[.w], drop=FALSE]
+    if (dim(.ctl$sigma)[1] == 0) .ctl$sigma <- NULL
     .names <- c(.names, .col[.w])
   } else if ( inherits(.ctl$sigma, "character")) {
     .mv <- rxModelVars(object)