Preserve names where sensible (#585)

Systematic review of all stringr functions.

Fixes #575

Author: jonovik

NEWS.md

@@ -1,5 +1,6 @@
 # stringr (development version)
 
+* All relevant stringr functions now preserve names (@jonovik, #575).
 * New `vignette("locale-sensitive")` about locale sensitive functions (@kylieainslie, #404)
 * New `str_ilike()` that follows the conventions of the SQL ILIKE operator (@edward-burn, #543).
 * `str_like(ignore_case)` is deprecated, with `str_like()` now always case sensitive to better follow the conventions of the SQL LIKE operator (@edward-burn, #543).

R/case.R

@@ -27,30 +27,31 @@ NULL
 #' @rdname case
 str_to_upper <- function(string, locale = "en") {
   check_string(locale)
-
-  stri_trans_toupper(string, locale = locale)
+  copy_names(string, stri_trans_toupper(string, locale = locale))
 }
 #' @export
 #' @rdname case
 str_to_lower <- function(string, locale = "en") {
   check_string(locale)
-
-  stri_trans_tolower(string, locale = locale)
+  copy_names(string, stri_trans_tolower(string, locale = locale))
 }
 #' @export
 #' @rdname case
 str_to_title <- function(string, locale = "en") {
   check_string(locale)
-
-  stri_trans_totitle(string, opts_brkiter = stri_opts_brkiter(locale = locale))
+  out <- stri_trans_totitle(
+    string,
+    opts_brkiter = stri_opts_brkiter(locale = locale)
+  )
+  copy_names(string, out)
 }
 #' @export
 #' @rdname case
 str_to_sentence <- function(string, locale = "en") {
   check_string(locale)
-
-  stri_trans_totitle(
+  out <- stri_trans_totitle(
     string,
     opts_brkiter = stri_opts_brkiter(type = "sentence", locale = locale)
   )
+  copy_names(string, out)
 }

R/conv.R

@@ -15,5 +15,5 @@
 str_conv <- function(string, encoding) {
   check_string(encoding)
 
-  stri_conv(string, encoding, "UTF-8")
+  copy_names(string, stri_conv(string, encoding, "UTF-8"))
 }

R/count.R

@@ -37,12 +37,13 @@
 str_count <- function(string, pattern = "") {
   check_lengths(string, pattern)
 
-  switch(
+  out <- switch(
     type(pattern),
     empty = ,
     bound = stri_count_boundaries(string, opts_brkiter = opts(pattern)),
     fixed = stri_count_fixed(string, pattern, opts_fixed = opts(pattern)),
     coll = stri_count_coll(string, pattern, opts_collator = opts(pattern)),
     regex = stri_count_regex(string, pattern, opts_regex = opts(pattern))
   )
+  preserve_names_if_possible(string, pattern, out)
 }

R/detect.R

@@ -42,7 +42,7 @@ str_detect <- function(string, pattern, negate = FALSE) {
   check_lengths(string, pattern)
   check_bool(negate)
 
-  switch(
+  out <- switch(
     type(pattern),
     empty = no_empty(),
     bound = no_boundary(),
@@ -65,6 +65,8 @@ str_detect <- function(string, pattern, negate = FALSE) {
       opts_regex = opts(pattern)
     )
   )
+
+  preserve_names_if_possible(string, pattern, out)
 }
 
 #' Detect the presence/absence of a match at the start/end
@@ -94,7 +96,7 @@ str_starts <- function(string, pattern, negate = FALSE) {
   check_lengths(string, pattern)
   check_bool(negate)
 
-  switch(
+  out <- switch(
     type(pattern),
     empty = no_empty(),
     bound = no_boundary(),
@@ -120,6 +122,7 @@ str_starts <- function(string, pattern, negate = FALSE) {
       )
     }
   )
+  preserve_names_if_possible(string, pattern, out)
 }
 
 #' @rdname str_starts
@@ -128,7 +131,7 @@ str_ends <- function(string, pattern, negate = FALSE) {
   check_lengths(string, pattern)
   check_bool(negate)
 
-  switch(
+  out <- switch(
     type(pattern),
     empty = no_empty(),
     bound = no_boundary(),
@@ -154,6 +157,7 @@ str_ends <- function(string, pattern, negate = FALSE) {
       )
     }
   )
+  preserve_names_if_possible(string, pattern, out)
 }
 
 #' Detect a pattern in the same way as `SQL`'s `LIKE` and `ILIKE` operators
@@ -216,7 +220,8 @@ str_like <- function(string, pattern, ignore_case = deprecated()) {
   }
 
   pattern <- regex(like_to_regex(pattern), ignore_case = FALSE)
-  stri_detect_regex(string, pattern, opts_regex = opts(pattern))
+  out <- stri_detect_regex(string, pattern, opts_regex = opts(pattern))
+  preserve_names_if_possible(string, pattern, out)
 }
 
 #' @export
@@ -231,7 +236,8 @@ str_ilike <- function(string, pattern) {
   }
 
   pattern <- regex(like_to_regex(pattern), ignore_case = TRUE)
-  stri_detect_regex(string, pattern, opts_regex = opts(pattern))
+  out <- stri_detect_regex(string, pattern, opts_regex = opts(pattern))
+  preserve_names_if_possible(string, pattern, out)
 }
 
 like_to_regex <- function(pattern) {

R/dup.R

@@ -19,10 +19,12 @@ str_dup <- function(string, times, sep = NULL) {
   check_string(sep, allow_null = TRUE)
 
   if (is.null(sep)) {
-    stri_dup(input$string, input$times)
+    out <- stri_dup(input$string, input$times)
   } else {
-    map_chr(seq_along(input$string), function(i) {
+    out <- map_chr(seq_along(input$string), function(i) {
       paste(rep(string[[i]], input$times[[i]]), collapse = sep)
     })
   }
+  names(out) <- names(input$string)
+  out
 }

R/escape.R

@@ -12,5 +12,6 @@
 #' str_detect(c("a", "."), ".")
 #' str_detect(c("a", "."), str_escape("."))
 str_escape <- function(string) {
-  str_replace_all(string, "([.^$\\\\|*+?{}\\[\\]()])", "\\\\\\1")
+  out <- str_replace_all(string, "([.^$\\\\|*+?{}\\[\\]()])", "\\\\\\1")
+  copy_names(string, out)
 }

R/extract.R

@@ -40,30 +40,21 @@
 #' str_extract_all("This is, suprisingly, a sentence.", boundary("word"))
 str_extract <- function(string, pattern, group = NULL) {
   if (!is.null(group)) {
-    return(str_match(string, pattern)[, group + 1])
+    out <- str_match(string, pattern)[, group + 1]
+    return(preserve_names_if_possible(string, pattern, out))
   }
 
   check_lengths(string, pattern)
-  switch(
+  opt <- opts(pattern)
+  out <- switch(
     type(pattern),
-    empty = stri_extract_first_boundaries(string, opts_brkiter = opts(pattern)),
-    bound = stri_extract_first_boundaries(string, opts_brkiter = opts(pattern)),
-    fixed = stri_extract_first_fixed(
-      string,
-      pattern,
-      opts_fixed = opts(pattern)
-    ),
-    coll = stri_extract_first_coll(
-      string,
-      pattern,
-      opts_collator = opts(pattern)
-    ),
-    regex = stri_extract_first_regex(
-      string,
-      pattern,
-      opts_regex = opts(pattern)
-    )
+    empty = stri_extract_first_boundaries(string, opts_brkiter = opt),
+    bound = stri_extract_first_boundaries(string, opts_brkiter = opt),
+    fixed = stri_extract_first_fixed(string, pattern, opts_fixed = opt),
+    coll = stri_extract_first_coll(string, pattern, opts_collator = opt),
+    regex = stri_extract_first_regex(string, pattern, opts_regex = opt)
   )
+  preserve_names_if_possible(string, pattern, out)
 }
 
 #' @rdname str_extract
@@ -72,40 +63,42 @@ str_extract_all <- function(string, pattern, simplify = FALSE) {
   check_lengths(string, pattern)
   check_bool(simplify)
 
-  switch(
+  opt <- opts(pattern)
+  out <- switch(
     type(pattern),
     empty = stri_extract_all_boundaries(
       string,
       simplify = simplify,
       omit_no_match = TRUE,
-      opts_brkiter = opts(pattern)
+      opts_brkiter = opt
     ),
     bound = stri_extract_all_boundaries(
       string,
       simplify = simplify,
       omit_no_match = TRUE,
-      opts_brkiter = opts(pattern)
+      opts_brkiter = opt
     ),
     fixed = stri_extract_all_fixed(
       string,
       pattern,
       simplify = simplify,
       omit_no_match = TRUE,
-      opts_fixed = opts(pattern)
+      opts_fixed = opt
     ),
     coll = stri_extract_all_coll(
       string,
       pattern,
       simplify = simplify,
       omit_no_match = TRUE,
-      opts_collator = opts(pattern)
+      opts_collator = opt
     ),
     regex = stri_extract_all_regex(
       string,
       pattern,
       simplify = simplify,
       omit_no_match = TRUE,
-      opts_regex = opts(pattern)
+      opts_regex = opt
     )
   )
+  preserve_names_if_possible(string, pattern, out)
 }

R/length.R

@@ -34,11 +34,11 @@
 #' # Because the second element is made up of a u + an accent
 #' str_sub(u, 1, 1)
 str_length <- function(string) {
-  stri_length(string)
+  copy_names(string, stri_length(string))
 }
 
 #' @export
 #' @rdname str_length
 str_width <- function(string) {
-  stri_width(string)
+  copy_names(string, stri_width(string))
 }

R/locate.R

@@ -37,7 +37,7 @@
 str_locate <- function(string, pattern) {
   check_lengths(string, pattern)
 
-  switch(
+  out <- switch(
     type(pattern),
     empty = ,
     bound = stri_locate_first_boundaries(string, opts_brkiter = opts(pattern)),
@@ -53,6 +53,7 @@ str_locate <- function(string, pattern) {
     ),
     regex = stri_locate_first_regex(string, pattern, opts_regex = opts(pattern))
   )
+  preserve_names_if_possible(string, pattern, out)
 }
 
 #' @rdname str_locate
@@ -61,7 +62,7 @@ str_locate_all <- function(string, pattern) {
   check_lengths(string, pattern)
   opts <- opts(pattern)
 
-  switch(
+  out <- switch(
     type(pattern),
     empty = ,
     bound = stri_locate_all_boundaries(
@@ -88,6 +89,7 @@ str_locate_all <- function(string, pattern) {
       opts_collator = opts
     )
   )
+  preserve_names_if_possible(string, pattern, out)
 }