Better way to apply rolling function to zoo or xts object?

Question

I am wondering if there isn’t a more elegant way to do this. I tried rollapply but could never get it to respond to more than the first column of the zoo object.

I want to access a 2-dimensional zoo or xts object, create a rolling window that includes all columns, perform some operation on each instance of the rolling window, and return a matrix containing the result of the operation on each of the rolling windows. I want the operation on a windowed snippet to be assignable to a function that I externally define.

Here is an example that works, but is not very elegant:

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)
}

A small test case is given below:

## 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)) 

The test zoo object is:

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

and the test output is:

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

Is there a more elegant/straightforward/faster way to perform this operation, perhaps using rollapply (I could not make this work)?

Answer 1

Assuming the input z shown reproducibly in the Note at the end, if the width is 2 then:

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

and in general:

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

or using 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

Note

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)