Как определить самую длинную общую подстроку в двух столбцах БОЛЬШОЙ таблицы данных в R

Я изменил ответ на этот вопрос: Найти длину перекрытия в строках, но возникли проблемы с применением к большим данным, так как итерация медленная.

Как я могу улучшить приведенную ниже функцию, которая находит самое длинное общее совпадение между двумя строками в любом месте двух строк (без учета регистра)?

Медленная функция, которая работает, но я хотел бы заменить ее более качественной:

strlcs <- function(str1, str2,type="lcs") {
  
  
  if(nchar(str1) < nchar(str2)) {
    x <- str2
    str2 <- str1
    str1 <- x
  }
  
  x <- strsplit(str2, "")[[1L]]
  n <- length(x)
  s <- sequence(seq_len(n))
  s <- split(s, cumsum(s == 1L))
  s <- rep(list(s), n)
  
  for(i in seq_along(s)) {
    s[[i]] <- lapply(s[[i]], function(x) {
      x <- x + (i-1L)
      x[x <= n]
    })
    s[[i]] <- unique(s[[i]])
  }
  
  s <- unlist(s, recursive = FALSE)
  s <- unique(s[order(-lengths(s))])
  
  i <- 1L
  len_s <- length(s)
  while(i < len_s) {
    lcs <- paste(x[s[[i]]], collapse = "")
    check <- grepl(lcs, str1, fixed = TRUE)
    if(check) {
      if(type=="nchar"){
        return(nchar(lcs))
      }else{
        return(lcs)
      }
      break
    } else {
      i <- i + 1L 
    }
  }
}

Пример данных:

library(data.table)
sampdata <- data.frame(
  str1=c("Doug Olivas", "GRANT MANAGEMENT LLC", "LUNA VAN DERESH", "wendy t marzardo", "AMIN NYGUEN COMPANY LLC", "GERARDO CONTRARAS", "miguel martinez","albert marks porter"),
  str2=c("doug olivas", "miguel grant", "LUNA VAN DERESH MANAGEMENT LLC", "marzardo", "amin nyguen llc", "gerardo contraras", "miggy martinez","albert"),
  stringsAsFactors = F
)

###Create sample big data from previous sampledata and apply on huge DT
samplist <- lapply(c(1:10000),FUN=function(x){sampdata})
bigsampdata <- rbindlist(samplist)

Эта функция НЕ оптимизирована для работы с большими данными.

Как мне сделать следующее менее чем за 20 с лишним секунд?

DESIRED FUNCTION APPLIED ON BIG DATA: 
system.time(bigsampdata$desired_LCSnchar <- sapply(c(1:nrow(bigsampdata)),FUN=function(x){strlcs(tolower(bigsampdata$str1[x]),tolower(bigsampdata$str2[x]),type="lcs")}))
   user  system elapsed 
 24.290   0.008  24.313

r string data.table substring lcs
person Neal Barsch    schedule 16.10.2020    source источник
comment
Другими словами, что делает strlcs()?   -  person sindri_baldur    schedule 16.10.2020
comment
См. редактирование наверху   -  person Neal Barsch    schedule 16.10.2020
comment
Какой будет самая длинная подстрока здесь: "doug olivas", "doug olds" должно быть doug ol или будет достаточно doug?   -  person sindri_baldur    schedule 16.10.2020

Ответы (2)


arrow_upward
2
arrow_downward

Я нашел более быстрое решение, используя функцию LCS в пакете qualV:

library(data.table)
library(qualV)

strlcs_op <- function(str1, str2) {
    v1 <- unlist(strsplit(str1, ""))
    v2 <- unlist(strsplit(str2, ""))
    
    return(paste(v1[LCS(v1, v2)$va], collapse = ""))
    
}

# same as yours but with data.table syntax
system.time(bigsampdata[, desired_LCSnchar := mapply(strlcs,
                                                     tolower(str1),
                                                     tolower(str2))])
#>    user  system elapsed 
#>   41.64    0.04   42.20
# optimised function
system.time(bigsampdata[, desired_LCSnchar := mapply(strlcs_op,
                                                     tolower(str1),
                                                     tolower(str2))])
#>    user  system elapsed 
#>    4.58    0.00    4.75

Вы можете еще больше ускорить его, распараллелив mapply с mcmapply.

person Jon Nagra    schedule 16.10.2020
comment
Я получаю немного другой результат для str1="GRANT MANAGEMENT LLC" и str2="miguel grant": медленная функция возвращает "grant", а ваша функция возвращает "mgent". Любая идея, почему это было бы правильно для других, но не для этого примера? Я думаю, что это может быть и непрерывные подстроки? У меня были некоторые странные проблемы, подобные этой, когда я пробовал LCS из qualV раньше - person Neal Barsch; 16.10.2020
comment
Я считаю, что qualV находит самую длинную общую подпоследовательность, которая немного отличается от самой длинной общей подстроки. Подпоследовательности не обязательно должны быть непрерывными, поэтому они соответствуют mgent. - person Paul; 17.10.2020
comment
@NealBarsch @Paul, вы оба правы, функция LCS берет самую длинную подпоследовательность, т. е. str1 <- "axbc";str2 <- "abyc";strlcs_op(tolower(str1),tolower(str2)); я проверю, есть ли простой способ повторного использования исходного кода lcs github.com/cran/qualV/blob/master/src/lcs.c - person Jon Nagra; 18.10.2020

arrow_upward
1
arrow_downward

Я реализовал решение Википедии псевдокод в c++, используя Rcpp.

library(Rcpp)


cppFunction('
String largeset_common_substring(String str1, String str2) 
{ 
    std::string S = str1;
    std::string T = str2;
    int r = S.length();
    int n = T.length();
    std::vector<std::vector<int> > L(r , std::vector<int>(n));
    int z = 0;
    std::string ret;

    for (int i = 0; i < r; ++i)
    {
        for (int j = 0; j < n; ++j)
        {
            if (S[i] == T[j])
            {
                if (i == 0 || j == 0)
                    L[i][j] = 1;
                else
                    L[i][j] = L[i - 1][j - 1] + 1;
 
                if (L[i][j] > z)
                {
                    z = L[i][j];
                    ret = S.substr(i - z + 1, z);
                }
            }
            else
            {
                L[i][j] = 0;
            }
        }
    }
    return ret;
} 
')

largeset_common_substring(tolower("GRANT MANAGEMENT LLC"), "miguel grant")
#> [1] "grant"

Вот время для вашего большого набора данных.

library(data.table)
sampdata <- data.frame(
  str1=c("Doug Olivas", "GRANT MANAGEMENT LLC", "LUNA VAN DERESH", "wendy t marzardo", "AMIN NYGUEN COMPANY LLC", "GERARDO CONTRARAS", "miguel martinez","albert marks porter"),
  str2=c("doug olivas", "miguel grant", "LUNA VAN DERESH MANAGEMENT LLC", "marzardo", "amin nyguen llc", "gerardo contraras", "miggy martinez","albert"),
  stringsAsFactors = F
)

###Create sample big data from previous sampledata and apply on huge DT
samplist <- lapply(c(1:10000),FUN=function(x){sampdata})
bigsampdata <- rbindlist(samplist)


system.time(
  bigsampdata[, desired_LCSnchar := purrr::map2_chr(
      tolower(bigsampdata$str1),
      tolower(bigsampdata$str2),
      largeset_common_substring
  )]
)
#> user  system elapsed 
#> 0.78    0.07    1.28
person Paul    schedule 17.10.2020
comment
Функция имеет ту же проблему LCS есть largeset_common_substring("axbc", "abyc") есть abc - person Jon Nagra; 18.10.2020
comment
Я еще немного проверил вашу функцию, и проблема, о которой я упоминаю, возникает из-за предложения else if. Сотрите этот кусок кода, и он даст удовлетворительный результат (даже если он самый левый). - person Jon Nagra; 18.10.2020
comment
Спасибо, @JonNagra. Я неверно истолковал значение ∪ в псевдокоде как конкатенацию строк. Я обновил свой ответ. - person Paul; 19.10.2020