Don't special-case if string is logical NA. Restore switch() in str_subset().

Remove tests for special-casing NA.
Remove a few redundant if's.
Comment on copy_names() and keep_names() in utils.R.

Author: jonovik

R/sub.R

@@ -94,5 +94,5 @@ str_sub_all <- function(string, start = 1L, end = -1L) {
   } else {
     stri_sub_all(string, from = start, to = end)
   }
-  if (length(out) == length(string)) copy_names(string, out) else out
+  copy_names(string, out)
 }

R/subset.R

@@ -30,18 +30,17 @@ str_subset <- function(string, pattern, negate = FALSE) {
   check_lengths(string, pattern)
   check_bool(negate)
 
-  if (type(pattern) == "empty") no_empty()
-  if (type(pattern) == "bound") no_boundary()
+  idx <- switch(
+    type(pattern),
+    empty = no_empty(),
+    bound = no_boundary(),
+    fixed = str_detect(string, pattern, negate = negate),
+    coll = str_detect(string, pattern, negate = negate),
+    regex = str_detect(string, pattern, negate = negate)
+  )
 
-  idx <- str_detect(string, pattern, negate = negate)
-  # str_detect() returns NA for NAs in string, but str_subset() should drop them
   idx[is.na(idx)] <- FALSE
-  out <- string[idx]
-  # Work around the fact that as.character() drops names
-  nm <- names(out)
-  out <- as.character(out)
-  names(out) <- nm
-  out
+  string[idx]
 }
 
 #' Find matching indices

R/unique.R

@@ -27,10 +27,6 @@ str_unique <- function(string, locale = "en", ignore_case = FALSE, ...) {
     ...
   )
 
-  # Ensure character output while preserving names of first occurrences
-  string_chr <- as.character(string)
-  keep <- !stringi::stri_duplicated(string_chr, opts_collator = opts)
-  out <- string_chr[keep]
-  names(out) <- names(string)[keep]
-  out
+  keep <- !stringi::stri_duplicated(string, opts_collator = opts)
+  string[keep]
 }

R/utils.R

@@ -30,6 +30,9 @@ tr_ <- function(...) {
   enc2utf8(gettext(paste0(...), domain = "R-stringr"))
 }
 
+# Helper to copy names from `string` to output.
+# For vector output (including list), set `names`.
+# For matrix output, set `rownames`.
 copy_names <- function(from, to) {
   nm <- names(from)
   if (is.null(nm)) return(to)
@@ -42,7 +45,8 @@ copy_names <- function(from, to) {
   }
 }
 
+# Whether to name the output using names from `string`:
+# We'll preserve names if pattern is scalar or aligns with string.
 keep_names <- function(string, pattern) {
-  if (is.null(names(string))) return(FALSE)
   length(pattern) == 1L || length(pattern) == length(string)
 }

tests/testthat/test-subset.R

@@ -55,5 +55,5 @@ test_that("str_subset() preserves names of retained elements", {
 
 test_that("str_subset() never matches missing values", {
   expect_equal(str_subset(c("a", NA, "b"), "."), c("a", "b"))
-  expect_identical(str_subset(NA, "."), character(0))
+  expect_identical(str_subset(NA_character_, "."), character(0))
 })

tests/testthat/test-unique.R

@@ -1,17 +1,12 @@
 test_that("unique values returned for strings with duplicate values", {
   expect_equal(str_unique(c("a", "a", "a")), "a")
-  expect_equal(str_unique(c(NA, NA)), NA_character_)
+  expect_equal(str_unique(c(NA_character_, NA_character_)), NA_character_)
 })
 
 test_that("can ignore case", {
   expect_equal(str_unique(c("a", "A"), ignore_case = TRUE), "a")
 })
 
-test_that("str_unique() returns NA_character_ for NA inputs", {
-  expect_equal(str_unique(c(NA_character_, NA_character_)), NA_character_)
-  expect_equal(str_unique(c(NA, NA)), NA_character_)
-})
-
 test_that("str_unique() preserves names of first occurrences", {
   y <- c(A = "a", A2 = "a", B = "b")
   out <- str_unique(y)

tests/testthat/test-utils.R

@@ -1,19 +1,13 @@
 test_that("keep_names() returns logical flag based on inputs", {
-  string_unnamed_scalar <- "s"
-  string_named_scalar <- c("A" = "s")
-  string_unnamed_vector <- c("s1", "s2")
-  string_named_vector <- c(A = "s1", B = "s2")
+  string_scalar <- c("A" = "s")
+  string_vector <- c(A = "s1", B = "s2")
   pattern_scalar <- "p"
   pattern_vector <- c("p1", "p2")
 
-  expect_true(keep_names(string_named_scalar, pattern_scalar))
-  expect_false(keep_names(string_named_scalar, pattern_vector))
-  expect_true(keep_names(string_named_vector, pattern_scalar))
-  expect_true(keep_names(string_named_vector, pattern_vector))
-  expect_false(keep_names(string_unnamed_scalar, pattern_scalar))
-  expect_false(keep_names(string_unnamed_scalar, pattern_vector))
-  expect_false(keep_names(string_unnamed_vector, pattern_scalar))
-  expect_false(keep_names(string_unnamed_vector, pattern_vector))
+  expect_true(keep_names(string_scalar, pattern_scalar))
+  expect_false(keep_names(string_scalar, pattern_vector))
+  expect_true(keep_names(string_vector, pattern_scalar))
+  expect_true(keep_names(string_vector, pattern_vector))
 })
 
 test_that("copy_names() applies names to vectors", {