查找所有相邻的组合答案

【问题标题】：Find all adjacent combinations查找所有相邻的组合
【发布时间】：2013-11-23 00:43:01
【问题描述】：

我有一个向量：

data <- c("ta", "tb", "tc", "tk", "tf")

如何将此向量转换为一个列表，其中包含 n 个（其中 n 的范围从 2 到 length(data)-1）相邻元素的每个可能组合？该列表应如下所示（每一行代表一个列表元素）：

"ta", "tb"
"tb", "tc"
"tc", "tk"
"tk", "tf"
"ta", "tb", "tc"
"tb", "tc", "tk"
"tc", "tk", "tf"
"ta", "tb", "tc", "tk"
"tb", "tc", "tk", "tf"

我需要多次执行此操作，因此速度很重要。谢谢！

【问题讨论】：

你的典型length(data)是什么？

标签： r vector combinations elements

【解决方案1】：

编辑：新功能

myFun <- function(Data) {
  A <- lapply(2:(length(Data)-1L), sequence)
  B <- lapply(rev(lengths(A))-1L, function(x) c(0, sequence(x)))
  unlist(lapply(seq_along(A), function(x) {
    lapply(B[[x]], function(y) Data[A[[x]]+y])
  }), recursive = FALSE, use.names = FALSE)
}

用法：

myFun(data)

原始函数

这是使用来自“动物园”的rollapply 的解决方案：

myFun <- function(Data, singles = FALSE) {
  require(zoo)
  x <- 2:(length(Data)-1)
  out <- lapply(x, function(y) rollapply(Data, FUN = c, width = y))
  if (isTRUE(singles)) {
    out <- unlist(lapply(out, function(y) split(y, sequence(nrow(y)))),
                  recursive = FALSE, use.names = FALSE)
  }
  out
}

如果您想按行拆分上述输出（新列表项中的每个项目），请使用 singles = TRUE 参数：

myFun(data, singles = TRUE)
# [[1]]
# [1] "ta" "tb"
# 
# [[2]]
# [1] "tb" "tc"
# 
#######
# SNIP
#######
# 
# [[8]]
# [1] "ta" "tb" "tc" "tk"
# 
# [[9]]
# [1] "tb" "tc" "tk" "tf"

【讨论】：

【解决方案2】：

这是一种使用data.table 的vecseq 函数的方法。基本上，vecseq(x, y, clamp) 为 x 中的每个数字，从相应索引中获取 y 的值并构造序列 x:(x+len)。也就是说，vecseq(c(1L, 4L), c(2L, 6L), 5L) 构造了序列c(1L, 2L, 4L, 5L, 6L)。 clamp 参数只是一个应该 >= 答案长度的参数。如果你不知道，你可以给一个比较大的数字。

这个想法是使用vecseq 生成索引，然后拆分以获取相应的列表。我希望通过逐步运行下面的代码，事情应该很明显（稍微努力:)）。

data <- c("ta", "tb", "tc", "tk", "tf")
require(data.table)
ff <- data.table:::vecseq
my_fun <- function(data) {
    xmin = 2L
    xmax = length(data)-1L
    len = xmax-xmin+1L
    tot = sum(xmax:xmin)

    t1 = ff(rep(1L, len), xmax:xmin, tot)
    t2 = rep.int(xmin:xmax, xmax:xmin)
    idx = ff(t1,t2,sum(t2))
    dt = data.table(x=data[idx], id=rep.int(seq_along(t2), t2))
    setattr(dt, 'sorted', 'id')
    dt[J(seq_along(t2)), list(list(x))]$V1
}

这似乎很快，与@flodel 的（优秀）答案相当。当数据长度达到 250 左右时，差异约为 0.2 秒（此解决方案更快）。所以，差别不大。

【讨论】：

【解决方案3】：

这是一种方法：

adj.poss <- function(x) {
  n <- length(x)
  stopifnot(n > 2L)
  idx <- expand.grid(start = 1L:n, len = 2L:(n-1L))
  idx$end <- idx$start + idx$len - 1L
  idx <- idx[idx$end <= n, ]
  Map(function(start, end) x[start:end], idx$start, idx$end)
}

adj.poss(data) 以与您指定的完全相同的顺序给出您的预期输出。

【讨论】：

我选择了 foldel 的回答。对于我的数据（典型长度