Extract matching words from strings in order

If I have two strings that look like this:

x <- "Here is a test of words and stuff."
y <- "Here is a better test of words and stuff."

Is there an easy way to check the words from left to right and create a new string of matching words and then stop when the words no longer match so the output would look like:

> "Here is a"

I don't want to find all matching words between the two strings but rather just the words that match in order. So "words and stuff." is in both string but I don't want that to be selected.

Split the strings, compute the minimum of the length of the two splits, take that number of words from the head of each and append a FALSE to ensure a non-match can occur when matching the corresponding words. Then use which.min to find the first non-match and take that number minus 1 of the words and paste back together.

L <- strsplit(c(x, y), " +")
wx <- which.min(c(do.call(`==`, lapply(L, head, min(lengths(L)))), FALSE))
paste(head(L[[1]], wx - 1), collapse = " ")
## [1] "Here is a"

This shows you the first n words that match:

xvec <- strsplit(x, " +")[[1]]
yvec <- strsplit(y, " +")[[1]]
(len <- min(c(length(xvec), length(yvec))))
# [1] 8
i <- which.max(cumsum(head(xvec, len) != head(yvec, len)))
list(xvec[1:i], yvec[1:i])
# [[1]]
# [1] "Here"   "is"     "a"      "test"   "of"     "words"  "and"    "stuff."
# [[2]]
# [1] "Here"   "is"     "a"      "better" "test"   "of"     "words"  "and"   
cumsum(head(xvec, len) != head(yvec, len))
# [1] 0 0 0 1 2 3 4 5
i <- which.max(cumsum(head(xvec, len) != head(yvec, len)) > 0)
list(xvec[1:(i-1)], yvec[1:(i-1)])
# [[1]]
# [1] "Here" "is"   "a"   
# [[2]]
# [1] "Here" "is"   "a"   

From here, we can easily derive the leading string:

paste(xvec[1:(i-1)], collapse = " ")
# [1] "Here is a"

and the remaining strings with

paste(xvec[-(1:(i-1))], collapse = " ")
# [1] "test of words and stuff."

I wrote a function which will check the string and return the desired output:

x <- "Here is a test of words and stuff."
y <- "Here is a better test of words and stuff."
z <- "This string doesn't match"

library(purrr)

check_str <- function(inp, pat, delimiter = "\\s") {

  inp <- unlist(strsplit(inp, delimiter))
  pat <- unlist(strsplit(pat, delimiter))
  ln_diff <- length(inp) - length(pat)
  
  if (ln_diff < 0) {
    inp <- append(inp, rep("", abs(ln_diff)))
  }
  if (ln_diff > 0) {
    pat <- append(pat, rep("", abs(ln_diff)))
  }
  
  idx <- map2_lgl(inp, pat, ~ identical(.x, .y))
  rle_idx <- rle(idx)
  
  if (rle_idx$values[1]) {
    idx2 <- seq_len(rle_idx$length[1])
  } else {
    idx2 <- 0
  }
  
  paste0(inp[idx2], collapse = delimiter)
}

check_str(x, y, " ")
#> [1] "Here is a"
check_str(x, z, " ")
#> [1] ""

^{Created on 2023-02-13 with reprex v2.0.2}

You could write a helper function to do the check for you

common_start<-function(x, y) {
  i <- 1
  last <- NA
  while (i <= nchar(x) & i <= nchar(x)) {
    if (substr(x,i,i) == substr(y,i,i)) {
      if (grepl("[[:space:][:punct:]]", substr(x,i,i), perl=T)) {
        last <- i
      }
    } else {
      break;
    }
    i <- i + 1
  }
  if (!is.na(last)) {
    substr(x, 1, last-1)
  } else {
    NA
  }
}

and use that with your sample stirngs

common_start(x,y)
# [1] "Here is a"

The idea is to check every character, keeping track of the last non-word character that still matches. Using a while loop may not be fancy but it does mean you get to break early without processing the whole string as soon as a mismatch is found.