Improved handling of NAs in fct_reorder() (#341)

* Drop missing values in `.x` by default. Fixes #315.
* New `.default` argument to control position of NAs. Fixes #266.

NEWS.md

@@ -1,5 +1,13 @@
 # forcats (development version)
 
+* `fct_reorder()` now removes `NA` values in `.x` with a warning (like
+   `ggplot2::geom_point()` and friends). You can suppress the warning by
+   setting `.na_rm = TRUE` (#315).
+
+* `fct_reorder()` gains a new `.default` argument that controls the placement of 
+  empty levels (including levels that might become empty after removing
+  missing values in `.x`) (#266).
+
 * `fct_explicit_na()` is deprecated in favour of `fct_na_value_to_level()`.
 
 * New `fct_na_value_to_level()` and `fct_na_level_to_value()` to convert 

R/reorder.R

@@ -12,8 +12,14 @@
 #' @param .fun n summary function. It should take one vector for
 #'   `fct_reorder`, and two vectors for `fct_reorder2`, and return a single
 #'   value.
-#' @param ... Other arguments passed on to `.fun`. A common argument is
-#'   `na.rm = TRUE`.
+#' @param .na_rm Should `fct_reorder()` remove missing values?
+#'   If `NULL`, the default, will remove missing values with a warning.
+#'   Set to `FALSE` to preserve `NA`s (if you `.fun` already handles them) and
+#'   `TRUE` to remove silently.
+#' @param .default What default value should we use for `.fun` for
+#'   empty levels? Use this to control where empty levels appear in the
+#'   output.
+#' @param ... Other arguments passed on to `.fun`.
 #' @param .desc Order in descending order? Note the default is different
 #'   between `fct_reorder` and `fct_reorder2`, in order to
 #'   match the default ordering of factors in the legend.
@@ -45,14 +51,31 @@
 #'   geom_point() +
 #'   geom_line() +
 #'   labs(colour = "Chick")
-fct_reorder <- function(.f, .x, .fun = median, ..., .desc = FALSE) {
+fct_reorder <- function(.f, .x, .fun = median, ..., .na_rm = NULL, .default = Inf, .desc = FALSE) {
   f <- check_factor(.f)
   stopifnot(length(f) == length(.x))
+  .fun <- as_function(.fun)
   check_dots_used()
 
-  summary <- tapply(.x, .f, .fun, ...)
-  check_single_value_per_group(summary, ".fun")
+  miss <- is.na(.x)
+  if (any(miss)) {
+    if (is.null(.na_rm)) {
+      cli::cli_warn(c(
+        "{.fn fct_reorder} removing {sum(miss)} missing value{?s}.",
+        i = "Use {.code .na_rm = TRUE} to silence this message.",
+        i = "Use {.code .na_rm = FALSE} to preserve NAs."
+      ))
+      .na_rm <- TRUE
+    }
+
+    if (isTRUE(.na_rm)) {
+      .x <- .x[!miss]
+      .f <- .f[!miss]
+    }
+  }
 
+  summary <- tapply(.x, .f, function(x) .fun(x, ...), default = .default)
+  check_single_value_per_group(summary, ".fun")
   lvls_reorder(f, order(summary, decreasing = .desc))
 }
 

tests/testthat/_snaps/reorder.md

@@ -21,6 +21,16 @@
       Error in `fct_reorder2()`:
       ! `.fun` must return a single value per group
 
+# automatically removes missing values with a warning
+
+    Code
+      f2 <- fct_reorder(f1, x)
+    Condition
+      Warning:
+      `fct_reorder()` removing 1 missing value.
+      i Use `.na_rm = TRUE` to silence this message.
+      i Use `.na_rm = FALSE` to preserve NAs.
+
 # fct_infreq() validates weight
 
     Code

tests/testthat/test-reorder.R

@@ -71,6 +71,34 @@ test_that("complains if summary doesn't return single value", {
   })
 })
 
+test_that("automatically removes missing values with a warning", {
+  f1 <- fct(c("a", "b", "c", "c"))
+  x <- c(3, 2, 1, NA)
+
+  expect_snapshot(f2 <- fct_reorder(f1, x))
+  expect_equal(levels(f2), c("c", "b", "a"))
+
+  expect_no_warning(fct_reorder(f1, x, .na_rm = TRUE))
+
+  expect_no_warning(f3 <- fct_reorder(f1, x, .na_rm = FALSE))
+  expect_equal(levels(f3), c("b", "a", "c"))
+})
+
+test_that("can control the placement of empty levels", {
+  f1 <- fct(c("a", "b", "c"), letters[1:4])
+  x <- c(1, 2, 3)
+
+  f2 <- fct_reorder(f1, x, .default = -Inf)
+  expect_equal(levels(f2), c("d", "a", "b", "c"))
+})
+
+test_that("can control the placement of levels with all missing data", {
+  f1 <- fct(c("a", "b", "c"))
+  x <- c(1, 2, NA)
+
+  f2 <- fct_reorder(f1, x, .na_rm = TRUE, .default = -Inf)
+  expect_equal(levels(f2), c("c", "a", "b"))
+})
 
 # fct_infreq --------------------------------------------------------------