Lump even when there's only 1 level (#336)

Fixes #274

NEWS.md

@@ -1,5 +1,9 @@
 # forcats (development version)
 
+* `fct_lump_n()` and `fct_lump_prop()` will now create an "Other" level even
+  if it only consists of a single level. This makes them consistent with the
+  other `fct_lump_*` functions (#274).
+
 * `fct_relevel()`, `fct_cross()`, and `fct_expand()` now error if you name the
   arguments in `...` since those names are ignored and your code probably 
   doesn't do what you think it does (#319).

R/lump.R

@@ -124,11 +124,6 @@ fct_lump_prop <- function(f, prop, w = NULL, other_level = "Other") {
     new_levels <- ifelse(prop_n > prop, levels(f), other_level)
   }
 
-  if (prop > 0 && sum(prop_n <= prop) <= 1) {
-    # No lumping needed
-    return(f)
-  }
-
   if (other_level %in% new_levels) {
     f <- lvls_revalue(f, new_levels)
     fct_relevel(f, other_level, after = Inf)
@@ -159,11 +154,6 @@ fct_lump_n <- function(f, n, w = NULL, other_level = "Other",
 
   new_levels <- ifelse(rank <= n, levels(f), other_level)
 
-  if (sum(rank > n) <= 1) {
-    # No lumping needed
-    return(f)
-  }
-
   if (other_level %in% new_levels) {
     f <- lvls_revalue(f, new_levels)
     fct_relevel(f, other_level, after = Inf)

tests/testthat/test-lump.R

@@ -126,12 +126,6 @@ test_that("values are correctly weighted", {
   )
 })
 
-test_that("do not change the label when no lumping occurs", {
-  f <- c("a", "a", "a", "a", "b", "b", "b", "c", "c", "d")
-  expect_equal(levels(fct_lump(f, n = 3)), c("a", "b", "c", "d"))
-  expect_equal(levels(fct_lump(f, prop = 0.1)), c("a", "b", "c", "d"))
-})
-
 test_that("only have one small other level", {
   f <- c("a", "a", "a", "a", "b", "b", "b", "c", "c", "d")
   expect_equal(levels(fct_lump(f)), c("a", "b", "c", "Other"))