Merge pull request #24 from nlmixr2/plot-noiiv

Fix plotting with no IIV
nlmixr2 · Nov 14, 2022 · 70c52cb · 70c52cb
2 parents 764d033 + a2c4895
commit 70c52cb
Show file tree

Hide file tree

Showing 3 changed files with 47 additions and 34 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -3,6 +3,8 @@
 * `plot()` now returns a named list of lists so that users can more easily
   choose which plots to include, if all plots are not desired.  Or the user
   could use those names as the basis of figure captions (fix #8).
+* Models without eta values (between subject variability) now have more
+  consistent plotting to models with eta values (fix #18).
 
 # nlmixr2plot 2.0.7
 

diff --git a/R/plot.nlmixr2.R b/R/plot.nlmixr2.R
@@ -6,7 +6,7 @@
 #' @noRd
 .setupPlotData <- function(data) {
   .dat <- as.data.frame(data)
-  .w <- which(!is.na(.dat$RES))
+  .w <- which(!is.na(.dat$IRES))
   .dat <- .dat[.w, ]
   .doCmt <- FALSE
   if (any(names(.dat) == "CMT")) {
@@ -15,7 +15,7 @@
     }
   }
   if (!.doCmt) {
-    .dat$CMT <- factor(rep(1, length(.dat[, 1])), 1, "All Data")
+    .dat$CMT <- factor("All Data")
   } else {
     levels(.dat$CMT) <- paste("Endpoint: ", levels(.dat$CMT))
   }
@@ -195,7 +195,7 @@ plotCmt <- function(x, cmt) {
   .hasIpred <- any(names(x) == "IPRED")
   .datCmt <- x[x$CMT == cmt,, drop = FALSE]
   if (nrow(.datCmt) > 0) {
-    if (.hasPred) {
+    if (.hasPred & .hasIpred) {
       .lst[["dv_pred_ipred_linear"]] <-
         .dvPlot(.datCmt, c("PRED", "IPRED")) +
         ggplot2::ggtitle(cmt, "DV vs PRED/IPRED")
@@ -211,6 +211,14 @@ plotCmt <- function(x, cmt) {
       .lst[["dv_ipred_log"]] <-
         .dvPlot(.datCmt, "IPRED", TRUE) +
         ggplot2::ggtitle(cmt, "log-scale DV vs IPRED")
+    } else if (.hasPred) {
+      .lst[["dv_pred_linear"]] <-
+        .dvPlot(.datCmt, "PRED") +
+        ggplot2::ggtitle(cmt, "DV vs PRED")
+
+      .lst[["dv_pred_log"]] <-
+        .dvPlot(.datCmt, "PRED", TRUE) +
+        ggplot2::ggtitle(cmt, "log-scale DV vs PRED")
     }
 
     if (.hasCwres) {
@@ -233,24 +241,20 @@ plotCmt <- function(x, cmt) {
         ggplot2::ggtitle(cmt, "log-scale DV vs EPRED/IPRED")
     }
 
-    for (x in c("IPRED", "PRED", "CPRED", "EPRED", "TIME", "tad")) {
-      if (any(names(.datCmt) == x)) {
-        for (y in c("IWRES", "IRES", "RES", "CWRES", "NPD")) {
-          if (any(names(.datCmt) == y)) {
-            if (y == "CWRES" && x %in% c("TIME", "CPRED")) {
-              .doIt <- TRUE
-            } else if (y == "NPD" && x %in% c("TIME", "EPRED")) {
-              .doIt <- TRUE
-            } else if (!(y %in% c("CWRES", "NPD"))) {
-              .doIt <- TRUE
-            }
-            if (.doIt) {
-              .lst[[paste(y, x, "linear", sep = "_")]] <-
-                .scatterPlot(.datCmt, c(x, y), cmt, log = FALSE)
-              .lst[[paste(y, x, "log", sep = "_")]] <-
-                .scatterPlot(.datCmt, c(x, y), cmt, log = TRUE)
-            }
-          }
+    for (x in intersect(names(.datCmt), c("IPRED", "PRED", "CPRED", "EPRED", "TIME", "tad"))) {
+      for (y in intersect(names(.datCmt), c("IWRES", "IRES", "RES", "CWRES", "NPD"))) {
+        if (y == "CWRES" && x %in% c("TIME", "CPRED")) {
+          .doIt <- TRUE
+        } else if (y == "NPD" && x %in% c("TIME", "EPRED")) {
+          .doIt <- TRUE
+        } else if (!(y %in% c("CWRES", "NPD"))) {
+          .doIt <- TRUE
+        }
+        if (.doIt) {
+          .lst[[paste(y, x, "linear", sep = "_")]] <-
+            .scatterPlot(.datCmt, c(x, y), cmt, log = FALSE)
+          .lst[[paste(y, x, "log", sep = "_")]] <-
+            .scatterPlot(.datCmt, c(x, y), cmt, log = TRUE)
         }
       }
     }

diff --git a/tests/testthat/test-plots.R b/tests/testthat/test-plots.R
@@ -80,7 +80,7 @@ test_that("test plots with vdiffr", {
     #}
   })
 
-  one.cmt <- function() {
+  oneCmtNoIiv <- function() {
     ini({
       tka <- 0.45
       tcl <- log(c(0, 2.7, 100))
@@ -95,24 +95,31 @@ test_that("test plots with vdiffr", {
     })
   }
 
-  fit2 <-
-    nlmixr2est::nlmixr(
-      one.cmt, nlmixr2data::theo_sd,
-      est="focei",
-      control = list(print = 0),
-      table=nlmixr2est::tableControl(npde=TRUE)
-    )
+  suppressMessages(
+    fitNoIiv <-
+      nlmixr2est::nlmixr(
+        object = oneCmtNoIiv,
+        data = nlmixr2data::theo_sd,
+        est = "focei",
+        control = nlmixr2est::foceiControl(print = 0, eval.max = 10),
+        table = nlmixr2est::tableControl(npde=TRUE)
+      )
+  )
 
-  ## apo <- nlmixr2est::augPred(fit2)
+  ## apo <- nlmixr2est::augPred(fitNoIiv)
   ## ap <- plot(apo)
 
-  expect_error(vpcPlot(fit2), NA)
+  suppressWarnings(
+    expect_error(vpcPlot(fitNoIiv, n = 10), NA)
+  )
 
-  #vp2 <- vpcPlot(fit2, pred_corr=TRUE)
+  #vp2 <- vpcPlot(fitNoIiv, pred_corr=TRUE)
 
-  expect_error(plot(fit2), NA)
+  expect_error(currentPlot <- plot(fitNoIiv), NA)
+  expect_named(currentPlot, c("traceplot", "All Data"))
+  expect_true(length(currentPlot[["All Data"]]) > 1)
 
-  expect_error(traceplot(fit2), NA)
+  expect_error(traceplot(fitNoIiv), NA)
 
   #vdiffr::expect_doppelganger("vpc plot np", vp)
   #vdiffr::expect_doppelganger("vpc pred_corr plot np", vp2)