Preserve names where sensible

R/case.R

@@ -27,30 +27,29 @@ 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/compat-purrr.R

@@ -10,9 +10,7 @@ map <- function(.x, .f, ...) {
   lapply(.x, .f, ...)
 }
 map_mold <- function(.x, .f, .mold, ...) {
-  out <- vapply(.x, .f, .mold, ..., USE.NAMES = FALSE)
-  names(out) <- names(.x)
-  out
+  copy_names(.x, vapply(.x, .f, .mold, ..., USE.NAMES = FALSE))
 }
 map_lgl <- function(.x, .f, ...) {
   map_mold(.x, .f, logical(1), ...)

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,11 +37,13 @@
 str_count <- function(string, pattern = "") {
   check_lengths(string, pattern)
 
-  switch(type(pattern),
+  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))
   )
+  if (length(out) == length(string)) names(out) <- names(string)
+  out
 }

R/detect.R

@@ -42,13 +42,18 @@ str_detect <- function(string, pattern, negate = FALSE) {
   check_lengths(string, pattern)
   check_bool(negate)
 
-  switch(type(pattern),
+  out <- switch(type(pattern),
     empty = no_empty(),
     bound = no_boundary(),
     fixed = stri_detect_fixed(string, pattern, negate = negate, opts_fixed = opts(pattern)),
     coll  = stri_detect_coll(string,  pattern, negate = negate, opts_collator = opts(pattern)),
     regex = stri_detect_regex(string, pattern, negate = negate, opts_regex = opts(pattern))
   )
+
+  if (length(out) == length(string)) {
+    names(out) <- names(string)
+  }
+  out
 }
 
 #' Detect the presence/absence of a match at the start/end
@@ -78,7 +83,7 @@ str_starts <- function(string, pattern, negate = FALSE) {
   check_lengths(string, pattern)
   check_bool(negate)
 
-  switch(type(pattern),
+  out <- switch(type(pattern),
     empty = no_empty(),
     bound = no_boundary(),
     fixed = stri_startswith_fixed(string, pattern, negate = negate, opts_fixed = opts(pattern)),
@@ -88,6 +93,8 @@ str_starts <- function(string, pattern, negate = FALSE) {
       stri_detect_regex(string, pattern2, negate = negate, opts_regex = opts(pattern))
     }
   )
+  if (length(out) == length(string)) names(out) <- names(string)
+  out
 }
 
 #' @rdname str_starts
@@ -96,7 +103,7 @@ str_ends <- function(string, pattern, negate = FALSE) {
   check_lengths(string, pattern)
   check_bool(negate)
 
-  switch(type(pattern),
+  out <- switch(type(pattern),
     empty = no_empty(),
     bound = no_boundary(),
     fixed = stri_endswith_fixed(string, pattern, negate = negate, opts_fixed = opts(pattern)),
@@ -106,6 +113,8 @@ str_ends <- function(string, pattern, negate = FALSE) {
       stri_detect_regex(string, pattern2, negate = negate, opts_regex = opts(pattern))
     }
   )
+  if (length(out) == length(string)) names(out) <- names(string)
+  out
 }
 
 #' Detect a pattern in the same way as `SQL`'s `LIKE` and `ILIKE` operators
@@ -166,7 +175,9 @@ 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))
+  if (length(out) == length(string)) names(out) <- names(string)
+  out
 }
 
 #' @export
@@ -179,7 +190,9 @@ 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))
+  if (length(out) == length(string)) names(out) <- names(string)
+  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,17 +40,22 @@
 #' 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]
+    if (length(out) == length(string)) names(out) <- names(string)
+    return(out)
   }
 
   check_lengths(string, pattern)
-  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))
+  opt <- opts(pattern)
+  out <- switch(type(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)
   )
+  if (length(out) == length(string)) names(out) <- names(string)
+  out
 }
 
 #' @rdname str_extract
@@ -59,16 +64,23 @@ str_extract_all <- function(string, pattern, simplify = FALSE) {
   check_lengths(string, pattern)
   check_bool(simplify)
 
-  switch(type(pattern),
+  opt <- opts(pattern)
+  out <- switch(type(pattern),
     empty = stri_extract_all_boundaries(string,
-      simplify = simplify, omit_no_match = TRUE, opts_brkiter = opts(pattern)),
+      simplify = simplify, omit_no_match = TRUE, opts_brkiter = opt),
     bound = stri_extract_all_boundaries(string,
-      simplify = simplify, omit_no_match = TRUE, opts_brkiter = opts(pattern)),
+      simplify = simplify, omit_no_match = TRUE, opts_brkiter = opt),
     fixed = stri_extract_all_fixed(string, pattern,
-      simplify = simplify, omit_no_match = TRUE, opts_fixed = opts(pattern)),
+      simplify = simplify, omit_no_match = TRUE, opts_fixed = opt),
     coll  = stri_extract_all_coll(string, pattern,
-      simplify = simplify, omit_no_match = TRUE, opts_collator = opts(pattern)),
+      simplify = simplify, omit_no_match = TRUE, opts_collator = opt),
     regex = stri_extract_all_regex(string, pattern,
-      simplify = simplify, omit_no_match = TRUE, opts_regex = opts(pattern))
+      simplify = simplify, omit_no_match = TRUE, opts_regex = opt)
   )
+  if (simplify) {
+    if (nrow(out) == length(string)) rownames(out) <- names(string)
+  } else {
+    if (length(out) == length(string)) names(out) <- names(string)
+  }
+  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,13 +37,15 @@
 str_locate <- function(string, pattern) {
   check_lengths(string, pattern)
 
-  switch(type(pattern),
+  out <- switch(type(pattern),
     empty = ,
     bound = stri_locate_first_boundaries(string, opts_brkiter = opts(pattern)),
     fixed = stri_locate_first_fixed(string, pattern, opts_fixed = opts(pattern)),
     coll  = stri_locate_first_coll(string, pattern, opts_collator = opts(pattern)),
     regex = stri_locate_first_regex(string, pattern, opts_regex = opts(pattern))
   )
+  if (is.matrix(out) && nrow(out) == length(string)) rownames(out) <- names(string)
+  out
 }
 
 #' @rdname str_locate
@@ -52,13 +54,15 @@ str_locate_all <- function(string, pattern) {
   check_lengths(string, pattern)
   opts <- opts(pattern)
 
-  switch(type(pattern),
+  out <- switch(type(pattern),
     empty = ,
     bound = stri_locate_all_boundaries(string, omit_no_match = TRUE, opts_brkiter = opts),
     fixed = stri_locate_all_fixed(string, pattern, omit_no_match = TRUE, opts_fixed = opts),
     regex = stri_locate_all_regex(string, pattern, omit_no_match = TRUE, opts_regex = opts),
     coll  = stri_locate_all_coll(string, pattern, omit_no_match = TRUE, opts_collator = opts)
   )
+  if (is.list(out) && length(out) == length(string)) names(out) <- names(string)
+  out
 }
 
 

R/match.R

@@ -54,10 +54,12 @@ str_match <- function(string, pattern) {
     cli::cli_abort(tr_("{.arg pattern} must be a regular expression."))
   }
 
-  stri_match_first_regex(string,
+  out <- stri_match_first_regex(string,
     pattern,
     opts_regex = opts(pattern)
   )
+  if (is.matrix(out) && nrow(out) == length(string)) rownames(out) <- names(string)
+  out
 }
 
 #' @rdname str_match
@@ -68,9 +70,11 @@ str_match_all <- function(string, pattern) {
     cli::cli_abort(tr_("{.arg pattern} must be a regular expression."))
   }
 
-  stri_match_all_regex(string,
+  out <- stri_match_all_regex(string,
     pattern,
     omit_no_match = TRUE,
     opts_regex = opts(pattern)
   )
+  if (is.list(out) && length(out) == length(string)) names(out) <- names(string)
+  out
 }

R/pad.R

@@ -32,9 +32,11 @@ str_pad <- function(string, width, side = c("left", "right", "both"), pad = " ",
   side <- arg_match(side)
   check_bool(use_width)
 
-  switch(side,
+  out <- switch(side,
     left = stri_pad_left(string, width, pad = pad, use_length = !use_width),
     right = stri_pad_right(string, width, pad = pad, use_length = !use_width),
     both = stri_pad_both(string, width, pad = pad, use_length = !use_width)
   )
+  if (length(out) == length(string)) names(out) <- names(string)
+  out
 }

R/replace.R

@@ -76,7 +76,7 @@ str_replace <- function(string, pattern, replacement) {
 
   check_lengths(string, pattern, replacement)
 
-  switch(type(pattern),
+  out <- switch(type(pattern),
     empty = no_empty(),
     bound = no_boundary(),
     fixed = stri_replace_first_fixed(string, pattern, replacement,
@@ -86,6 +86,8 @@ str_replace <- function(string, pattern, replacement) {
     regex = stri_replace_first_regex(string, pattern, fix_replacement(replacement),
       opts_regex = opts(pattern))
   )
+  if (length(out) == length(string)) names(out) <- names(string)
+  out
 }
 
 #' @export
@@ -107,7 +109,7 @@ str_replace_all <- function(string, pattern, replacement) {
   }
 
 
-  switch(type(pattern),
+  out <- switch(type(pattern),
     empty = no_empty(),
     bound = no_boundary(),
     fixed = stri_replace_all_fixed(string, pattern, replacement,
@@ -117,6 +119,8 @@ str_replace_all <- function(string, pattern, replacement) {
     regex = stri_replace_all_regex(string, pattern, fix_replacement(replacement),
       vectorize_all = vec, opts_regex = opts(pattern))
   )
+  if (length(out) == length(string)) names(out) <- names(string)
+  out
 }
 
 is_replacement_fun <- function(x) {
@@ -178,10 +182,9 @@ fix_replacement_one <- function(x) {
 #' str_replace_na(c(NA, "abc", "def"))
 str_replace_na <- function(string, replacement = "NA") {
   check_string(replacement)
-  stri_replace_na(string, replacement)
+  copy_names(string, stri_replace_na(string, replacement))
 }
 
-
 str_transform <- function(string, pattern, replacement) {
   loc <- str_locate(string, pattern)
   new <- replacement(str_sub(string, loc))

R/sort.R

@@ -87,9 +87,11 @@ str_sort <- function(x,
   check_bool(numeric)
 
   opts <- stri_opts_collator(locale, numeric = numeric, ...)
-  stri_sort(x,
+  idx <- stri_order(
+    x,
     decreasing = decreasing,
     na_last = na_last,
     opts_collator = opts
   )
+  x[idx]
 }