More plot functions

DESCRIPTION

@@ -35,4 +35,4 @@ Suggests:
 Config/testthat/edition: 3
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.1.2
+RoxygenNote: 7.2.1

NAMESPACE

@@ -13,7 +13,10 @@ export(geom_cens)
 export(stat_amt)
 export(stat_cens)
 export(traceplot)
+export(vpcCens)
+export(vpcCensTad)
 export(vpcPlot)
+export(vpcPlotTad)
 importFrom(ggplot2,.data)
 importFrom(ggplot2,aes)
 importFrom(ggplot2,element_blank)

R/vpcPlot.R

@@ -52,7 +52,7 @@ vpcPlot <- function(fit, data = NULL, n = 300, bins = "jenks",
                     xlab = NULL, ylab = NULL, title = NULL, smooth = TRUE, vpc_theme = NULL,
                     facet = "wrap", scales = "fixed", labeller = NULL, vpcdb = FALSE,
                     verbose = FALSE, ..., seed=1009,
-                    idv="time") {
+                    idv="time", cens=FALSE) {
   force(idv)
   rxode2::rxReq("vpc")
   .ui <- fit$ui
@@ -134,14 +134,28 @@ vpcPlot <- function(fit, data = NULL, n = 300, bins = "jenks",
   .obsCols$idv <- idv
   .w <- which(tolower(names(.sim)) == "id")
   names(.sim)[.w] <- "id"
-  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)
+  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)
+  }
 }
 
 #' @rdname vpcPlot
@@ -150,6 +164,19 @@ vpcPlotTad <- function(..., idv="tad") {
   vpcPlot(..., idv=idv)
 }
 
+
+#' @rdname vpcPlot
+#' @export
+vpcCensTad <- function(..., cens=TRUE, idv="tad") {
+  vpcPlot(..., cens=cens, idv=idv)
+}
+
+#' @rdname vpcPlot
+#' @export
+vpcCens <- function(..., cens=TRUE, idv="time") {
+  vpcPlot(..., cens=cens, idv=idv)
+}
+
 #' Setup Observation data for VPC
 #'
 #' @param fit nlmixr2 fit

tests/testthat/test-plots.R

@@ -22,7 +22,7 @@ test_that("test plots with vdiffr", {
     })
   }
 
-  censData <- theo_md
+  censData <- nlmixr2data::theo_md
   # Assign CENS = 1 for bloq values, otherwise CENS = 0.
   censData$CENS[censData$DV < 3 & censData$AMT == 0] <- 1
   censData$CENS[censData$DV >= 3 & censData$AMT == 0] <- 0