9
我有2個載體：R：找到最大的公共子從頭開始
word1 <- "bestelling"
word2 <- "bestelbon"
現在我想找到始於beginnig最大公共子，所以在這裏，這將是「畢思特」 。
但是，舉個例子，如「bestelling」和「stel」等兩個詞，然後我想返回""。
A
回答
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"
5
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] ""
+1
這很好 - 我一直在尋找一個能夠處理單詞列表的函數，而不僅僅是一對。 – 2015-12-08 21:26:16
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] ""
1
有些凌亂的任意向量工作，但它是我想出了：
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" ""
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"
+0
理查德感謝您的優雅解決方案。我怎樣才能擴展這個，以便我可以在兩個字符串的長度內找到常見的子字符串（而不僅僅是開始） – IAMTubby 2015-02-01 12:37:52
4
爲什麼不添加另一個！並對它進行破解，所以答案與其他人不同！
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] ""
4
雖然我通常避免在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")
3
我意識到，我來晚了，這個黨，但決定兩兩比對是在生物學研究中的基本問題，並已經有一個包（或一個包系列）攻擊這個問題。名爲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")
[email protected]
#[1] bestel
但是，它不設置默認爲比賽的限制排列在兩個字符串的第一個字符。我們希望@MartinMorgan能夠解決我的錯誤。
8
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
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 = "")
}
+1
幾乎所有這些都可以通過使用'charToRaw' /'rawToChar'而不是'strsplit' /'paste'來加速。特別是這個速度已經很快，在我的測試中速度提升了將近5倍。 – user295691 2015-03-06 21:06:37
1
正則表達式的位可以這樣做：
sub('^([^|]*)[^|]*(?:\\|\\1[^|]*)$', '\\1', paste0(word1, '|', word2))
#[1] "bestel"
我用|爲分隔符 - 挑選一個有意義的你的字符串。
相關問題
- 1. 尋找最大公共子
- 2. 查找兩組最大公共子集的有效算法？
- 3. R - 從最大到最小
- 4. 的Java：最長公共子
- 5. 找到最大的子集
- 6. 從表中尋找最長公共子序列
- 7. 從頭開始設計最近的帖子
- 8. 找到R中每行最大最大值和第二大最大值R
- 9. 程序找到最大的公約數
- 10. 從選定的點開始查找最大的連接Blob
- 11. 找到最大子陣列
- 12. UINavigationController從頭開始？
- 13. R，因子的最大值
- 14. 讓子彈從頭開始遊戲到目的地
- 15. 查找2個字符串的最長公共子序列？
- 16. 查找唯一最長公共子序列的數量
- 17. 從頭開始的UIPageViewController
- 18. 最長的公共子序列printdDiff
- 19. 最長的公共子序列差異
- 20. 最長的公共子列表
- 21. 計算最大與公共圖書館
- 22. 如何找到多個字符串中最長的公共子字符串？
- 23. 找到最大的子矩陣算法
- 24. 找到子對象的最大值
- 25. R中的時間序列迴歸：從頭開始幫助
- 26. R中的樸素貝葉斯分類 - 從頭開始
- 27. R - 最大公約數dplyr例程
- 28. 最長公共子序列優化
- 29. 打印最長公共子序列
- 30. 從頭開始創建
+1對於所有這些答案的基準測試人員。 – 2014-10-09 18:39:35
@MatthewPlourde我無法抗拒的挑戰:-) ... – 2014-10-09 19:36:52
@MatthewPlourde看到了初步結果。 – 2014-10-09 19:48:42