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交叉验证帖子中的解决方案（@mbq和@r_evolutionist的回答没有运气。另外我在rollapply包中使用zoo绑定了但我觉得这需要一个自制的功能。

Answer 1

1）首先定义一个cummean函数。然后使用末尾注释中定义的Speed定义st以返回用于计算速度的第j个元素的平均值的起始索引，其中i是{{1}的先前元素的起始索引}。然后使用Speed将Reduce应用于1：n，其中st包含n个元素。这会给出一个分组变量Speed，以便g cummean Speed分别应用于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的另一种方法是认识到这可以作为整数线性编程的集合分区问题，其中分区的组件必须是连续的并且具有意思是＆gt; 0.1。将Inf追加到Speed的末尾并取其长度n。然后找到0：n的两个元素的所有组合，如果出现零则将其替换为另一个元素。将其转换为零一个向量，然后仅保留平均值> 1的那些向量。 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语句。

备注

请注意，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)

锚定滑动窗口

1 个答案:

备注