R/rematch2.R

In presser: Lightweight Web Server for Testing

re_match <- function(text, pattern, perl = TRUE, ...) {

  stopifnot(is.character(pattern), length(pattern) == 1, !is.na(pattern))
  text <- as.character(text)

  match <- regexpr(pattern, text, perl = perl, ...)

  start  <- as.vector(match)
  length <- attr(match, "match.length")
  end    <- start + length - 1L

  matchstr <- substring(text, start, end)
  matchstr[ start == -1 ] <- NA_character_

  empty <- data.frame(stringsAsFactors = FALSE, .text = text)[, numeric()]
  res <- list(match = !is.na(matchstr), groups = empty)

  if (!is.null(attr(match, "capture.start"))) {

    gstart  <- attr(match, "capture.start")
    glength <- attr(match, "capture.length")
    gend    <- gstart + glength - 1L

    groupstr <- substring(text, gstart, gend)
    groupstr[ gstart == -1 ] <- NA_character_
    dim(groupstr) <- dim(gstart)

    res$groups <- cbind(groupstr, res$groups, stringsAsFactors = FALSE)
    names(res$groups) <- attr(match, "capture.names")
  }

  res
}