Rolling z-score function in R

Question

I have written a rolling z-score function myself. Is my implementation of rolling z-score function correct?

#x is an xts object and y duration eg rollz(x,25)
rollz<-function(x,y){
 avg=rollapply(x, y, mean)
 std=rollapply(x, y, sd)
 z=(x-avg)/std
 return(z)
}

EDIT

Here is the description of z-score. A rolling (moving) z-score calculates z-score at a particular width like how we calculate simple moving averages.

• Phrancis: Welcome to Code Review. You may want to add a link to inform reviews of what a "rolling z-score" is, seems like a pretty specialized term.
• Eka: I have edited the question and added more information
• Phrancis: Excellent. Hope you get some good answers!
• Tolani: What's an xts object ?
• Eka: its a time series object. I am passing data with time series as the index

Answer 1

This is very old, but I'd like to give a "modern way" of implementing this.

• Everything should be a project, e.g. usethis::create_package("roll_util")

• Every function should be in its own R-file, e.g. usethis::use_r("roll_zscore")

• First version:

  roll_zscore <- function(x, ...) {
  avg <- RcppRoll::roll_mean(x, ...)
  std <- RcppRoll::roll_sd(x, ...)
  (x - avg) / std
  }
  

  Here, instead of y, we are inheriting all the rolling-operation behaviour that is provided by {RcppRoll} (remember to add it as a dependency, usethis::use_package("RcppRoll"))

• Documentation, second version

  #' Rolling Z-scores
  #'
  #'
  #' @param x a time-series `xts` object
  #' @inheritDotParams RcppRoll::roll_mean
  #'
  roll_zscore <- function(x, ...) {
  #omitted
  

• Next, example/test/etc.

  • Testing framework: usethis::use_testthat()
  • Unit-test for this function: usethis::use_test("roll_zscore")
  • We want it to work for {xts} objects, so we add it as a suggestion, because really this function could work with other stuff. usethis::use_package("xts", "Suggests")

• The test looks like this:

  test_that("standard example of roll_zscore", {
   requireNamespace("xts", quietly = TRUE)
   data(sample_matrix, package = "xts")
   sample.xts <- xts::as.xts(sample_matrix, descr='my new xts object')
   roll_zscore(sample.xts$Open, n = 2, fill = NA)
   roll_zscore(sample.xts$Open, n = 25, NA)
  })
  

  From this test, we discover some crucial problems with this implementation.

  1. It doesn't work for n = 1. This is probably due to sd. attached to it.
  2. In order, to do the last calculation, the fill argument must be set to something, otherwise the vectors won't be of equal length.

  Either decide to handle these in the function, in the documentation, or elsewhere.

To properly handle ellipsis arguments, I've made use of do.call. Honestly, if I wasn't trying to make this as simple as possible, I'd have used rlang and purrr::exec.

Final version of the code:

#' Rolling Z-scores
#'
#'
#' @param x a time-series `xts` object
#' @inheritDotParams RcppRoll::roll_mean
#'
roll_zscore <- function(x, ...) {
 args <- list(...)
 # either use provided `fill` or `NA`
 args$fill <- if (is.null(args$fill)) NA else args$fill
 args <- append(args, list(x = x))
 avg <- do.call(RcppRoll::roll_mean, args)
 std <- do.call(RcppRoll::roll_sd, args)
 (x - avg) / std
}

And final test file:

test_that("standard example of roll_zscore", {
 requireNamespace("xts", quietly = TRUE)
 data(sample_matrix, package = "xts")
 sample.xts <- xts::as.xts(sample_matrix, descr='my new xts object')
 roll_zscore(sample.xts, n = 3)
 roll_zscore(sample.xts$Open, n = 25)
 roll_zscore(sample.xts, n = 3, fill = 0)
 roll_zscore(sample.xts, n = 3, fill = NA)
 roll_zscore(sample.xts$Open, n = 2, fill = NA)
 roll_zscore(sample.xts$Open, n = 25, fill = NA)
})