feat: Add if_else

Closes #11

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: poorman
 Type: Package
 Title: A Poor Man's Base R Copy of 'dplyr' Verbs
-Version: 0.1.11.9
+Version: 0.1.11.10
 Authors@R: person("Nathan", "Eastwood", "", "[email protected]",
     role = c("aut", "cre"))
 Maintainer: Nathan Eastwood <[email protected]>

NAMESPACE

@@ -32,6 +32,7 @@ export(filter)
 export(full_join)
 export(get_groups)
 export(group_by)
+export(if_else)
 export(inner_join)
 export(lag)
 export(last_col)

R/if_else.R

@@ -0,0 +1,41 @@
+#' Vectorised if
+#'
+#' This is a wrapper around `ifelse()` which checks that `true` and `false` are of the same type, making the output more
+#' predictable.
+#'
+#' @param condition A `logical(n)` vector.
+#' @param true,false Values to use for `TRUE` and `FALSE` in `condition`. They must either be the same length as
+#' `condition` or be length 1. They must also be the same type.
+#' @param missing If not `NULL` (the default), this will replace any missing values.
+#'
+#' @return A vector the same length as `condition` with values for `TRUE` and `FALSE` replaced by those specified in
+#' `true` and `false`, respectively.
+#'
+#' @examples
+#' x <- c(-5:5, NA)
+#' if_else(x < 0, NA_integer_, x)
+#' if_else(x < 0, "negative", "positive", "missing")
+#'
+#' # Unlike ifelse, if_else preserves types
+#' x <- factor(sample(letters[1:5], 10, replace = TRUE))
+#' ifelse(x %in% c("a", "b", "c"), x, factor(NA))
+#' # Attributes are taken from the `true` vector
+#' if_else(x %in% c("a", "b", "c"), x, factor(NA))
+#'
+#' @export
+if_else <- function(condition, true, false, missing = NULL) {
+  if (!is.logical(condition)) stop("`condition` must be a logical vector.")
+  cls_true <- class(true)
+  cls_false <- class(false)
+  cls_missing <- class(missing)
+  if (!identical(cls_true, cls_false)) {
+    stop("The class of `true` <", class(true), "> is not the same as the class of `false` <", class(false), ">")
+  }
+  if (!is.null(missing) && !identical(cls_true, cls_missing)) {
+    stop("`missing` must be a ", cls_true, " vector, not a ", cls_missing, " vector.")
+  }
+  res <- ifelse(condition, true, false)
+  if (!is.null(missing)) res[is.na(res)] <- missing
+  attributes(res) <- attributes(true)
+  res
+}

inst/tinytest/test_if_else.R

@@ -0,0 +1,63 @@
+expect_equal(
+  if_else(c(TRUE, TRUE, FALSE, FALSE), 1, 2),
+  c(1, 1, 2, 2),
+  info = "Scalar true and false are vectorised"
+)
+
+expect_error(
+  if_else(c(TRUE, TRUE, FALSE, FALSE), 1, "2"),
+  info = "true and false should be the same type"
+)
+
+expect_equal(
+  {
+    x <- c(-1, 0, 1)
+    if_else(x < 0, x, 0)
+  },
+  c(-1, 0, 0),
+  info = "Vectorised true works"
+)
+
+expect_equal(
+  {
+    x <- c(-1, 0, 1)
+    if_else(x > 0, x, 0)
+  },
+  c(0, 0, 1),
+  info = "Vectorised false works"
+)
+
+expect_equal(
+  if_else(c(TRUE, NA, FALSE), -1, 1),
+  c(-1, NA, 1),
+  info = "Missing values are missing by default"
+)
+
+expect_equal(
+  if_else(c(TRUE, NA, FALSE), -1, 1, 0),
+  c(-1, 0, 1),
+  info = "Missing values are replaced"
+)
+
+expect_error(
+  if_else(c(TRUE, NA, FALSE), -1, 1, "should fail"),
+  info = "missing should be the same type as true and false"
+)
+
+expect_equal(
+  {
+    x <- factor(letters[1:5])
+    if_else(x %in% c("a", "b", "c"), x, factor(NA))
+  },
+  factor(c("a", "b", "c", NA, NA), levels = letters[1:5]),
+  info = "if_else works with factors"
+)
+
+expect_equal(
+  {
+    x <- list(1, 2, 3)
+    if_else(c(TRUE, TRUE, FALSE), x, list(NULL))
+  },
+  list(1, 2, NULL),
+  info = "if_else works with lists"
+)