Merge pull request #277 from tidymodels/check-for-pipe

add error for piping after visualize()

Author: ismayc

R/shade_confidence_interval.R

@@ -70,6 +70,9 @@ NULL
 #' @export
 shade_confidence_interval <- function(endpoints, color = "mediumaquamarine",
                                       fill = "turquoise", ...) {
+  # argument checking
+  check_for_piped_visualize(endpoints, color, fill)
+  
   dots <- list(...)
 
   endpoints <- impute_endpoints(endpoints)

R/shade_p_value.R

@@ -60,6 +60,8 @@ NULL
 #' @export
 shade_p_value <- function(obs_stat, direction,
                           color = "red2", fill = "pink", ...) {
+  # argument checking
+  check_for_piped_visualize(obs_stat, direction, color, fill)
   obs_stat <- check_obs_stat(obs_stat)
   check_shade_p_value_args(obs_stat, direction, color, fill)
 

R/utils.R

@@ -367,6 +367,7 @@ check_direction <- function(direction = c("less", "greater", "two_sided",
 
 check_obs_stat <- function(obs_stat) {
   if (!is.null(obs_stat)) {
+    
     if ("data.frame" %in% class(obs_stat)) {
       check_type(obs_stat, is.data.frame)
       if ((nrow(obs_stat) != 1) || (ncol(obs_stat) != 1)) {
@@ -439,3 +440,26 @@ parse_type <- function(f_name) {
     regexec("is[_\\.]([[:alnum:]_\\.]+)$", f_name)
   )[[1]][2]
 }
+
+# Helpers for visualize() Utilities -----------------------------------------------
+
+# a function for checking arguments to functions that are added as layers
+# to visualize()d objects to make sure they weren't mistakenly piped
+check_for_piped_visualize <- function(...) {
+  
+  is_ggplot_output <- vapply(list(...), ggplot2::is.ggplot, logical(1))
+  
+  if (any(is_ggplot_output)) {
+    
+    called_function <- sys.call(-1)[[1]]
+    
+    stop_glue(
+      "It looks like you piped the result of `visualize()` into ",
+      "`{called_function}()` (using `%>%`) rather than adding the result of ",
+      "`{called_function}()` as a layer with `+`. Consider changing",
+      "`%>%` to `+`."
+    )
+  }
+  
+  TRUE
+}

tests/testthat/test-shade_confidence_interval.R

@@ -68,6 +68,22 @@ test_that("shade_confidence_interval throws errors and warnings", {
     iris_viz_sim + shade_confidence_interval(c(-1, 1), fill = "x"),
     "color"
   )
+  expect_error(
+    iris_viz_sim %>% shade_confidence_interval(c(-1, 1)), 
+    "\\`shade_confidence_interval\\(\\)\\` as a layer"
+  )
+  expect_error(
+    iris_viz_sim %>% shade_confidence_interval(endpoints = c(-1, 1)), 
+    "\\`shade_confidence_interval\\(\\)\\` as a layer"
+  )
+  expect_error(
+    iris_viz_sim %>% shade_ci(c(-1, 1)), 
+    "\\`shade_ci\\(\\)\\` as a layer"
+  )
+  expect_error(
+    iris_viz_sim %>% shade_ci(endpoints = c(-1, 1)), 
+    "\\`shade_ci\\(\\)\\` as a layer"
+  )
 })
 
 

tests/testthat/test-shade_p_value.R

@@ -92,6 +92,21 @@ test_that("shade_p_value throws errors", {
   expect_error(iris_viz_sim + shade_p_value(1, 1), "character")
   expect_error(iris_viz_sim + shade_p_value(1, "right", color = "x"), "color")
   expect_error(iris_viz_sim + shade_p_value(1, "right", fill = "x"), "color")
+  expect_error(iris_viz_sim %>% shade_p_value(1, "right"), 
+               "\\`shade_p_value\\(\\)\\` as a layer")
+  expect_error(iris_viz_sim %>% shade_p_value(obs_stat = 1), 
+               "\\`shade_p_value\\(\\)\\` as a layer")
+  expect_error(iris_viz_sim %>% shade_p_value(obs_stat = 1, 
+                                              direction = "right"), 
+               "\\`shade_p_value\\(\\)\\` as a layer")
+  expect_error(iris_viz_sim %>% shade_pvalue(1, "right"), 
+               "\\`shade_pvalue\\(\\)\\` as a layer")
+  expect_error(iris_viz_sim %>% shade_pvalue(obs_stat = 1), 
+               "\\`shade_pvalue\\(\\)\\` as a layer")
+  expect_error(iris_viz_sim %>% shade_pvalue(obs_stat = 1, 
+                                              direction = "right"), 
+               "\\`shade_pvalue\\(\\)\\` as a layer")
+  
 })