3

我想在 R 中解决一个奇怪的问题：
假设我们有 2 个向量，x 和 y，其中每个向量中的每个元素都是唯一的，向量具有相同的长度，向量 2 是向量的排列1：

x <- LETTERS[c(1,2,3,4,5,6,7,8,9,10)]
y <- LETTERS[c(5,8,7,9,6,10,1,3,2,4)]

让我们将“链”定义为一种特殊类型的排列，具有定义的第一个和最后一个元素。
例如，可能是的排列，而"A" "B" "C" "D"可能"C" "B" "D" "A"
的“链”"A" "B" "C" "D"是"A" "C" "B" "D"

我的目标是找出 x 和 y 共有的所有“链”。例如，x 和 y 有一个共同的长度为 4 的链：

> x[1:4]
[1] "A" "B" "C" "D"
> y[7:10]
[1] "A" "C" "B" "D"

（链为A、B、C、D，顺序不限，以A开头，以D结尾）

和一个长度为 6 的公共链：

> x[5:10]
[1] "E" "F" "G" "H" "I" "J"
> y[1:6]
[1] "E" "H" "G" "I" "F" "J"

（链为E、F、G、H、I、J任意顺序，以E开头，以J结尾）

我编写了以下函数来识别特定长度的子链：

subChains <- function(x, y, Len){
    start.x <- rep(NA, length(x))
    start.y <- rep(NA, length(y))
    for (i in 1:(length(x) - Len + 1)) {
        for (j in 1:(length(y) - Len + 1)) {
            canidate.x <- x[i:(i+Len-1)]
            canidate.y <- y[j:(j+Len-1)]
            if (
                    canidate.x[1]==canidate.y[1] & 
                    canidate.x[Len]==canidate.y[Len] &
                    all(canidate.x %in% canidate.y) & 
                    all(canidate.y %in% canidate.x)
                    ){
                start.x[i] <- i
                start.y[i] <- j
            }
        }
    }
    return(na.omit(data.frame(start.x, start.y, Len)))
}

使用如下：

> subChains(x, y, 4)
  start.x start.y Len
1       1       7   4

以下函数可用于查找 2 个向量共有的所有链：

allSubchains <- function(x, y, Lens){
    do.call(rbind, lapply(Lens, function(l) subChains(x, y, l)))
}

使用如下：

allSubchains(x, y, Lens=1:10)
   start.x start.y Len
1        1       7   1
2        2       9   1
3        3       8   1
4        4      10   1
5        5       1   1
6        6       5   1
7        7       3   1
8        8       2   1
9        9       4   1
10      10       6   1
11       1       7   4
51       5       1   6

当然，这两个功能都非常缓慢。我是否可以改进它们，以便它们可以在合理的时间内解决更大的问题？例如

n <- 100000
a <- 1:n
b <- sample(a, n)
allSubchains(a, b, Lens=50:100)
4

1 回答 1

4

你的 100,000 箱不到一秒钟会让你开心吗？试试这个：

allSubChains <- function(x, y, Lens) {

   N <- length(x)
   x.starts <- 1:N
   y.starts <- match(x, y)   # <-- That's where the money is

   subChains <- function(Len) {
      x.ends <- x.starts + Len - 1L
      y.ends <- y.starts + Len - 1L
      keep   <- which(x.ends <= N & y.ends <= N)
      good   <- keep[x[x.ends[keep]] == y[y.ends[keep]]]
      is.perm <- function(i) all(x[x.starts[i]:x.ends[i]] %in%
                                 y[y.starts[i]:y.ends[i]])
      good    <- Filter(is.perm, good) 
      if (length(good) > 0) data.frame(x.starts[good], y.starts[good], Len)
      else NULL
   }

   do.call(rbind, lapply(Lens, subChains))
}

在这里测试：

n <- 100000
a <- 1:n
b <- sample(a, n)
system.time(z <- allSubChains(a, b, Lens=50:100))
#   user  system elapsed 
#  0.800   0.053   0.848
于 2013-01-05T02:05:14.787 回答