将数据帧拆分为重叠的数据帧答案

【问题标题】：Split a data frame into overlapping dataframes将数据帧拆分为重叠的数据帧
【发布时间】：2011-08-04 22:56:03
【问题描述】：

我正在尝试编写一个行为如下的函数，但事实证明这非常困难：

DF <- data.frame(x = seq(1,10), y = rep(c('a','b','c','d','e'),2))
> DF
    x y
1   1 a
2   2 b
3   3 c
4   4 d
5   5 e
6   6 a
7   7 b
8   8 c
9   9 d
10 10 e

>OverLapSplit(DF,nsplits=2,overlap=2)
[[1]]
  x y
1 1 a
2 2 b
3 3 c
4 4 d
5 5 e
6 6 a

[[2]]
   x y
1  5 a
2  6 b
3  7 c
4  8 d
5  9 e
6 10 a

>OverLapSplit(DF,nsplits=1)
[[1]]
    x y
1   1 a
2   2 b
3   3 c
4   4 d
5   5 e
6   6 a
7   7 b
8   8 c
9   9 d
10 10 e

>OverLapSplit(DF,nsplits=2,overlap=4)
[[1]]
  x y
1 1 a
2 2 b
3 3 c
4 4 d
5 5 e
6 6 a
7 7 b

[[2]]
   x y
1  4 e
2  5 a
3  6 b
4  7 c
5  8 d
6  9 e
7 10 a

>OverLapSplit(DF,nsplits=5,overlap=1)
[[1]]
  x y
1 1 a
2 2 b
3 3 c

[[2]]
  x y
1 3 c
2 4 d
3 5 e

[[3]]
  x y
1 5 e
2 6 a
3 7 b

[[4]]
  x y
1 7 b
2 8 c
3 9 d

[[5]]
   x y
1  8 d
2  9 e
3 10 f

我没有想过如果你尝试类似OverLapSplit(DF,nsplits=2,overlap=1) 会发生什么

可能如下：

[[1]]
  x y
1 1 a
2 2 b
3 3 c
4 4 d
5 5 e

[[2]]
   x y
1  5 a
2  6 b
3  7 c
4  8 d
5  9 e
6 10 a

谢谢！

【问题讨论】：

那么这个函数存在吗，还是你不知道怎么处理边缘情况？
@Chase 函数不存在。如果我得到一个可行（但不优雅）的编码版本，我会发布它。
@Zach 这个 Q apropos 你之前的 Q 吗？ stackoverflow.com/q/5652058/429846
@Gavin Simpson：是的，这个问题是基于我之前的问题。基本上，我正在尝试开发一种方法来并行化rollapply 函数。也许我应该直接问这个问题？
注意 100% 肯定这会有所帮助，您可能希望将数据分解为所需的块大小，1:31、2:32 等并将它们发送到您的节点 - @Joris 和我所做的是将数据拆分为相等的重叠部分，尽管您的 rollapply() 代码正在做的事情并非如此。

标签： r dataframe data-manipulation data-management

【解决方案1】：

试试类似的东西：

OverlapSplit <- function(x,nsplit=1,overlap=2){
    nrows <- NROW(x)
    nperdf <- ceiling( (nrows + overlap*nsplit) / (nsplit+1) )
    start <- seq(1, nsplit*(nperdf-overlap)+1, by= nperdf-overlap )

    if( start[nsplit+1] + nperdf != nrows )
        warning("Returning an incomplete dataframe.")

    lapply(start, function(i) x[c(i:(i+nperdf-1)),])
}

用 nsplit 分割的数量！（nsplit=1 返回 2 个数据帧）。这将呈现一个不完整的最后一个数据帧，以防重叠拆分不真正适合数据帧，并发出警告。

> OverlapSplit(DF,nsplit=3,overlap=2)
[[1]]
  x y
1 1 a
2 2 b
3 3 c
4 4 d

[[2]]
  x y
3 3 c
4 4 d
5 5 e
6 6 a

[[3]]
  x y
5 5 e
6 6 a
7 7 b
8 8 c

[[4]]
    x y
7   7 b
8   8 c
9   9 d
10 10 e

还有一个警告

> OverlapSplit(DF,nsplit=1,overlap=1)
[[1]]
  x y
1 1 a
2 2 b
3 3 c
4 4 d
5 5 e
6 6 a

[[2]]
    x    y
6   6    a
7   7    b
8   8    c
9   9    d
10 10    e
NA NA <NA>

Warning message:
In OverlapSplit(DF, nsplit = 1, overlap = 1) :
  Returning an incomplete dataframe.

【讨论】：

+1 来自第一原则的好答案 --- 我太 [懒惰 |愚蠢的]*为第一原则。 [*酌情删除] ;-)
@Gavin Simpson：我发布了我自己的答案，其中包含我想到的完整工作流程。肯定有改进的余地，但我认为它现在可以满足我的需求。谢谢大家的建议！
@Joris Meys 你将如何不包括“不完整”的重叠数据框（即，进一步超越警告）

【解决方案2】：

这使用了 Lattice graphics 中的 shingle 思想，因此利用包 lattice 中的代码生成间隔，然后使用循环将原始 DF 分解为正确的子集。

我不确定overlap = 1 是什么意思 - 我想你的意思是重叠 1 个样本/观察值。如果是这样，下面的代码就是这样做的。

OverlapSplit <- function(x, nsplits = 1, overlap = 0) {
    stopifnot(require(lattice))
    N <- seq_len(nr <- nrow(x))
    interv <- co.intervals(N, nsplits, overlap / nr)
    out <- vector(mode = "list", length = nrow(interv))
    for(i in seq_along(out)) {
        out[[i]] <- x[interv[i,1] < N & N < interv[i,2], , drop = FALSE]
    }
    out
}

这给出了：

> OverlapSplit(DF, 2, 2)
[[1]]
  x y
1 1 a
2 2 b
3 3 c
4 4 d
5 5 e
6 6 a

[[2]]
    x y
5   5 e
6   6 a
7   7 b
8   8 c
9   9 d
10 10 e

> OverlapSplit(DF)
[[1]]
    x y
1   1 a
2   2 b
3   3 c
4   4 d
5   5 e
6   6 a
7   7 b
8   8 c
9   9 d
10 10 e

> OverlapSplit(DF, 4, 1)
[[1]]
  x y
1 1 a
2 2 b
3 3 c

[[2]]
  x y
3 3 c
4 4 d
5 5 e

[[3]]
  x y
6 6 a
7 7 b
8 8 c

[[4]]
    x y
8   8 c
9   9 d
10 10 e

【讨论】：

注意overlap的定义； co.intervals() 想要重叠的分数而不是重叠样本的绝对数量，因此在某些情况下可能存在舍入问题。如果发生这种情况并且你得到的重叠比你想要的少/多
+1 哇哦！从来没有想过要破解 lattice 来为我做到这一点。不错的一个

【解决方案3】：

只是为了说明我在这里做什么：

#Load Libraries
library(PerformanceAnalytics)
library(quantmod)

#Function to Split Data Frame
OverlapSplit <- function(x,nsplit=1,overlap=0){
    nrows <- NROW(x)
    nperdf <- ceiling( (nrows + overlap*nsplit) / (nsplit+1) )
    start <- seq(1, nsplit*(nperdf-overlap)+1, by= nperdf-overlap )

    if( start[nsplit+1] + nperdf != nrows )
        warning("Returning an incomplete dataframe.")

    lapply(start, function(i) x[c(i:(i+nperdf-1)),])
}

#Function to run regression on 30 days to predict the next day
FL <- as.formula(Next(HAM1)~HAM1+HAM2+HAM3+HAM4)
MyRegression <- function(df,FL) {
  df <- as.data.frame(df)
  model <- lm(FL,data=df[1:30,])
  predict(model,newdata=df[31,])
}

#Function to roll the regression
RollMyRegression <- function(data,ModelFUN,FL) {
  rollapply(data, width=31,FUN=ModelFUN,FL,
    by.column = FALSE, align = "right", na.pad = FALSE)
}

#Load Data
data(managers)

#Split Dataset
split.data <- OverlapSplit(managers,2,30)
sapply(split.data,dim)

#Run rolling regression on each split
output <- lapply(split.data,RollMyRegression,MyRegression,FL)
output
unlist(output)

通过这种方式，您可以将最后的 lapply 替换为并行版本的 lapply 并稍微提高速度。

当然，考虑到处理器的数量和数据集的大小，现在存在优化拆分/重叠的问题。

【讨论】：