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.
- It doesn't work for
n = 1
. This is probably due to sd
.
attached to it.
- 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)
})