Извлечь совпадающие слова из строк по порядку

Это показывает вам первые n слова, которые соответствуют:

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"   

Отсюда мы можем легко получить ведущую строку:

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

А остальные строки с

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

Я написал функцию, которая проверит строку и вернет желаемый результат:

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

Вы можете написать вспомогательную функцию, чтобы сделать проверку для вас

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
  }
}

И используйте это с вашими образцами

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

Идея состоит в том, чтобы проверять каждый символ, отслеживая последний символ, не являющийся словом, который все еще соответствует. Использование цикла while может быть непривлекательным, но это означает, что вы можете прервать работу раньше, не обрабатывая всю строку, как только будет обнаружено несоответствие.

Разделите строки, вычислите минимальную длину двух разделений, возьмите это количество слов из заголовка каждого и добавьте FALSE, чтобы гарантировать, что несоответствие может произойти при сопоставлении соответствующих слов. Затем используйте which.min, чтобы найти первое несоответствие, возьмите это число минус 1 слов и снова соедините их.

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"