more target_value interfaces

NEWS.md

@@ -2,6 +2,7 @@
 # WVPlots 1.0.8 2019-01-26
 
  * Add baseline in lift curve plot.
+ * Truth targets.
 
 # WVPlots 1.0.7 2018-12-17
 

R/DoubleDensity.R

@@ -18,6 +18,7 @@
 #' @param truthVar name of the dependent (output or result to be modeled) column in frame
 #' @param title title to place on plot
 #' @param ...  no unnamed argument, added to force named binding of later arguments.
+#' @param truth_target if not NULL compare to this scalar value.
 #' @examples
 #'
 #' mpg = ggplot2::mpg
@@ -37,16 +38,25 @@
 #' WVPlots::DoubleDensityPlot(frm, "score", "rare", title="Example double density plot")
 #'
 #' @export
-DoubleDensityPlot <- function(frame, xvar, truthVar, title,...) {
-  frame <- as.data.frame(frame)
+DoubleDensityPlot <- function(frame, xvar, truthVar, title,
+                              ...,
+                              truth_target = NULL) {
   check_frame_args_list(...,
                         frame = frame,
                         name_var_list = list(xvar = xvar, truthVar = truthVar),
                         title = title,
                         funname = "WVPlots::DoubleDensityPlot")
-  df <- data.frame(x=as.numeric(frame[[xvar]]),
-                   y=as.character(frame[[truthVar]]),
-                   stringsAsFactors=FALSE)
+  if(is.null(truth_target)) {
+    df <- data.frame(x=as.numeric(frame[[xvar]]),
+                     y=as.character(frame[[truthVar]]),
+                     stringsAsFactors=FALSE)
+  } else {
+    df <- data.frame(x=as.numeric(frame[[xvar]]),
+                     y=ifelse(frame[[truthVar]]==truth_target,
+                              truth_target,
+                              paste0("!", truth_target)),
+                     stringsAsFactors=FALSE)
+  }
   pf <- wv_gapply(df,'y',
                   partitionMethod='split',
                   function(sf) {

R/GainCurve.R

@@ -104,7 +104,8 @@ thin_frame_by_orders <- function(d, cols, groupcol, large_count) {
 #' @param title title to place on plot
 #' @param ...  no unnamed argument, added to force named binding of later arguments.
 #' @param estimate_sig logical, if TRUE compute significance.
-#' @param large_count numeric, upper bound target for number of plotting points
+#' @param large_count numeric, upper bound target for number of plotting points.
+#' @param truth_target if not NULL compare to this scalar value.
 #' @examples
 #'
 #' set.seed(34903490)
@@ -118,7 +119,8 @@ thin_frame_by_orders <- function(d, cols, groupcol, large_count) {
 GainCurvePlot = function(frame, xvar, truthVar, title,
                          ...,
                          estimate_sig = FALSE,
-                         large_count = 1000) {
+                         large_count = 1000,
+                         truth_target = NULL) {
   frame <- check_frame_args_list(...,
                                  frame = frame,
                                  name_var_list = list(xvar = xvar, truthVar = truthVar),
@@ -129,7 +131,11 @@ GainCurvePlot = function(frame, xvar, truthVar, title,
     NULL # used as a symbol, declare not an unbound variable
   sort_criterion <-
     NULL # used as a symbol, declare not an unbound variable
-  truthcol <- as.numeric(frame[[truthVar]])
+  if(!is.null(truth_target)) {
+    truthcol <- as.numeric(frame[[truthVar]]==truth_target)
+  } else {
+    truthcol <- as.numeric(frame[[truthVar]])
+  }
   predcol <- as.numeric(frame[[xvar]])
   # data frame of pred and truth, sorted in order of the predictions
   d = data.frame(predcol = predcol, truthcol = truthcol)

R/LiftCurve.R

@@ -25,6 +25,7 @@
 #' @param ...  no unnamed argument, added to force named binding of later arguments.
 #' @param large_count numeric, upper bound target for number of plotting points
 #' @param include_wizard logical, if TRUE plot the ideal or wizard plot.
+#' @param truth_target if not NULL compare to this scalar value.
 #' @examples
 #'
 #' set.seed(34903490)
@@ -38,14 +39,19 @@
 LiftCurvePlot = function(frame, xvar, truthVar, title,
                          ...,
                          large_count = 1000,
-                         include_wizard = TRUE) {
+                         include_wizard = TRUE,
+                         truth_target = NULL) {
   frame <- check_frame_args_list(...,
                                  frame = frame,
                                  name_var_list = list(xvar = xvar, truthVar = truthVar),
                                  title = title,
                                  funname = "WVPlots::LiftCurvePlot")
   pct_outcome <- pctpop <- sort_criterion <- NULL # mark as not unbound variables
-  truthcol <- as.numeric(frame[[truthVar]])
+  if(!is.null(truth_target)) {
+    truthcol <- as.numeric(frame[[truthVar]]==truth_target)
+  } else {
+    truthcol <- as.numeric(frame[[truthVar]])
+  }
   predcol <- as.numeric(frame[[xvar]])
   # data frame of pred and truth, sorted in order of the predictions
   d = data.frame(predcol = predcol, truthcol = truthcol)