锚定滑动window

Question

我想创建一个滑动 window，其中 window 的起点固定，window 的终点以一个单位的增量增长。因此，在下面的数据框中，window 的开头将保持在 0.10，而另一端将移动到 0.08、0.15 等等，每次它移动到列 Speed 时都会执行一个函数。如果不满足函数的条件，则 window 的末尾继续移动。一旦满足条件，我希望第二列 Out 中的一些输出与整个 window 中之前的所有元素一致。

一旦满足条件，window 就会终止，然后在最后一个 window 结束时再次锚定并重新开始，一次增长一个单位。

例如，对于此数据框，标准可能是 window 的平均值在再次开始之前大于 0.1，因此:

mean(c(0.10, 0.08)) = 0.09 - criteria not met
mean(c(0.10, 0.08, 0.15)) = 0.11 - criteria met so all previous elements are labelled 'A'

下一个：

mean(c(0.13, 0.14)) = 0.14 - criteria met so all previous elements are labelled 'B'

下一个：

mean(c(0.08, 0.10)) = 0.09 - criteria not met
mean(c(0.08, 0.10, 0.07)) = 0.08 - criteria not met
mean(c(0.08, 0.10, 0.07, 0.15)) = 0.1 - criteria met so all previous elements are labelled 'C'


Speed  Out  
0.10    A    
0.08    A
0.15    A
0.13    B
0.14    B
0.08    C
0.10    C
0.07    C
0.15    C

我已经尝试修改 THIS Cross Validated post 中的解决方案（@mbq 和@r_evolutionist 的回答，但运气不佳。我还使用 rollapply 在包 zoo 但我觉得这需要一个自制的功能。

Answer 1

1)首先定义一个cummean函数。然后使用末尾注释中定义的 Speed 定义 st 到 return 的起始索引，用于计算 Speed 的第 j 个元素的平均值，其中 i 是 prior 元素的起始索引Speed。然后使用 Reduce 将 st 应用于 1:n，其中 Speed 有 n 个元素。这给出了一个分组变量 g，以便我们将 Speed 的 cummean 分别应用于 Speed 的每个子集，这些子集在 g.

中具有共同元素

cummean <- function(x) cumsum(x) / seq_along(x)

st <- function(i, j) if (mean(Speed[i:j]) > 0.1) j+1 else i
g <- Reduce(st, seq_along(Speed), acc = TRUE)

ave(Speed, g, FUN = cummean)
## [1] 0.1000000 0.0900000 0.1500000 0.1300000 0.1400000 0.1150000 0.1033333
## [8] 0.0950000 0.0960000

产生的g的值为

g
## [1] 1 1 4 5 6 6 6 6 6

2) 另一种构造 g 的方法是认识到这可以转化为整数线性规划的集合划分问题，其中划分的组件必须是连续的并且均值 > 0.1 。将 Inf 附加到 Speed 的末尾并取其长度 n。然后找到 0:n 的两个元素的所有组合，如果出现零，则将其替换为另一个元素。将其转换为零一向量，然后仅保留平均值 > 0.1 的向量 const.mat。右边是所有的 objective 函数。最后我们将 0-1 解向量转换为 g。请注意 g 中的实际值无关紧要，除了哪些位置具有相同的值。

library(lpSolve)

n <- length(Speed)+1
f <- function(x) {
  if (x[1] == 0) x[1] <- x[2]
  replace(numeric(n), x[1]:x[2], 1)
}
const.mat <- combn(0:n, 2, f)
ok <- apply(const.mat, 2, function(x) mean(c(Speed, Inf)[x == 1]) > .1)
const.mat <- const.mat[, ok]
const.rhs <- rep(1, nrow(const.mat))
obj <- rep(1, ncol(const.mat))
result <- lp("max", obj, const.mat, "=", const.rhs, all.bin = TRUE)
result
result$solution
g <- rowSums(const.mat[, result$solution == 1] %*% diag(1:result$objval))[-n]
g
## [1] 2 2 2 1 3 3 3 4 4

现在将 g 与 (1) 中的 ave 语句一起使用。

备注

注意 cummean 可以实现为：
```
library(zoo)
cummean <- function(x) rollapplyr(x, seq_along(x), mean)
```
优点是可以很容易地用其他函数替换mean。

上面使用的输入是：

Speed <- c(0.1, 0.08, 0.15, 0.13, 0.14, 0.09, 0.08, 0.07, 0.1)

锚定滑动window

Anchored sliding window

r

sliding-window

备注