R：找到最大的公共子從頭開始

Question

我有2個載體：

word1 <- "bestelling" 
word2 <- "bestelbon" 

現在我想找到始於beginnig最大公共子，所以在這裏，這將是「畢思特」 。

但是，舉個例子，如「bestelling」和「stel」等兩個詞，然後我想返回""。

Answer 1

這將爲話

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" 

Answer 2

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] "" 

Answer 3

這似乎是工作

longestprefix<-function(a,b) { 
    n <- pmin(nchar(a), nchar(b)) 
    mapply(function(x, y, n) { 
     rr<-rle(x[1:n]==y[1:n]) 
     if(rr$values[1]) { 
      paste(x[1:rr$lengths[1]], collapse="") 
     } else { 
      "" 
     } 
    }, strsplit(a, ""), strsplit(b,""), n) 
} 



longestprefix("bestelling", "bestelbon") 
# [1] "bestel" 
longestprefix("bestelling", "stel") 
# [1] "" 

Answer 4

有些凌亂的任意向量工作，但它是我想出了：

largest_subset <- Vectorize(function(word1,word2) { 
    substr(word1, 1, sum(substring(word1, 1, 1:nchar(word1))==substring(word2, 1, 1:nchar(word2)))) 
}) 

它會產生一條警告消息，如果字的長度不一樣，但是沒有恐懼。它檢查從每個單詞的第一個字符到每個位置的每個子字符串是否在這兩個單詞之間產生匹配。然後，您可以計算出有多少數值是真實的，並將子字符串捕獲到該字符。我矢量化它，所以你可以將它應用到單詞向量。

> word1 <- c("tester","doesitwork","yupyppp","blanks") 
> word2 <- c("testover","doesit","yupsuredoes","") 
> largest_subset(word1,word2) 
    tester doesitwork yupyppp  blanks 
    "test" "doesit"  "yup"   "" 

Answer 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" 

Answer 6

爲什麼不添加另一個！並對它進行破解，所以答案與其他人不同！

largestStartSubstr<-function(word1, word2){ 
    word1vec<-unlist(strsplit(word1, "", fixed=TRUE)) 
    word2vec<-unlist(strsplit(word2, "", fixed=TRUE)) 
    indexes<-intersect(1:nchar(word1), 1:nchar(word2)) 
    bools<-word1vec[indexes]==word2vec[indexes] 
    if(bools[1]==FALSE){ 
     "" 
    }else{ 
     lastChar<-match(1,c(0,diff(cumsum(!bools))))-1 
     if(is.na(lastChar)){ 
      lastChar<-indexes[length(indexes)] 
     } 
     substr(word1, 1,lastChar) 
    } 
} 

word1 <- "bestselling" 
word2<- "bestsel" 

largestStartSubstr(word1, word2) 
#[1] "bestsel" 

word1 <- "bestselling" 
word2<- "sel" 

largestStartSubstr(word1, word2) 
#[1] "" 

Answer 7

雖然我通常避免在R迴路 - 給你從頭開始，繼續，直到你找到它似乎是一個簡單的方法解決。

它比其他的一些例子更直觀一點，我認爲

lcsB <- function(string1, string2) { 
    x <- '' 
    for (i in 1:nchar(string1)){ 
     if (substr(string1[1],1,i) == substr(string2[1],1,i)) { 
      x <- substr(string1[1],1,i) 
     } 
     else 
      return(x) 
     } 
    return(x) 
} 

lcsB("bestelling", "bestelbon") 
lcsB("bestelling", "stel") 

Answer 8

我意識到，我來晚了，這個黨，但決定兩兩比對是在生物學研究中的基本問題，並已經有一個包（或一個包系列）攻擊這個問題。名爲Biostrings的Bioconductor軟件包可用（並且至少在安裝所有默認依賴項時很重要，因此在安裝過程中需要耐心）。它返回S4對象，因此需要不同的提取功能。這也許是一個大錘提取螺母，但這裏以得到所需的結果代碼：

install.packages("Biostrings", repo="http://www.bioconductor.org/packages/2.14/bioc/", dependencies=TRUE) 
library(Biostrings) 
psa1 <- pairwiseAlignment(pattern = c(word1) ,word2,type="local") 
psa1@pattern 
#[1] bestel 

但是，它不設置默認爲比賽的限制排列在兩個字符串的第一個字符。我們希望@MartinMorgan能夠解決我的錯誤。

Answer 9

Matthew Plourde打來電話，Benchmarker先生迴應！
對不起，BondedDust，但我無法從工作場所牆壁後面找到bioconductor。

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 

我認爲這是我義不容辭的義務，使他們衡量，比如說輸入字，1000個參考字矢量（而不僅僅是一對）看到速度測試如何去修改這些功能。也許以後。

後來... :-)。我沒有製作循環，但我試了很長的單詞：

編輯：這是，因爲flodel指出，一個錯字，導致測試一個相當長的矢量 非常短的單詞！

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 

對不起，理查德，但看起來你需要給你的雞晚餐彌敦道。

EDIT2：確保輸入是單個單詞，並將flodel的代碼添加到堆中。

編着的「plourde」功能，接受輸入和重新運行長字的情況下

wfoo1 <-paste(rep(letters,100),collapse='') 
wfoo2<-paste(c(rep(letters,99),'foo'),collapse='') 

貌似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 

Answer 10

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 = "") 
} 

Answer 11

正則表達式的位可以這樣做：

sub('^([^|]*)[^|]*(?:\\|\\1[^|]*)$', '\\1', paste0(word1, '|', word2)) 
#[1] "bestel" 

我用|爲分隔符 - 挑選一個有意義的你的字符串。