R:从头开始找到最大的公共子串

Ani*_*ita 12 substring r

我有2个向量:

word1 <- "bestelling"   
word2 <- "bestelbon"
Run Code Online (Sandbox Code Playgroud)

现在我想找到从beginnig开始的最大公共子字符串,所以这里将是"bestel".

但举个例子是"bestelling"和"stel"这两个词,然后我想回来"".

Car*_*oft 9

Matthew Plourde打来电话,Benchmarker先生回应!
对不起,BondedDust,但我无法从工作场所墙后面找到生物传导器.

library(microbenchmark)
wfoo1 <-'bestelling'
wfoo2<-'bestelbon'


microbenchmark(stu(wfoo1,wfoo2),nathan(wfoo1,wfoo2),plourde(),scriven(wfoo1,wfoo2),dmt(wfoo1,wfoo2),mrflick(wfoo1,wfoo2),roland(c(wfoo1,wfoo2)))
Unit: microseconds
                    expr     min       lq   median       uq
       stu(wfoo1, wfoo2) 171.905 183.0230 187.5135 191.1490
    nathan(wfoo1, wfoo2)  35.921  42.3360  43.6180  46.1840
               plourde() 551.208 581.3545 591.6175 602.5220
   scriven(wfoo1, wfoo2)  16.678  21.1680  22.6645  23.7335
       dmt(wfoo1, wfoo2)  79.966  86.1665  88.7325  91.5125
   mrflick(wfoo1, wfoo2) 100.492 108.4030 111.1830 113.9625
 roland(c(wfoo1, wfoo2)) 215.950 226.8545 231.7725 237.5455
     max neval
 435.321   100
  59.012   100
 730.809   100
  85.525   100
 286.081   100
 466.537   100
 291.213   100
Run Code Online (Sandbox Code Playgroud)

我认为我有责任修改这些功能,以便他们测量一个输入字,例如,一个1000个参考字(而不是一对)的矢量,以查看速度测试的进展情况.也许以后.

后来... :-).我没有制作循环,但我用长话来试试:

编辑:正如弗洛尔指出的那样,这是一个错字,导致测试一个非常短的单词的相当长的向量!

wfoo1 <-rep(letters,100)
wfoo2<-c(rep(letters,99),'foo')
Unit: microseconds
                    expr        min          lq      median
       stu(wfoo1, wfoo2)  31215.243  32718.5535  35270.6110
    nathan(wfoo1, wfoo2)    202.266    216.3780    227.2825
               plourde()    569.168    617.0615    661.5340
   scriven(wfoo1, wfoo2)    794.953    828.3070    847.5505
       dmt(wfoo1, wfoo2)   1081.033   1156.9365   1205.8990
   mrflick(wfoo1, wfoo2) 126058.316 131283.4485 241018.5150
 roland(c(wfoo1, wfoo2))    946.759   1004.4885   1045.3260
          uq        max neval
 146451.2595 167000.713   100
    236.0485    356.211   100
    694.6750    795.381   100
    868.9310   1021.594   100
   1307.6740 116075.442   100
 246739.6910 991550.586   100
   1082.1020   1243.103   100
Run Code Online (Sandbox Code Playgroud)

对不起理查德,但看起来你需要把你的鸡肉晚餐交给内森.

EDIT2:确保输入是单个单词,并将flodel的代码添加到堆中.

编辑了"plourde"函数来接受输入并重新考虑了长字案例

wfoo1 <-paste(rep(letters,100),collapse='')
wfoo2<-paste(c(rep(letters,99),'foo'),collapse='')
Run Code Online (Sandbox Code Playgroud)

看起来3个人的代码表现相似,所以就像环法自行车赛一样,我给mrflick,dmt和flodel一等奖.

 microbenchmark(stu(wfoo1,wfoo2),nathan(wfoo1,wfoo2),plourde(c(wfoo1,wfoo2)),scriven(wfoo1,wfoo2),dmt(wfoo1,wfoo2),mrflick(wfoo1,wfoo2),roland(c(wfoo1,wfoo2)),flodel(wfoo1,wfoo2) )
Unit: microseconds
                     expr        min          lq     median
        stu(wfoo1, wfoo2)  17786.578  18243.2795  18420.317
     nathan(wfoo1, wfoo2)  36651.195  37703.3625  38095.493
 plourde(c(wfoo1, wfoo2)) 183616.029 187673.5350 190706.457
    scriven(wfoo1, wfoo2)  17546.253  17994.1890  18244.990
        dmt(wfoo1, wfoo2)    737.651    781.0550    821.466
    mrflick(wfoo1, wfoo2)    870.643    951.4630    976.479
  roland(c(wfoo1, wfoo2))  99540.947 102644.2115 103654.258
     flodel(wfoo1, wfoo2)    666.239    705.5795    717.553
         uq         max neval
  18602.270   20835.107   100
  38450.848  155422.375   100
 303856.952 1079715.032   100
  18404.281   18992.905   100
    853.751    1719.047   100
   1012.186  116669.839   100
 105423.123  226522.073   100
    732.947     822.748   100
Run Code Online (Sandbox Code Playgroud)


Rol*_*and 6

fun <- function(words) {
  #extract substrings from length 1 to length of shortest word
  subs <- sapply(seq_len(min(nchar(words))), 
                 function(x, words) substring(words, 1, x), 
                 words=words)
  #max length for which substrings are equal
  neqal <- max(cumsum(apply(subs, 2, function(x) length(unique(x)) == 1L)))
  #return substring
  substring(words[1], 1, neqal)
}

words1 <- c("bestelling", "bestelbon")
fun(words1)
#[1] "bestel"

words2 <- c("bestelling", "stel")
fun(words2)
#[1] ""
Run Code Online (Sandbox Code Playgroud)


Ric*_*ven 5

这是另一个似乎有用的功能.

foo <- function(word1, word2) {
    s1 <- substring(word1, 1, 1:nchar(word1))
    s2 <- substring(word2, 1, 1:nchar(word2))
    if(length(w <- which(s1 %in% s2))) s2[max(w)] else character(1)
}

foo("bestelling", "bestelbon")
# [1] "bestel"
foo("bestelling", "stel")
# [1] ""
foo("bestelbon", "bestieboop")
# [1] "best"
foo("stel", "steal")
# [1] "ste"
Run Code Online (Sandbox Code Playgroud)


flo*_*del 5

flodel <- function(word1, word2) {
   # the length of the shorter word
   n <- min(nchar(word1), nchar(word2))
   # two vectors of characters of the same length n
   c1 <- strsplit(word1, "", fixed = TRUE)[[1]][1:n]
   c2 <- strsplit(word2, "", fixed = TRUE)[[1]][1:n]
   # a vector that is TRUE as long as the characters match
   m <- as.logical(cumprod(c1 == c2))
   # the answer
   paste(c1[m], collapse = "")
}
Run Code Online (Sandbox Code Playgroud)


Mat*_*rde 4

这适用于任意单词向量

words <- c('bestelling', 'bestelbon')
words.split <- strsplit(words, '')
words.split <- lapply(words.split, `length<-`, max(nchar(words)))
words.mat <- do.call(rbind, words.split)
common.substr.length <- which.max(apply(words.mat, 2, function(col) !length(unique(col)) == 1)) - 1
substr(words[1], 1, common.substr.length)
# [1] "bestel"
Run Code Online (Sandbox Code Playgroud)