Implement fct() (#305)

Fixes #299

NAMESPACE

@@ -6,6 +6,7 @@ S3method(as_factor,logical)
 S3method(as_factor,numeric)
 export("%>%")
 export(as_factor)
+export(fct)
 export(fct_anon)
 export(fct_c)
 export(fct_collapse)

NEWS.md

@@ -1,5 +1,8 @@
 # forcats (development version)
 
+* New `fct()` which works like `factor()` but errors if values of `x`
+  are not included in the levels specification (#299)
+
 * `first2()` and `last2()` now ignore missing values in both `x` and `y` (#303).
 
 * Error messages are more informative.

R/explicit_na.R

@@ -4,14 +4,17 @@
 #' appear in summaries and on plots.
 #'
 #' @param f A factor (or character vector).
-#' @param na_level Level to use for missing values: this is what NAs will be changed to.
+#' @param na_level Level to use for missing values: this is what `NA`s will be
+#'   changed to.
 #' @export
 #' @examples
 #' f1 <- factor(c("a", "a", NA, NA, "a", "b", NA, "c", "a", "c", "b"))
 #' fct_count(f1)
+#' table(is.na(f1))
 #'
 #' f2 <- fct_explicit_na(f1)
 #' fct_count(f2)
+#' table(is.na(f2))
 fct_explicit_na <- function(f, na_level = "(Missing)") {
   f <- check_factor(f)
 

R/fct.R

@@ -0,0 +1,62 @@
+#' Create a factor
+#'
+#' `fct()` is a stricter version of [factor()] that errors if your
+#' specification of `levels` is inconsistent with the values in `x`.
+#'
+#' @param x A character vector. Values must occur in either `levels` or `na`.
+#' @param levels A character vector of known levels. If not supplied, will
+#'   be computed from the unique values of `x`, in the order in which they
+#'   occur.
+#' @param na A character vector of values that should become missing values.
+#' @return A factor.
+#' @export
+#' @examples
+#' # Use factors when you know the set of possible values a variable might take
+#' x <- c("A", "O", "O", "AB", "A")
+#' fct(x, levels = c("O", "A", "B", "AB"))
+#'
+#' # If you don't specify the levels, fct will create from the data
+#' # in the order that they're seen
+#' fct(x)
+#'
+#'
+#' # Differences with base R -----------------------------------------------
+#' # factor() silently generates NAs
+#' x <- c("a", "b", "c")
+#' factor(x, levels = c("a", "b"))
+#' # fct() errors
+#' try(fct(x, levels = c("a", "b")))
+#' # Unless you explicitly supply NA:
+#' fct(x, levels = c("a", "b"), na = "c")
+#'
+#' # factor() sorts default levels:
+#' factor(c("y", "x"))
+#' # fct() uses in order of appearance:
+#' fct(c("y", "x"))
+fct <- function(x = character(), levels = NULL, na = character()) {
+  if (!is.character(x)) {
+    cli::cli_abort("{.arg x} must be a character vector")
+  }
+  if (!is.character(na)) {
+    cli::cli_abort("{.arg na} must be a character vector")
+  }
+
+  x[x %in% na] <- NA
+
+  if (is.null(levels)) {
+    levels <- unique(x)
+    levels <- levels[!is.na(levels)]
+  } else if (!is.character(levels)) {
+    cli::cli_abort("{.arg levels} must be a character vector")
+  }
+
+  invalid <- setdiff(x, c(levels, NA))
+  if (length(invalid) > 0 ) {
+    cli::cli_abort(c(
+      "All values of {.arg x} must appear in {.arg levels} or {.arg na}",
+      i = "Missing level{?s}: {.str {invalid}}"
+    ))
+  }
+
+  factor(x, levels = levels, exclude = NULL)
+}

_pkgdown.yml

@@ -57,6 +57,7 @@ reference:
 
   - title: Other helpers
     contents:
+    - fct
     - as_factor
     - fct_count
     - fct_match

tests/testthat/_snaps/fct.md

@@ -0,0 +1,27 @@
+# checks input types
+
+    Code
+      fct(1:3)
+    Condition
+      Error in `fct()`:
+      ! `x` must be a character vector
+    Code
+      fct("x", 1:3)
+    Condition
+      Error in `fct()`:
+      ! `levels` must be a character vector
+    Code
+      fct("x", "y", na = 1)
+    Condition
+      Error in `fct()`:
+      ! `na` must be a character vector
+
+# clear error if levels are incomplete
+
+    Code
+      fct(c("x", "y", "z"), c("x", "y"))
+    Condition
+      Error in `fct()`:
+      ! All values of `x` must appear in `levels` or `na`
+      i Missing level: "z"
+

tests/testthat/test-fct.R

@@ -0,0 +1,42 @@
+test_that("can create simple example", {
+  expect_equal(
+    fct(c("x", "y", "z")),
+    factor(c("x", "y", "z"))
+  )
+})
+
+test_that("orders by appearance", {
+  expect_equal(
+    fct(c("y", "x")),
+    factor(c("y", "x"), levels = c("y", "x"))
+  )
+})
+
+test_that("checks input types", {
+  expect_snapshot(error = TRUE, {
+    fct(1:3)
+    fct("x", 1:3)
+    fct("x", "y", na = 1)
+  })
+})
+
+test_that("clear error if levels are incomplete", {
+  expect_snapshot(error = TRUE,
+    fct(c("x", "y", "z"), c("x", "y"))
+  )
+})
+
+test_that("can covert values to implicit or explcit NA", {
+  expect_equal(
+    fct(c("x", "y", "z"), na = "z"),
+    factor(c("x", "y", NA), levels = c("x", "y"))
+  )
+  expect_equal(
+    fct(c("x", "y", "z"), c("x", "y"), na = "z"),
+    factor(c("x", "y", NA), levels = c("x", "y"))
+  )
+  expect_equal(
+    fct(c("x", "y", "z"), c("x", "y", NA), na = "z"),
+    factor(c("x", "y", NA), levels = c("x", "y", NA), exclude = NULL)
+  )
+})