Improved handling of NAs in fct_reorder()

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

NEWS.md

@@ -1,5 +1,12 @@
 # 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 `.na_last` argument that allows you to control
+  where levels that are empty or only contain missing values are placed (#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,12 @@
 #' @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()` silently remove missing values?
+#'   If `FALSE`, the default, will remove missing values with a warning.
+#' @param .na_last Should `NA` values be ordered last (`TRUE`) or first
+#'   (`FALSE`). Particularly important for empty levels, since their
+#'   summary result will always be `NA`.
+#' @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,15 +49,24 @@
 #'   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 = FALSE, .na_last = TRUE, .desc = FALSE) {
   f <- check_factor(.f)
   stopifnot(length(f) == length(.x))
   check_dots_used()
 
+  miss <- is.na(.x)
+  if (any(miss) && !isTRUE(.na_rm)) {
+    cli::cli_warn(c(
+      "{.fn fct_reorder} removing {sum(miss)} missing value{?s}.",
+      i = "Use `.na_rm = TRUE` to silence this message"
+    ))
+  }
+  .x <- .x[!miss]
+  .f <- .f[!miss]
+
   summary <- tapply(.x, .f, .fun, ...)
   check_single_value_per_group(summary, ".fun")
-
-  lvls_reorder(f, order(summary, decreasing = .desc))
+  lvls_reorder(f, order(summary, decreasing = .desc, na.last = .na_last))
 }
 
 #' @export

tests/testthat/_snaps/reorder.md

@@ -21,6 +21,15 @@
       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
+
 # fct_infreq() validates weight
 
     Code

tests/testthat/test-reorder.R

@@ -71,6 +71,21 @@ 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"))
+})
+
+test_that("can control the placement of NA levels", {
+  f1 <- fct(c("a", "b", "c"), letters[1:4])
+  x <- c(1, 2, 3)
+
+  f2 <- fct_reorder(f1, x, .na_last = FALSE)
+  expect_equal(levels(f2), c("d", "a", "b", "c"))
+})
 
 # fct_infreq --------------------------------------------------------------