Merge pull request #16 from nlmixr2/11-skip-plots-for-non-normally-re…

…lated-endpoints 11 skip plots for non normally related endpoints
nlmixr2 · Sep 20, 2022 · b9ae543 · b9ae543
2 parents 55986f0 + 5067e64
commit b9ae543
Show file tree

Hide file tree

Showing 2 changed files with 45 additions and 25 deletions.
diff --git a/R/vpcPlot.R b/R/vpcPlot.R
@@ -62,6 +62,17 @@ vpcPlot <- function(fit, data = NULL, n = 300, bins = "jenks",
                     idv="time", cens=FALSE) {
   force(idv)
   rxode2::rxReq("vpc")
+    # Simulate with VPC
+  if (inherits(fit, "nlmixr2vpcSim")) {
+    .sim <- fit
+    .fit <- attr(class(.sim), "fit")
+    .cls <- class(.fit)
+    .attr <- attr(.cls, ".foceiEnv")
+    .cls <- .cls[-1]
+    attr(.cls, ".foceiEnv") <- .attr
+    class(.fit) <- .cls
+    fit <- .fit
+  }
   .ui <- fit$ui
   .obsLst <- .vpcUiSetupObservationData(fit, data=data, idv=idv)
   .obs <- .obsLst$obs
@@ -82,12 +93,27 @@ vpcPlot <- function(fit, data = NULL, n = 300, bins = "jenks",
     }
   }
   # Simulate with VPC
-  if (inherits(fit, "nlmixr2vpcSim")) {
-    .sim <- fit
-  } else {
+  if (!inherits(fit, "nlmixr2vpcSim")) {
     .sim <- nlmixr2est::vpcSim(fit, ..., keep=stratify, n=n, pred=pred_corr, seed=seed)
   }
   .sim <- nlmixr2est::vpcSimExpand(fit, .sim, stratify, .obs)
+  if (cens) {
+    if (is.null(lloq) && is.null(uloq)) {
+      stop("this data is not censored")
+    }
+    .sim$dv <- .sim$sim
+    .sim$idv <- .sim[[idv]]
+    .obs <- as.data.frame(fit)
+    .obs$idv <- .obs[[idv]]
+    .obs$TIME <- .obs[[idv]]
+    return(vpc::vpc_cens(sim=.sim,
+                         obs=.obs,
+                         bins=bins, n_bins=n_bins, bin_mid=bin_mid,
+                         show = show, stratify = stratify, ci = ci,
+                         uloq = uloq, lloq = lloq,
+                         xlab = xlab, ylab = ylab, title = title, smooth = smooth, vpc_theme = vpc_theme,
+                         facet = facet, labeller = labeller, vpcdb = vpcdb, verbose = verbose))
+  }
   .simCols <- list(
     id="id",
     dv="sim",
@@ -128,7 +154,13 @@ vpcPlot <- function(fit, data = NULL, n = 300, bins = "jenks",
       .sim[[.n]] <- .tmp
     }
   }
+  .w <- which(tolower(names(.obs)) == "evid")
+  if (length(.w) == 1L) {
+    .obs <- .obs[.obs[, .w] == 0 | .obs[, .w] == 2, ]
+  }
   .w <- which(tolower(names(.obs)) == "dv")
+  .obsCols$dv <-"dv"
+  names(.obs)[.w] <- "dv"
   .obs <- .obs[!is.na(.obs[[.w]]), ]
   .w <- which(tolower(names(.obs)) == "ipred")
   if (length(.w) > 0) {
@@ -141,28 +173,14 @@ vpcPlot <- function(fit, data = NULL, n = 300, bins = "jenks",
   .obsCols$idv <- idv
   .w <- which(tolower(names(.sim)) == "id")
   names(.sim)[.w] <- "id"
-  if (cens) {
-    if (is.null(lloq) && is.null(uloq)) {
-      stop("this data is not censored")
-    }
-    vpc::vpc_cens(sim=.sim, sim_cols=.simCols,
-                 obs=.obs, obs_cols=.obsCols,
-                 bins=bins, n_bins=n_bins, bin_mid=bin_mid,
-                 show = show, stratify = stratify, 
-                 ci = ci,
-                 uloq = uloq, lloq = lloq, 
-                 xlab = xlab, ylab = ylab, title = title, smooth = smooth, vpc_theme = vpc_theme,
-                 facet = facet, labeller = labeller, vpcdb = vpcdb, verbose = verbose)    
-  } else {
-    vpc::vpc_vpc(sim=.sim, sim_cols=.simCols,
-                 obs=.obs, obs_cols=.obsCols,
-                 bins=bins, n_bins=n_bins, bin_mid=bin_mid,
-                 show = show, stratify = stratify, pred_corr = pred_corr,
-                 pred_corr_lower_bnd = pred_corr_lower_bnd, pi = pi, ci = ci,
-                 uloq = uloq, lloq = lloq, log_y = log_y, log_y_min = log_y_min,
-                 xlab = xlab, ylab = ylab, title = title, smooth = smooth, vpc_theme = vpc_theme,
-                 facet = facet, scales=scales, labeller = labeller, vpcdb = vpcdb, verbose = verbose)
-  }
+  vpc::vpc_vpc(sim=.sim, sim_cols=.simCols,
+               obs=.obs, obs_cols=.obsCols,
+               bins=bins, n_bins=n_bins, bin_mid=bin_mid,
+               show = show, stratify = stratify, pred_corr = pred_corr,
+               pred_corr_lower_bnd = pred_corr_lower_bnd, pi = pi, ci = ci,
+               uloq = uloq, lloq = lloq, log_y = log_y, log_y_min = log_y_min,
+               xlab = xlab, ylab = ylab, title = title, smooth = smooth, vpc_theme = vpc_theme,
+               facet = facet, scales=scales, labeller = labeller, vpcdb = vpcdb, verbose = verbose)
 }
 
 #' @rdname vpcPlot

diff --git a/tests/testthat/test-plots.R b/tests/testthat/test-plots.R
@@ -35,6 +35,8 @@ test_that("test plots with vdiffr", {
                             est="focei",
                             table=nlmixr2est::tableControl(npde=TRUE))
 
+  fitSim <- nlmixr2est::vpcSim(fit)
+
   apo <- nlmixr2est::augPred(fit)
   expect_error(plot(apo), NA)
   expect_error(vpcPlot(fit), NA)