将滚动功能应用于动物园或 xts 对象的更好方法？

Question

我想知道是否没有更优雅的方法来做到这一点。我尝试了 rollapply，但无法让它响应超过 zoo 对象的第一列。

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

这是一个有效的例子，但不是很优雅：

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)