主页 / coding / 问题 / 79045676
Accepted
mto_19
Asked: 2024-10-02 15:05:43 +0800 CST

从开始快速成对最长公共子串

  • 772

假设有很多二进制字符串

x <- c("0100100010101010", "0100110010101010","0111001000","010111")

我正在寻找 R 中的一种快速方法来输出一个矩阵，该矩阵包含从开始到结束的成对（不包括自匹配）最长公共子串。例如，解决方案可能如下所示

> mySolution(x)
    [,1]     [,2]      [,3]      [,4]
[1,] ""       "01001"   "01"     "010"
[2,] "01001"  ""        "01"     "010"
[3,] "01"     "01"      ""       "01"
[4,] "010"    "010"     "01"     ""

例如，位置 [1,2] 处的矩阵是从 和 开始的最长公共子串x[1]。x[2]请注意，生成的矩阵是对称的。因此，我们只需要计算它的一半。

我知道可以与类似函数一起使用substr,sub,grepl，但由于我有很多字符串，我正在寻找一种非常有效的解决方案，需要很少的计算时间。也许可以将其转换为二进制数以提高性能？

3 个回答

  1. 也许性能不是那么好，但如果你有一个helper函数从一开始找到最长的公共子字符串，它应该可以按预期工作

    helper <- function(a, b) {
    l <- min(nchar(a), nchar(b))
    aa <- substr(a, 1, l)
    bb <- substr(b, 1, l)
    vaa <- utf8ToInt(aa)
    vbb <- utf8ToInt(bb)
    if (aa == bb) {
        aa
    } else {
        k <- which.max(vaa != vbb) - 1
        ifelse(k > 0, intToUtf8(vaa[1:k]), "")
    }
}

    在其基础上，你还可以定义自定义函数f1()，f2()例如，

    f1 <- function(x) `diag<-`(outer(x, x, Vectorize(helper)), "")

    或者它的变体，但速度要快一点

    f2 <- function(x) {
    res <- matrix(rep("", length(x)^2), length(x))
    v <- combn(x, 2, \(p) helper(p[1], p[2]))
    res[lower.tri(res)] <- v
    res[upper.tri(res)] <- t(res)[upper.tri(res)]
    res
}

    使得

    > f1(x)
     [,1]    [,2]    [,3] [,4]
[1,] ""      "01001" "01" "010"
[2,] "01001" ""      "01" "010"
[3,] "01"    "01"    ""   "01"
[4,] "010"   "010"   "01" ""

> f2(x)
     [,1]    [,2]    [,3] [,4]
[1,] ""      "01001" "01" "010"
[2,] "01001" ""      "01" "010"
[3,] "01"    "01"    ""   "01"
[4,] "010"   "010"   "01" ""

    基准

    set.seed(0)
x <- replicate(1000, paste0(sample.int(2, sample(5, 1), TRUE) - 1, collapse = ""))
microbenchmark(
    f1(x),
    f2(x),
    unit = "relative",
    times = 10L,
    check = "equal"
)

    节目

    Unit: relative
  expr      min       lq     mean   median       uq      max neval
 f1(x) 2.125062 2.010759 2.057626 1.951325 2.154321 2.099333    10
 f2(x) 1.000000 1.000000 1.000000 1.000000 1.000000 1.000000    10
    • 5

  2. 对于某些成本高昂的步骤，可以使用data.table每个线程进行扩展。仅打印上三角。

    library(data.table) # rleid, tstrsplit

getPsub <- function(dat){

  len <- seq_along(dat)
  mlen <- max(len)

  mat <- matrix(NA, mlen, mlen)
  d <- do.call(rbind, tstrsplit(dat, ""))

  mat[lower.tri(mat)] <- apply(combn(len, 2), 2, \(x){
    res <- d[,x[1]] == d[,x[2]]
    paste(d[rleid(res) == 1 & res, x[1]], collapse="")})

  t(mat)
}

    输出

    getPsub(x)
     [,1] [,2]    [,3] [,4]
[1,] NA   "01001" "01" "010"
[2,] NA   NA      "01" "010"
[3,] NA   NA      NA   "01"
[4,] NA   NA      NA   NA
    • 3
  3. Best Answer

    针对大型二进制字符串向量的快速解决方案。下面的函数flcs能够在大约 13 秒内对 10k 个二进制字符串执行所需的操作。

    思路是依次检查k每个字符串的第 字符，并将每个字符串放入一个0容器或一个容器中。如果和在不同的容器中，则和1之间的最长公共子串在或之前终止。ijkij

    flcs返回成对公共子串的端点，可用于填充所需矩阵的底部三角形。

    library(data.table)

flcs <- function(x) {
  y <- lapply(x, \(x) utf8ToInt(x) == 49L)
  nx <- length(x)
  nx1 <- nx - 1L
  lens <- lengths(y)
  dt <- data.table(
    v = unlist(y),
    i = sequence(lens),
    j1 = rep.int(1:nx, lens)
  )[,j2 := (j1 - 1L)*nx]
  # `n` is a vector containing the earliest mismatch between pairs
  n <- pmin(lens[rep.int(1:nx1, nx1:1)], lens[sequence(nx1:1, 2:nx)])
  b <- logical(length(n))
  # create a vector `idx` to map to the indices of `n`
  idx <- integer(nx^2)
  idx[sequence(nx1:1, seq(2, nx^2, nx + 1))] <-
    idx[sequence(nx1:1, seq(nx + 1, nx^2, nx + 1), nx)] <- 1:length(n)
  
  for (k in 1:-sort.int(-lens, 2)[2]) {
    nstop <- idx[dt[i == k, outer(j2[v], j1[!v], "+")]]
    nstop <- nstop[!b[nstop]]
    b[nstop] <- TRUE
    n[nstop] <- k - 1L
    if (all(b)) break
  }
  
  n
}

    演示：

    x <- c("0100100010101010", "0100110010101010","0111001000","010111")
flcs(x)
#> [1] 5 2 3 2 3 2

    根据输出构建最终矩阵的函数flcs：

    buildmat <- function(x, n, symmetric = FALSE) {
  nx <- length(x)
  nx1 <- nx - 1L
  z <- matrix("", nx, nx)
  if (symmetric) {
    z[sequence(nx1:1, seq(2, nx^2, nx + 1))] <-
      z[sequence(nx1:1, seq(nx + 1, nx^2, nx + 1), nx)] <-
      substr(x[rep.int(1:nx1, nx1:1)], 1, n)
  } else {
    z[sequence(nx1:1, seq(2, nx^2, nx + 1))] <-
      substr(x[rep.int(1:nx1, nx1:1)], 1, n)
  }
  
  z
}

buildmat(x, flcs(x), TRUE)
#>      [,1]    [,2]    [,3] [,4] 
#> [1,] ""      "01001" "01" "010"
#> [2,] "01001" ""      "01" "010"
#> [3,] "01"    "01"    ""   "01" 
#> [4,] "010"   "010"   "01" ""

    与并行比较每个字符串与其他字符串的解决方案进行比较。

    library(parallel)

f <- function(x) {
  n <- min(length(x[[1]]), length(x[[2]]))
  out <- which.max(x[[1]][1:n] != x[[2]][1:n])
  if (out == 1L && x[[1]][1] == x[[2]][1]) n + 1L else out
}

cl <- makeCluster(detectCores() - 1) # 15 cores
clusterExport(cl, c("f"), environment(f))

flcsPar <- function(x) {
  unlist(parLapply(cl, combn(lapply(x, utf8ToInt), 2, NULL, FALSE), f)) - 1L
}

buildmat(x, flcsPar(x), TRUE)
#>      [,1]    [,2]    [,3] [,4] 
#> [1,] ""      "01001" "01" "010"
#> [2,] "01001" ""      "01" "010"
#> [3,] "01"    "01"    ""   "01" 
#> [4,] "010"   "010"   "01" ""

    在 10k 二进制字符串向量上对这两个函数进行计时。

    x <- vapply(1:1e4, \(.) intToUtf8(sample(48:49, sample(10:20, 1), 1)), "")
system.time(n1 <- flcs(x))
#>    user  system elapsed 
#>    9.84    3.41   13.26
system.time(n2 <- flcsPar(x))
#>    user  system elapsed 
#>   69.31   54.53  242.07
identical(n1, n2)
#> [1] TRUE

    flcs在大约13秒内进行了近5000万次比较。

    • 3

相关问题