Merge pull request #42 from certara/predcorrect_usability_enhancements

predcorrect usability enhancements

NEWS.md

@@ -2,6 +2,7 @@
 * Plotting updates were made for ggplot2 version 3.4.0 to use `linewidth` instead of `size` for lines[#39](https://github.com/certara/tidyvpc/issues/39).
 * `simulated.tidyvpcobj()` detects if the number of simulated rows is not an integer multiple of the number of observed rows and adds the new `xsim` argument to test that x values match between replicated simulations.  It will suggest that MDV filtering may not have occurred if either of these fails [#35](https://github.com/certara/tidyvpc/issues/35).
 * Prevent division by zero in `predcorrect()` transformation [#31](https://github.com/certara/tidyvpc/issues/31).
+* Usability enhancements for prediction corrected VPC (pcVPC), which include support for `binning.tidyvpcobj()` either before or after usage of `predcorrect.tidyvpcobj()`, and automatically performing LOESS pcVPC when `binless.tidyvpcobj()` is used. As a result, the `loess.ypc` argument is no longer required[#43](https://github.com/certara/tidyvpc/issues/43).
 
 # tidyvpc 1.4.0
 * Fix for npde calculation fix npde calc [#16](https://github.com/certara/tidyvpc/pull/16)

R/binless.R

@@ -7,10 +7,10 @@
 #' @param o A \code{tidyvpcobj}.
 #' @param optimize Logical indicating whether smoothing parameters should be optimized using AIC.
 #' @param optimization.interval Numeric vector of length 2 specifying the min/max range of smoothing parameter for optimization. Only applicable if \code{optimize = TRUE}.
-#' @param loess.ypc Logical indicating LOESS prediction corrected VPC. Must first use \code{\link{predcorrect}}, if specifying \code{loess.ypc = TRUE}. Only applicable to continuous VPC.
+#' @param loess.ypc (Deprecated) Argument is ignored. For a LOESS pcVPC using the `binless` method, usage of \code{\link{predcorrect}} will automatically perform LOESS prediction correction.
 #' @param lambda Numeric vector of length 3 specifying lambda values for each quantile. If stratified, specify a \code{data.frame} with given strata represented the column name, and value specified as a numeric vector of length 3.
 #' See below examples. Only applicable to continuous VPC with \code{optimize = FALSE}.
-#' @param span Numeric between 0,1 specifying smoothing parameter for LOESS prediction correction. Only applicable for continuous VPC with \code{loess.ypc = TRUE} and \code{optimize = FALSE}.
+#' @param span Numeric between 0,1 specifying smoothing parameter for LOESS prediction correction. Only applicable for continuous VPC with \code{optimize = FALSE} and usage of \code{\link{predcorrect}}.
 #' @param sp List of smoothing parameters applied to \code{mgcv::gam()}. Elements of list must be in the same order as unique values of DV. If one or more stratification variables present, the order of sp
 #' should be specified as unique combination of strata + DV, in ascending order. See below examples. Only applicable for categorical VPC, if \code{optimize = FALSE}.
 #' @param ... Other arguments to include will be ignored.
@@ -42,8 +42,8 @@
 #'
 #'  vpc <- observed(obs_data, y = DV, x = TIME) %>%
 #'       simulated(sim_data, y = DV) %>%
-#'       predcorrect(pred = PRED) %>%
-#'       binless(optimize = TRUE, loess.ypc = TRUE) %>%
+#'       binless(optimize = TRUE) %>%
+#'       predcorrect(pred = PRED) %>% 
 #'       vpcstats()
 #'
 #' # Binless example with user specified lambda values stratified on
@@ -91,15 +91,15 @@ binless <- function(o, ...) UseMethod("binless")
 
 #' @rdname binless
 #' @export
-binless.tidyvpcobj <- function(o, optimize = TRUE, optimization.interval = c(0,7), loess.ypc = FALSE,  lambda = NULL, span = NULL, sp = NULL, ...) {
+binless.tidyvpcobj <- function(o, optimize = TRUE, optimization.interval = c(0,7), loess.ypc = NULL, lambda = NULL, span = NULL, sp = NULL, ...) {
 
   if(!inherits(o, "tidyvpcobj")) {
     stop("No tidyvpcobj found, observed(...) %>% simulated(...) must be called prior to binless()")
   }
 
   if(!optimize){
     if(is.null(lambda) && is.null(sp)) {
-      stop("Set optimize = TRUE if no lambda or sp arguments specified")
+      stop("Set optimize = TRUE if no lambda or sp arguments specified.")
     }
     # if(!is.null(sp) && length(sp) != length(unique(o$obs$y))){
     #   stop("Argument `sp` must be a vector of length equal to the number of unique values of DV. \n
@@ -115,8 +115,12 @@ binless.tidyvpcobj <- function(o, optimize = TRUE, optimization.interval = c(0,7
       x <- c(sp = x))
   }
 
-  if(!is.null(span) && !loess.ypc) {
-    stop("Set loess.ypc = TRUE and optimize = FALSE if setting span smoothing parameter for LOESS prediction corrected")
+  if (!is.null(loess.ypc)) {
+    warning('The loess.ypc argument is deprecated and will be ignored. Usage of `binless()` with `predcorrect()` will now perform LOESS prediction corrected VPC by default.')
+  }
+  loess.ypc <- o$predcor
+  if (is.null(loess.ypc)) {
+    loess.ypc <- FALSE
   }
 
   #if binless categorical, check that sp length = number of unique categories of y

R/vpcstats.R

@@ -525,6 +525,22 @@ binning.tidyvpcobj <- function(o, bin, data=o$data, xbin="xmedian", centers, bre
     stop("Invalid xbin")
   }
   vpc.method <- list(method = "binning")
+
+  # check if user supplied predcorrect before binning
+  if (!is.null(o$predcor) && o$predcor) {
+    pred <- o$pred
+    log <- o$predcor.log
+    mpred <- data.table(stratbin, pred)[, mpred := median(pred), by = stratbin]$mpred
+
+    if (log) {
+      o$obs[, ypc := (mpred - pred) + y]
+      o$sim[, ypc := (mpred - pred) + y]
+    } else {
+      o$obs[, ypc := ifelse(pred == 0, 0, (mpred / pred) * y)]
+      o$sim[, ypc := ifelse(rep(pred, times = nrow(o$sim) / nrow(o$obs)) == 0, 0, (mpred / pred) * y)]
+    }
+  }
+
   update(o, xbin=xbin, vpc.method = vpc.method)
 }
 
@@ -588,25 +604,26 @@ predcorrect.tidyvpcobj <- function(o, pred, data=o$data, ..., log=FALSE) {
     stop("No pred specified")
   }
 
-  stratbin <- o$.stratbin #create loess predcorrect argument in function if want to use below stop because binless comes after predcorrect
-  # if (is.null(stratbin)) {
-  #     stop("Need to specify binning before pred correction. For binless method set argument loess.ypc = TRUE.")
-  # }
-
-  mpred <- data.table(stratbin, pred)
-  mpred <- mpred[, mpred := median(pred), by=stratbin]
-  mpred <- mpred$mpred
-
-  if (log) {
-    o$obs[, ypc := (mpred - pred) + y]
-    o$sim[, ypc := (mpred - pred) + y]
-  } else {
-    o$obs[, ypc := ifelse(pred == 0, 0, (mpred/pred)*y)]
-    o$sim[, ypc := ifelse(rep(pred, times = nrow(o$sim)/nrow(o$obs)) == 0, 0, (mpred/pred)*y)]
+  stratbin <- o$.stratbin
+  # predcorrect after binning, check if binning/binless has already been specified
+
+  if (!is.null(o$vpc.method)) {
+    if(o$vpc.method$method == "binless") {
+      o$vpc.method$loess.ypc <- TRUE
+    } else { #binning specified, perform ypc calculcation
+      mpred <- data.table(stratbin, pred)[, mpred := median(pred), by = stratbin]$mpred
+
+      if (log) {
+        o$obs[, ypc := (mpred - pred) + y]
+        o$sim[, ypc := (mpred - pred) + y]
+      } else {
+        o$obs[, ypc := ifelse(pred == 0, 0, (mpred / pred) * y)]
+        o$sim[, ypc := ifelse(rep(pred, times = nrow(o$sim) / nrow(o$obs)) == 0, 0, (mpred / pred) * y)]
+      }
+    }
   }
 
-
-  update(o, predcor=TRUE, predcor.log=log, pred=pred )
+  update(o, predcor=TRUE, predcor.log=log, pred=pred)
 }
 
 #' Remove prediction correction for Visual Predictive Check (VPC)