用于在一组字符串中查找最长的公共起始子字符串的 R 实现

Question

这个问题只是要求在 R 中实现以下问题：Find the longest common starting substring in a set of strings (JavaScript)

"这个问题是最长公共子串问题的一个更具体的例子。我只需要在一个数组中找到最长的公共起始子串"。

所以我只是为这个问题寻找一个 R 实现（最好不要以 JavaScript 版本中建议的 for / while 循环 方式），如果可能的话，我想把它包装成一个函数，所以我可以应用于数据表中的许多组。

经过一些搜索，我找不到一个 R 示例，因此这个问题。

示例数据： 我有以下字符向量：

dput(data)
c("ADA4417-3ARMZ-R7", "ADA4430-1YKSZ-R2", "ADA4430-1YKSZ-R7", 
"ADA4431-1YCPZ-R2", "ADA4432-1BCPZ-R7", "ADA4432-1BRJZ-R2")

我希望在 R 中运行一个算法，它会找到以下输出：ADA44。

从我在 JavaScript 接受的答案中看到的，这个想法是首先对向量进行排序，提取第一个和最后一个元素（例如："ADA4417-3ARMZ-R7" 和 "ADA4432-1BRJZ-R2"，将它们分成单个字符，然后循环通过它们直到其中一个字符不匹配（希望我是对的）

任何关于这方面的帮助都会很棒！

Answer 1

从你的建议中获得灵感，你可以试试这个功能：

comsub<-function(x) {
    # sort the vector
    x<-sort(x)
    # split the first and last element by character
    d_x<-strsplit(x[c(1,length(x))],"")
    # compute the cumulative sum of common elements
    cs_x<-cumsum(d_x[[1]]==d_x[[2]])
    # check if there is at least one common element
    if(cs_x[1]!=0) {
        # see when it stops incrementing and get the position of last common element
        der_com<-which(diff(cs_x)==0)[1]
        # return the common part
        return(substr(x[1],1,der_com))
    } else { # else, return an empty vector
        return(character(0))
    }
}

更新

按照@nicola 的建议，该函数的一个更简单、更优雅的变体：

comsub<-function(x) {
    # sort the vector
    x<-sort(x)
    # split the first and last element by character
    d_x<-strsplit(x[c(1,length(x))],"")
    # search for the first not common element and so, get the last matching one
    der_com<-match(FALSE,do.call("==",d_x))-1
    # if there is no matching element, return an empty vector, else return the common part
    ifelse(der_com==0,return(character(0)),return(substr(x[1],1,der_com)))
}

示例：

使用您的数据

x<-c("ADA4417-3ARMZ-R7", "ADA4430-1YKSZ-R2", "ADA4430-1YKSZ-R7", 
"ADA4431-1YCPZ-R2", "ADA4432-1BCPZ-R7", "ADA4432-1BRJZ-R2")
> comsub(x)
#[1] "ADA44"

当没有公共起始子串时

x<-c("abc","def")
> comsub(x)
# character(0)

Answer 2

非base 的替代方案，使用Biostrings 中的lcprefix 函数来查找“两个字符串的最长公共前缀[...]”

source("http://bioconductor.org/biocLite.R")
biocLite("Biostrings")
library(Biostrings)

x2 <- sort(x)
substr(x2[1], start = 1, stop = lcprefix(x2[1], x2[length(x2)]))
# [1] "ADA44"

Answer 3

借鉴 Henrik 的回答，Bioconductor 有一个基于 C 的前缀函数和一个基于 R 的函数。基于 R 的一个是：

lcPrefix <- function (x, ignore.case = FALSE) 
{
    x <- as.character(x)
    if (ignore.case) 
        x <- toupper(x)
    nc <- nchar(x, type = "char")
    for (i in 1:min(nc)) {
        ss <- substr(x, 1, i)
        if (any(ss != ss[1])) {
            return(substr(x[1], 1, i - 1))
        }
    }
    substr(x[1], 1, i)
}
<environment: namespace:Biobase>

...并且不需要 Bioconductor 的任何特殊功能（据我所知）。

--- 引用 ---

使用 Bioconductor 协调高通量基因组分析。 W。 胡贝尔，V.J. Carey, R. Gentleman, ..., M. Morgan Nature Methods,
2015:12, 115.

Answer 4

这是一个紧凑的解决方案：

data<-c("ADA4417-3ARMZ-R7", "ADA4430-1YKSZ-R2", "ADA4430-1YKSZ-R7", "ADA4431-1YCPZ-R2", "ADA4432-1BCPZ-R7", "ADA4432-1BRJZ-R2")

substr(data[1],1,which.max(apply(do.call(rbind,lapply(strsplit(data,''),`length<-`,nchar(data[1]))),2,function(i)!length(unique(i))==1))-1)
[1] "ADA44"