Deal with dplyr deprecation of funs().

For more info, see tidyverse/dplyr/issues/3433

R/get_skimmers.R

@@ -44,7 +44,7 @@ NULL
 #' get_skimmers.integer <- function(column) {
 #'   sfl(
 #'     .type = "integer",
-#'     p50 = stats::quantile(
+#'     p50 = ~ stats::quantile(
 #'       .,
 #'       probs = .50, na.rm = TRUE, names = FALSE, type = 1
 #'     )
@@ -54,12 +54,12 @@ NULL
 #' class(x$carb) <- "integer"
 #' skim(x)
 #' \dontrun{
-#' # In a package, to revert to the V1 behavior of skimming separately with the
-#' # same functions, assign the numeric `get_skimmers`.
-#' get_skimmers.integer <- skimr::get_skimmers.numeric
+#'   # In a package, to revert to the V1 behavior of skimming separately with the
+#'   # same functions, assign the numeric `get_skimmers`.
+#'   get_skimmers.integer <- skimr::get_skimmers.numeric
 #'
-#' # Or, in a local session, use `skim_with` to create a different `skim`.
-#' new_skim <- skim_with(integer = skimr::get_skimmers.numeric())
+#'   # Or, in a local session, use `skim_with` to create a different `skim`.
+#'   new_skim <- skim_with(integer = skimr::get_skimmers.numeric())
 #' }
 #' @export
 get_skimmers <- function(column) {
@@ -79,14 +79,14 @@ get_skimmers.numeric <- function(column) {
     missing = n_missing,
     complete = n_complete,
     n = length,
-    mean = mean(., na.rm = TRUE),
-    sd = stats::sd(., na.rm = TRUE),
-    p0 = stats::quantile(., probs = 0, na.rm = TRUE, names = FALSE),
-    p25 = stats::quantile(., probs = .25, na.rm = TRUE, names = FALSE),
-    p50 = stats::quantile(., probs = .50, na.rm = TRUE, names = FALSE),
-    p75 = stats::quantile(., probs = .75, na.rm = TRUE, names = FALSE),
-    p100 = stats::quantile(., probs = 1, na.rm = TRUE, names = FALSE),
-    hist = inline_hist(., 5)
+    mean = ~ mean(., na.rm = TRUE),
+    sd = ~ stats::sd(., na.rm = TRUE),
+    p0 = ~ stats::quantile(., probs = 0, na.rm = TRUE, names = FALSE),
+    p25 = ~ stats::quantile(., probs = .25, na.rm = TRUE, names = FALSE),
+    p50 = ~ stats::quantile(., probs = .50, na.rm = TRUE, names = FALSE),
+    p75 = ~ stats::quantile(., probs = .75, na.rm = TRUE, names = FALSE),
+    p100 = ~ stats::quantile(., probs = 1, na.rm = TRUE, names = FALSE),
+    hist = ~ inline_hist(., 5)
   )
 }
 
@@ -125,7 +125,7 @@ get_skimmers.logical <- function(column) {
     missing = n_missing,
     complete = n_complete,
     n = length,
-    mean = mean(., na.rm = TRUE),
+    mean = ~ mean(., na.rm = TRUE),
     count = top_counts
   )
 }
@@ -147,9 +147,9 @@ get_skimmers.Date <- function(column) {
     missing = n_missing,
     complete = n_complete,
     n = length,
-    min = min(., na.rm = TRUE),
-    max = max(., na.rm = TRUE),
-    median = stats::median(., na.rm = TRUE),
+    min = ~ min(., na.rm = TRUE),
+    max = ~ max(., na.rm = TRUE),
+    median = ~ stats::median(., na.rm = TRUE),
     n_unique = n_unique
   )
 }
@@ -177,12 +177,12 @@ get_skimmers.ts <- function(column) {
     end = ts_end,
     frequency = stats::frequency,
     deltat = stats::deltat,
-    mean = mean(., na.rm = TRUE),
-    sd = stats::sd(., na.rm = TRUE),
-    min = min(., na.rm = TRUE),
-    max = max(., na.rm = TRUE),
-    median = stats::median(., na.rm = TRUE),
-    line_graph = inline_linegraph(., 16)
+    mean = ~ mean(., na.rm = TRUE),
+    sd = ~ stats::sd(., na.rm = TRUE),
+    min = ~ min(., na.rm = TRUE),
+    max = ~ max(., na.rm = TRUE),
+    median = ~ stats::median(., na.rm = TRUE),
+    line_graph = ~ inline_linegraph(., 16)
   )
 }
 

R/sfl.R

@@ -1,9 +1,9 @@
 #' Create a skimr function list
 #'
-#' This is an extension of [dplyr::funs()]. It is used to create a named list
-#' of functions. It also you also pass `NULL` to identify a skimming function
-#' that you wish to remove. Only functions that return a single value, working
-#' with [dplyr::summarize()], can be used within `sfl`.
+#' This constructor is used to create a named list of functions. It also you
+#' also pass `NULL` to identify a skimming function that you wish to remove.
+#' Only functions that return a single value, working with [dplyr::summarize()],
+#' can be used within `sfl`.
 #'
 #' @inheritParams dplyr::funs
 #' @param .type A character scalar. This is used to match locally-provided
@@ -12,21 +12,20 @@
 #'   returned by [dplyr::funs()] and a list of skimming functions to drop.
 #' @seealso [dplyr::funs()], [skim_with()] and [get_skimmers()].
 #' @export
-sfl <- function(..., .args = list(), .type = "") {
-  skimmer_list <- rlang::enquos(...)
+sfl <- function(..., .type = "") {
+  stopifnot(length(.type) == 1, is.character(.type))
+  skimmer_list <- rlang::list2(...)
   if (length(skimmer_list) < 1) {
     stop("Please provide one or more named argument")
   }
 
-  stopifnot(length(.type) == 1, is.character(.type))
-
-  dropable <- purrr::map_lgl(skimmer_list, rlang::quo_is_null)
+  dropable <- purrr::map_lgl(skimmer_list, is.null)
   keep <- skimmer_list[!dropable]
   drop <- skimmer_list[dropable]
   out <- list(
-    keep = dplyr::funs(!!!keep, .args = .args), drop = names(drop),
+    keep = keep,
+    drop = names(drop),
     type = .type
   )
-
   structure(out, class = "skimr_function_list")
 }

R/skim_with.R

@@ -47,19 +47,15 @@
 #' my_skim <- skim_with(numeric = sfl(mean = mean, sd = sd), append = FALSE)
 #'
 #' # Skimmers are unary functions. Partially apply arguments during assigment.
-#' # For example, you might want to remove NA values. Use `dplyr::funs()`
-#' # syntax for partial application.
-#' my_skim <- skim_with(numeric = sfl(iqr = IQR(., na.rm = TRUE)))
-#'
-#' # Or, use the `.args` argument from `dplyr::funs()`
-#' my_skim <- skim_with(numeric = sfl(median, mad, .args = list(na.rm = FALSE)))
+#' # For example, you might want to remove NA values.
+#' my_skim <- skim_with(numeric = sfl(iqr = ~ IQR(., na.rm = TRUE)))
 #'
 #' # Set multiple types of skimmers simultaneously.
 #' my_skim <- skim_with(numeric = sfl(mean), character = sfl(length))
 #'
-#' # Or pass the same as a list
+#' # Or pass the same as a list, unquoting the input.
 #' my_skimmers <- list(numeric = sfl(mean), character = sfl(length))
-#' my_skim <- skim_with(my_skimmers)
+#' my_skim <- skim_with(!!!my_skimmers)
 #' @export
 skim_with <- function(..., append = TRUE) {
   local_skimmers <- validate_assignment(...)
@@ -120,15 +116,9 @@ skim_with <- function(..., append = TRUE) {
 #' @keywords internal
 #' @noRd
 validate_assignment <- function(...) {
-  to_assign <- list(...)
-
+  to_assign <- rlang::list2(...)
   if (length(to_assign) < 1) return(to_assign)
 
-  # Need to cope with case where ... is a list already
-  if (class(to_assign[[1]]) != "skimr_function_list") {
-    to_assign <- to_assign[[1]]
-  }
-
   proposed_names <- names(to_assign)
   if (!all(nzchar(proposed_names)) || is.null(proposed_names) ||
     anyNA(proposed_names)) {
@@ -169,7 +159,7 @@ skim_one <- function(column, data, local_skimmers, append) {
   all_classes <- class(data[[column]])
   locals <- get_local_skimmers(all_classes, local_skimmers)
 
-  if (is.null(defaults$type)) {
+  if (!nzchar(defaults$type)) {
     msg <- sprintf(
       "Default skimming functions for column [%s] with class [%s]",
       column, paste(all_classes, collapse = ", ")
@@ -182,7 +172,8 @@ skim_one <- function(column, data, local_skimmers, append) {
 
   if (is.null(locals$keep)) {
     if (defaults$type == "default") {
-      warning("Couldn't find skimmers for class: %s; No user-defined `sfl` ",
+      warning(
+        "Couldn't find skimmers for class: %s; No user-defined `sfl` ",
         "provided. Falling back to `character`.",
         call. = FALSE
       )

tests/testthat/test-sfl.R

@@ -17,25 +17,12 @@ test_that("The interface for sfl's separates keep and drop functions", {
   expect_identical(input$type, "test")
 
   keep <- input$keep
-  expect_is(keep, "fun_list")
-  expect_true(attr(keep, "have_name"))
+  expect_is(keep, "list")
   expect_named(keep, "mad")
-  expect_is(keep$mad, "quosure")
-})
-
-test_that("sfl's automatically generate names", {
-  input <- sfl(mad, .type = "test")
-  keep <- input$keep
-  expect_is(keep, "fun_list")
-  expect_false(attr(keep, "have_name"))
-  expect_named(keep, "mad")
-  expect_is(keep$mad, "quosure")
 })
 
 test_that("sfl's support dummy names", {
-  input <- sfl(mean = mean(., na.rm = TRUE))
+  input <- sfl(mean = ~ mean(., na.rm = TRUE), .type = "test")
   keep <- input$keep
-  expect_identical(keep$mean, rlang::quo(mean(., na.rm = TRUE)))
-  res <- rlang::eval_tidy(keep$mean, list(. = c(NA, 1:10)))
-  expect_equal(res, 5.5)
+  expect_equal(keep$mean, rlang::quo(mean(., na.rm = TRUE)))
 })

tests/testthat/test-skim_with.R

@@ -10,7 +10,7 @@ test_that("Skimmer list is updated correctly when changing functions", {
 })
 
 test_that("Skimming functions can be changed for multiple types", {
-  newfuns1 <- sfl(iqr = IQR, q99 = quantile(., probs = .99))
+  newfuns1 <- sfl(iqr = IQR, q99 = ~ quantile(., probs = .99))
   newfuns2 <- sfl(n2 = length)
   new_skim <- skim_with(numeric = newfuns1, factor = newfuns2, append = FALSE)
   input <- new_skim(iris)
@@ -56,7 +56,7 @@ test_that("Skimmers can be removed and added at the same time", {
 })
 
 test_that("Skimming functions for new types can be added", {
-  funs <- sfl(iqr = IQR, quantile = quantile(., probs = .99))
+  funs <- sfl(iqr = IQR, quantile = ~ quantile(., probs = .99))
   expect_message(new_skim <- skim_with(new_type = funs), "new_type")
   x <- tibble::tibble(x = rnorm(10))
   class(x$x) <- "new_type"
@@ -66,7 +66,7 @@ test_that("Skimming functions for new types can be added", {
 })
 
 test_that("Set multiple sets of skimming functions", {
-  funs <- sfl(iqr = IQR, quantile = quantile(., probs = .99))
+  funs <- sfl(iqr = IQR, quantile = ~ quantile(., probs = .99))
   expect_message(
     new_skim <- skim_with(numeric = funs, new_type = funs),
     "new_type"
@@ -86,7 +86,7 @@ test_that("Set multiple sets of skimming functions", {
 
 
 test_that("Set multiple sets of skimming functions, rlang", {
-  funs <- sfl(iqr = IQR, quantile = quantile(., probs = .99))
+  funs <- sfl(iqr = IQR, quantile = ~ quantile(., probs = .99))
   expect_message(new_skim <- skim_with(!!!list(numeric = funs, new_type = funs),
     append = FALSE
   ))
@@ -113,9 +113,9 @@ test_that("An empty call to skim_with() returns the default skim()", {
   expect_identical(input(iris), skim(iris))
 })
 
-test_that("sfls can use unnamed functions", {
-  dat <- tibble::tibble(1:3)
-  new_skim <- skim_with(integer = sfl(mad), append = FALSE)
-  input <- new_skim(dat)
-  expect_named(input, c("variable", "type", "mad"))
+test_that("User-defined defaults require sfl's with class names", {
+  with_mock(
+    get_skimmers = function(column) sfl(length),
+    expect_error(skim(data.frame(1)), "Default skimming functions")
+  )
 })