Question

我有一个奇怪的问题，我想在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

当然，这两个功能都非常慢。我可以改进它们，这样它们会在合理的时间内运行在更大的问题上吗？ e.g。

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

Answer 1

你的10万个案件不到一秒会让你开心吗？试试这个：

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

在2个向量中找到共同的“子链”

1 个答案: