r语言 - 将滚动函数应用于 zoo 或 xts 对象的更好方法

Question

我想知道是否有更优雅的方法可以做到这一点。我尝试了rollapply，但永远无法让它响应超过动物园对象的第一列。

我想访问二维 zoo 或 xts 对象，创建一个包含所有列的滚动窗口，对滚动窗口的每个实例执行一些操作，并返回一个矩阵，其中包含每个滚动窗口上的操作结果。我希望对窗口代码段的操作可分配给我在外部定义的函数。

下面是一个有效但不是很优雅的示例：

rolling_function <- function(my_data, w, FUN = my_func)
{
  ## Produce a rolling window of width w starting at
  ## w, ending at nrow(my_data), with window width w.
  ## FUN is some function passed that performs some
  ## operation on 'snippet' and returns a value for
  ## each column of snippet. That is assembled into
  ## a matrix and returned.
  ## Set up a matrix to hold results
  results <- matrix(ncol = ncol(my_data), 
                    nrow = (nrow(my_data) - w + 1))
  nn <-nrow(my_data)
  for(jstart in 1:(nn - w + 1))
  {
    snippet <- window(my_data, 
                      start = index(my_data[jstart]),
                      end = index(my_data[jstart + w - 1]))
    ## Do something with snippet here
    # print(my_func(snippet))
    results[jstart, ] <- FUN(snippet)
  }
  return(results)
}
my_func <- function(x)
{
  # An example function that takes the difference between
  # the first and last rows of the snippet, x
  result <- as.vector(x[1,]) - as.vector(x[nrow(x),])
  return(result)
}

下面给出了一个小的测试用例：

## Main code
## Define a zoo object with dummy dates
my_data <-zoo(matrix(data = c(1,5,6,5,3,7,8,8,8,2,4,5),
                     nrow = 4, ncol = 3), order.by = as.Date(100:103))
## Define a window width of 2 and call the rolling function
width = 2
print(rolling_function(my_data, width)) 

测试动物园对象为：

1970-04-11 1 3 8
1970-04-12 5 7 2
1970-04-13 6 8 4
1970-04-14 5 8 5

测试输出为：

      [,1] [,2] [,3]
[1,]   -4   -4    6
[2,]   -1   -1   -2
[3,]    1    0   -1

有没有更优雅/直接/更快的方法来执行此操作，也许使用 rollapply（我无法完成这项工作）？

Answer 1

假设输入 z 在末尾的注释中可重复显示，如果宽度为 2，则：

library(zoo)
-diff(z)
##            V2 V3 V4
## 1970-04-12 -4 -4  6
## 1970-04-13 -1 -1 -2
## 1970-04-14  1  0 -1

一般来说：

w <- 2 # modify as needed
-diff(z, w-1)
##            V2 V3 V4
## 1970-04-12 -4 -4  6
## 1970-04-13 -1 -1 -2
## 1970-04-14  1  0 -1

或使用rollapplyr：

w <- 2 # modify as needed
rollapplyr(z, w, function(x) x[1] - x[w])
##            V2 V3 V4
## 1970-04-12 -4 -4  6
## 1970-04-13 -1 -1 -2
## 1970-04-14  1  0 -1

注意

Lines <- "
1970-04-11 1 3 8
1970-04-12 5 7 2
1970-04-13 6 8 4
1970-04-14 5 8 5"
library(zoo)
z <- read.zoo(text = Lines)