Replace several stringr fns with base equivalents

DESCRIPTION

@@ -118,7 +118,6 @@ Imports:
     evaluate (>= 0.15),
     highr,
     methods,
-    stringr (>= 0.6),
     yaml (>= 2.1.19),
     xfun (>= 0.34),
     tools

NEWS.md

@@ -12,6 +12,8 @@
 
 - Due to a change in the **evaluate** package, the chunk options `message = FALSE` and `warning = FALSE` will completely suppress the messages/warnings now, instead of sending them to the console. To get back to the old behavior, you can use `NA` instead of `FALSE` (thanks, @gadenbuie, https://github.com/yihui/yihui.org/discussions/1458).
 
+- The **stringr** dependency has been removed. All string operations are done with base R now (thanks, @HughParsonage #1549 #1552, @rich-iannone #2174 #2177 #2186 #2187 #2195 #2202 #2205).
+
 ## MINOR CHANGES
 
 - Improved the error message when inline R code cannot be parsed (thanks, @hadley #2173, @rich-iannone #2198).

R/block.R

@@ -584,7 +584,7 @@ process_tangle.block = function(x) {
   } else knit_code$get(label)
   # read external code if exists
   if (!isFALSE(ev) && length(code) && any(grepl('read_chunk\\(.+\\)', code))) {
-    eval(parse_only(unlist(stringr::str_extract_all(code, 'read_chunk\\(([^)]+)\\)'))))
+    eval(parse_only(unlist(str_extract(code, 'read_chunk\\(([^)]+)\\)'))))
   }
   code = parse_chunk(code)
   if (isFALSE(ev)) code = comment_out(code, params$comment, newline = FALSE)

R/header.R

@@ -55,7 +55,7 @@ insert_header_latex = function(doc, b) {
       j = j[1]
       doc[j] = sub(p, '\n\\\\IfFileExists{upquote.sty}{\\\\usepackage{upquote}}{}\n\\2', doc[j], perl = TRUE)
     }
-    i = i[1L]; l = stringr::str_locate(doc[i], b)
+    i = i[1L]; l = str_locate(doc[i], b, FALSE)
     tmp = substr(doc[i], l[, 1], l[, 2])
     doc[i] = str_replace(doc[i], l, paste0(tmp, make_header_latex(doc)))
   } else if (parent_mode() && !child_mode()) {
@@ -86,7 +86,7 @@ make_header_html = function() {
 insert_header_html = function(doc, b) {
   i = grep(b, doc)
   if (length(i) == 1L) {
-    l = stringr::str_locate(doc[i], b)
+    l = str_locate(doc[i], b, FALSE)
     tmp = substr(doc[i], l[, 1], l[, 2])
     doc[i] = str_replace(doc[i], l, paste0(tmp, '\n', make_header_html()))
   }

R/parser.R

@@ -355,11 +355,10 @@ parse_inline = function(input, patterns) {
   input = one_string(input) # merge into one line
 
   loc = cbind(start = numeric(0), end = numeric(0))
-  if (group_pattern(inline.code)) loc = stringr::str_locate_all(input, inline.code)[[1]]
+  if (group_pattern(inline.code)) loc = str_locate(input, inline.code)[[1]]
   if (nrow(loc)) {
-    code = stringr::str_match_all(input, inline.code)[[1L]]
+    code = t(str_match(input, inline.code))
     code = if (NCOL(code) >= 2L) {
-      code[is.na(code)] = ''
       apply(code[, -1L, drop = FALSE], 1, paste, collapse = '')
     } else character(0)
   } else code = character(0)

R/template.R

@@ -118,9 +118,9 @@ knit_expand = function(file, ..., text = read_utf8(file), delim = c('{{', '}}')
   delim = paste0(delim[1L], '((.|\n)+?)', delim[2L])
 
   txt = one_string(text)
-  loc = stringr::str_locate_all(txt, delim)[[1L]]
+  loc = str_locate(txt, delim)[[1L]]
   if (nrow(loc) == 0L) return(txt) # no match
-  mat = stringr::str_extract_all(txt, delim)[[1L]]
+  mat = str_extract(txt, delim)[[1L]]
   mat = sub(delim, '\\1', mat)
   env = list(...)
   env = if (length(env)) list2env(env, parent = parent.frame()) else parent.frame()

R/utils-string.R

@@ -16,3 +16,34 @@ str_wrap = function(...) {
   res = strwrap(..., simplify = FALSE)
   unlist(lapply(res, one_string))
 }
+
+# a simplified replacement for stringr::str_locate_all() that returns a list
+# having an element for every element of 'string'; every list element is an
+# integer matrix having a row per match, and two columns: 'start' and 'end'.
+str_locate = function(x, pattern, all = TRUE) {
+  out = (if (all) gregexpr else regexpr)(pattern, x, perl = TRUE)
+  if (all) lapply(out, location) else location(out)
+}
+
+location = function(x) {
+  len = attr(x, 'match.length')
+  if (length(x) == 1 && x == -1) x = integer()
+  cbind(start = x, end = x + len - 1L)
+}
+
+# a replacement for stringr::str_extract_all()
+str_extract = function(x, pattern) {
+  m = gregexpr(pattern, x, perl = TRUE)
+  regmatches(x, m)
+}
+
+str_match = function(x, pattern) {
+  # gregexec() was added in R 4.1.0; for lower versions of R, use fallback
+  if (is.function(gregexec <- baseenv()[['gregexec']])) {
+    m = gregexec(pattern, x, perl = TRUE)
+  } else {
+    x = unlist(str_extract(x, pattern))
+    m = regexec(pattern, x, perl = TRUE)
+  }
+  do.call(cbind, regmatches(x, m))
+}

R/utils.R

@@ -91,7 +91,7 @@ set_preamble = function(input, patterns = knit_patterns$get()) {
   idx1 = grep(hb, input)[1]
   if (is.na(idx1) || idx1 >= idx2) return()
   txt = one_string(input[idx1:(idx2 - 1L)])  # rough preamble
-  idx = stringr::str_locate(txt, hb)  # locate documentclass
+  idx = str_locate(txt, hb, FALSE)  # locate documentclass
   options(tikzDocumentDeclaration = substr(txt, idx[, 1L], idx[, 2L]))
   preamble = pure_preamble(split_lines(substr(txt, idx[, 2L] + 1L, nchar(txt))), patterns)
   .knitEnv$tikzPackages = c(.header.sweave.cmd, preamble, '\n')