Handle 'width' when it's a numeric vector

rollapply.xts() only supports 'width' when it's a scalar, while
rollapply.zoo() supports 'width' when it's a vector of multiple values.
Support this in rollapply.xts() by converting 'data' to zoo, calling
rollapply() on the zoo object, and converting the result back to xts.

Thanks to James Hirschorn (@quantitative-technologies) for the report,
and to @npschweizer for the nudge to fix.

Fixes #290.

Author: joshuaulrich

R/rollapply.xts.R

@@ -22,6 +22,21 @@ rollapply.xts <- function(data, width, FUN, ..., by=1, by.column=TRUE,
   fill=if(na.pad) NA, na.pad=TRUE, partial=TRUE,
   align=c("right","center","left")) {
 
+  # handle width when it has multiple elements
+  if (length(width) > 1) {
+      align. <- match.arg(align)
+      result <-
+          rollapply(as.zoo(data), width, FUN, ..., by = by,
+                    by.column = by.column, fill = fill,
+                    partial = partial, align = align.)
+
+      result <- as.xts(result)
+      return(result)
+  } else {
+      width <- as.integer(width)
+      stopifnot(width > 0, width <= NROW(data))
+  }
+
   if (!missing(na.pad)) {
     warning("na.pad argument is deprecated")
   }
@@ -42,8 +57,6 @@ rollapply.xts <- function(data, width, FUN, ..., by=1, by.column=TRUE,
 
   nr <- NROW(data)
   nc <- NCOL(data)
-  width <- as.integer(width)[1]
-  stopifnot( width > 0, width <= nr )
 
   ## process alignment
   align <- match.arg(align)

inst/tinytest/test-rollapply.R

@@ -0,0 +1,5 @@
+info_msg <- "test rollapply.xts() handles multi-element 'width'"
+x <- .xts(1:6, 1:6)
+rsum <- rollapply(x, width = 1:6, FUN = sum)
+csum <- cumsum(x)
+expect_equal(rsum, csum, info = info_msg)