Add paste_skip_na()

NAMESPACE

@@ -39,6 +39,7 @@ export(fisher.test)
 export(get_dupes)
 export(get_one_to_one)
 export(make_clean_names)
+export(paste_skip_na)
 export(remove_constant)
 export(remove_empty)
 export(remove_empty_cols)

NEWS.md

@@ -1,5 +1,9 @@
 # janitor 2.2.0.9000 - unreleased development version
 
+## New features
+
+* A new function `paste_skip_na()` pastes without including NA values (#537).
+
 ## Bug fixes
 
 * `adorn_totals("row")` now succeeds if the new `name` of the totals row is already a factor level of the input data.frame (#529, thanks @egozoglu for reporting).

R/paste_skip_na.R

@@ -0,0 +1,64 @@
+#' Like \code{paste()}, but missing values are omitted
+#'
+#' @details If all values are missing, the value from the first argument is
+#'   preserved.
+#'
+#' @param ...,sep,collapse See \code{?paste}
+#' @return A character vector of pasted values.
+#' @examples
+#' paste_skip_na(NA) # NA_character_
+#' paste_skip_na("A", NA) # "A"
+#' paste_skip_na("A", NA, c(NA, "B"), sep = ",") # c("A", "A,B")
+#' @export
+paste_skip_na <- function(..., sep = " ", collapse = NULL) {
+  args <- list(...)
+  if (length(args) <= 1) {
+    if (length(args) == 0) {
+      # match the behavior of paste
+      paste(sep = sep, collapse = collapse)
+    } else if (!is.null(collapse)) {
+      if (all(is.na(args[[1]]))) {
+        # Collapsing with all NA values results in NA
+        NA_character_
+      } else {
+        # Collapsing without all NA values collapses the non-NA values
+        paste(na.omit(args[[1]]), sep = sep, collapse = collapse)
+      }
+    } else {
+      # as.character() to ensure that logical NA values are converted to
+      # NA_character_
+      as.character(args[[1]])
+    }
+  } else {
+    # There are at least 2 arguments; paste the first two and recurse
+    a1 <- args[[1]]
+    a2 <- args[[2]]
+    if (length(a1) != length(a2)) {
+      if (length(a1) == 1) {
+        a1 <- rep(a1, length(a2))
+      } else if (length(a2) == 1) {
+        a2 <- rep(a2, length(a1))
+      } else {
+        stop("Arguments must be the same length or one argument must be a scalar.")
+      }
+    }
+    # Which arguments are NA, if any?
+    mask1 <- !is.na(a1)
+    mask2 <- !is.na(a2)
+    mask_both <- mask1 & mask2
+    mask_only2 <- (!mask1) & mask2
+    firsttwo <- a1
+    if (any(mask_only2)) {
+      firsttwo[mask_only2] <- a2[mask_only2]
+    }
+    if (any(mask_both)) {
+      # Collapse only occurs on the final pasting
+      firsttwo[mask_both] <- paste(a1[mask_both], a2[mask_both], sep = sep, collapse = NULL)
+    }
+    # prepare to recurse, and recurse
+    new_args <- append(list(firsttwo), args[-(1:2)])
+    new_args$sep <- sep
+    new_args$collapse <- collapse
+    do.call(paste_skip_na, new_args)
+  }
+}

tests/testthat/test-paste_skip_na.R

@@ -0,0 +1,25 @@
+test_that("paste_skip_na", {
+  # handle no arguments the same as paste()
+  expect_equal(paste_skip_na(), paste())
+  expect_equal(paste_skip_na(NA), NA_character_)
+  expect_equal(paste_skip_na(NA, NA), NA_character_)
+  expect_equal(paste_skip_na(NA, NA, sep = ","), NA_character_)
+  # It does not behave like paste(NA, NA, collapse = ",") nor does it behave like paste(c(), collapse = ",")
+  expect_equal(paste_skip_na(NA, NA, collapse = ","), NA_character_)
+
+  expect_equal(paste_skip_na("A", NA), "A")
+  expect_equal(paste_skip_na("A", NA, collapse = ","), "A")
+  expect_equal(paste_skip_na("A", NA, c(NA, "B"), collapse = ","), "A,A B")
+  expect_equal(paste_skip_na("A", NA, c(NA, "B"), sep = ","), c("A", "A,B"))
+
+  expect_equal(paste_skip_na(c("A", "B"), NA), c("A", "B"))
+  expect_equal(paste_skip_na(NA, c("A", "B")), c("A", "B"))
+})
+
+test_that("paste_skip_na expected errors", {
+  expect_error(
+    paste_skip_na(c("A", "B"), c("A", "B", "C")),
+    regexp = "Arguments must be the same length or one argument must be a scalar.",
+    fixed = TRUE
+  )
+})