锚定滑动窗

Question

我想创建一个滑动窗口，其中窗口的开始被锚定，窗口的结束以一个单位的增量增长。因此，在窗口开始下方的数据框中，窗口开始处将保持在 0.10，而另一端将移动超过 0.08、0.15 等等，每次移动超过列 Speed 时都会执行一个函数。如果不满足函数的标准，则窗口的末端会继续移动。一旦满足条件，我希望第二列Out 中的一些输出与整个窗口中之前的所有元素一致。

一旦满足条件，窗口就会终止，然后再次锚定在最后一个窗口的末尾并重新开始，一次增长一个单位。

例如，对于这个数据框，标准可能是在重新开始之前窗口的平均值大于 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 帖子中的解决方案（@mbq 和@r_evolutionist 的回答，但运气不佳。此外，我在包zoo 中使用rollapply 并列，但我觉得这需要自制功能。

Answer 1

1) 首先定义一个cummean 函数。然后使用注释中定义的Speed 在末尾定义st 返回用于计算Speed 的第j 个元素的平均值的起始索引，其中i 是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。右手边和目标函数一样都是一。最后我们将 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 语句一起使用。

注意事项

1. 请注意，cummean 可以实现为：

   library(zoo)
   cummean <- function(x) rollapplyr(x, seq_along(x), mean)
   

   它的优点是可以很容易地将mean替换为其他一些功能。

2. 上面使用的输入是：

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