Merge pull request #29 from nlmixr2/28-vpc-for-censored-data

Fix/test for vpcPlot

.Rbuildignore

@@ -12,3 +12,4 @@
 
 
 ^cran-comments\.md$
+^CRAN-SUBMISSION$

R/vpcPlot.R

@@ -72,7 +72,7 @@ vpcPlot <- function(fit, data = NULL, n = 300, bins = "jenks",
     fit <- .fit
   }
   .ui <- rxode2::rxUiDecompress(fit$ui)
-  .obsLst <- .vpcUiSetupObservationData(fit, data=data, idv=idv)
+  .obsLst <- .vpcUiSetupObservationData(fit, data=data, idv=idv, cens=cens)
   .obs <- .obsLst$obs
   .no <- .obsLst$namesObs
   .nol <- .obsLst$namesObsLower
@@ -210,7 +210,7 @@ vpcCens <- function(..., cens=TRUE, idv="time") {
 #' @return List with `namesObs`, `namesObsLower`, `obs` and `obsCols`
 #' @author Matthew L. Fidler
 #' @noRd
-.vpcUiSetupObservationData <- function(fit, data=NULL, idv="time") {
+.vpcUiSetupObservationData <- function(fit, data=NULL, idv="time", cens=FALSE) {
   if (!is.null(data)) {
     .obs <- data
   } else {
@@ -252,8 +252,13 @@ vpcCens <- function(..., cens=TRUE, idv="time") {
   }
   .obsCols <- c(.obsCols,
                 list(idv=.no[.wo]))
+  if (!cens) {
+    .no <- .no[which(tolower(.no) != "cens")]
+    .nol <- .no[which(tolower(.no) != "cens")]
+    .obs <- .obs[which(tolower(names(.obs)) != "cens")]
+  }
   list(namesObs=.no,
        namesObsLower=.nol,
-       obs=.obs,
-       obsCols=.obsCols)
+              obs=.obs,
+              obsCols=.obsCols)
 }

tests/testthat/test-plots-cens.R

@@ -84,4 +84,31 @@ test_that("plot censoring", {
   #for (i in seq_along(gof)) {
   #    vdiffr::expect_doppelganger(sprintf("gof %03d", i), gof[[i]])
   #}
+
+  theo_cens <- nlmixr2data::theo_sd
+  theo_cens$cens <- 0
+  theo_cens$cens[theo_cens$DV <= 1] <- 1
+  theo_cens$DV[theo_cens$DV <= 1 & theo_cens$AMT == 0] <- 1
+
+  m1 <- function() {
+    ini({
+      tka <- 0.5
+      tcl <- -3.2
+      tv <- -1
+      eta.ka ~ 1
+      eta.cl ~ 2
+      eta.v ~ 1
+      add.err <- 0.1
+    })
+    model({
+      ka <- exp(tka + eta.ka)
+      cl <- exp(tcl + eta.cl)
+      v <- exp(tv + eta.v)
+      linCmt() ~ add(add.err)
+    })
+  }
+  fit1 <- nlmixr2est::nlmixr(m1, theo_cens, 
+                 est = "focei", control=nlmixr2est::foceiControl(print=0),
+                 table = nlmixr2est::tableControl(npde = TRUE, censMethod = "cdf"))
+  expect_error(vpcPlot(fit = fit1), NA)
 })