apply_any_r_function.R
In runner: Running Operations for Vectors

## ----eval=FALSE---------------------------------------------------------------
# library(runner)
# # full windows
# runner(1:15)
# 
# # summarizing - sum
# runner(
#   1:15,
#   f = sum
# )
# 
# # summarizing - concatenating
# runner(
#   letters[1:15],
#   f = paste,
#   collapse = " > "
# )

## ----eval=FALSE---------------------------------------------------------------
# # summarizing - sum of 4-elements
# runner(
#   1:15,
#   k = 4,
#   f = sum
# )
# 
# # summarizing - slope from lm
# df <- data.frame(
#   a = 1:15,
#   b = 3 * 1:15 + rnorm(15)
# )
# 
# runner(
#   x = df,
#   k = 5,
#   f = function(x) {
#     model <- lm(b ~ a, data = x)
#     coefficients(model)["a"]
#   }
# )

## ----eval=FALSE---------------------------------------------------------------
# idx <- c(4, 6, 7, 13, 17, 18, 18, 21, 27, 31, 37, 42, 44, 47, 48)
# 
# # summarize - mean
# runner::runner(
#   x = idx,
#   k = 5, # 5-days window
#   lag = 1,
#   idx = idx,
#   f = function(x) mean(x)
# )
# 
# 
# # use Date or datetime sequences
# runner::runner(
#   x = idx,
#   k = "5 days", # 5-days window
#   lag = 1,
#   idx = Sys.Date() + idx,
#   f = function(x) mean(x)
# )
# 
# # obtain window from above illustration
# runner::runner(
#   x = idx,
#   k = "5 days",
#   lag = 1,
#   idx = Sys.Date() + idx
# )

## ----eval=FALSE---------------------------------------------------------------
# idx <- c(4, 6, 7, 13, 17, 18, 18, 21, 27, 31, 37, 42, 44, 47, 48)
# 
# # summary
# runner::runner(
#   x = 1:15,
#   k = 5,
#   lag = 1,
#   idx = idx,
#   at = c(18, 27, 48, 31),
#   f = mean
# )
# 
# # full window
# runner::runner(
#   x = idx,
#   k = 5,
#   lag = 1,
#   idx = idx,
#   at = c(18, 27, 48, 31)
# )

## ----eval=FALSE---------------------------------------------------------------
# idx_date <- seq(Sys.Date(), Sys.Date() + 365, by = "1 month")
# 
# # change interval to 4-months
# runner(
#   x = 0:12,
#   idx = idx_date,
#   at = "4 months"
# )
# 
# # calculate correlation at every 6-months
# runner(
#   x = data.frame(
#     a = 1:13,
#     b = 1:13 + rnorm(13, sd = 5),
#     idx_date
#   ),
#   idx = "idx_date",
#   at = "6 months",
#   f = function(x) {
#     cor(x$a, x$b)
#   }
# )

## ----eval=FALSE---------------------------------------------------------------
# # summarizing - concatenating
# runner::runner(
#   x = 1:10,
#   lag = c(-1, 2, -1, -2, 0, 0, 5, -5, -2, -3),
#   k = c(0, 1, 1, 1, 1, 5, 5, 5, 5, 5),
#   f = paste,
#   collapse = ","
# )
# 
# # full window
# runner::runner(
#   x = 1:10,
#   lag = 1,
#   k = c(1, 1, 1, 1, 1, 5, 5, 5, 5, 5)
# )
# 
# # on dates
# idx <- c(4, 6, 7, 13, 17, 18, 18, 21, 27, 31, 37, 42, 44, 47, 48)
# 
# runner::runner(
#   x = 1:15,
#   lag = sample(c("-2 days", "-1 days", "1 days", "2 days"),
#     size = 15,
#     replace = TRUE
#   ),
#   k = sample(c("5 days", "10 days", "15 days"),
#     size = 15,
#     replace = TRUE
#   ),
#   idx = Sys.Date() + idx,
#   f = function(x) mean(x)
# )

## ----eval=FALSE---------------------------------------------------------------
# idx <- c(4, 6, 7, 13, 17, 18, 18, 21, 27, 31, 37, 42, 44, 47, 48)
# 
# runner::runner(
#   x = 1:15,
#   k = 5,
#   lag = 1,
#   idx = idx,
#   at = c(4, 18, 48, 51),
#   na_pad = TRUE,
#   f = function(x) mean(x)
# )

## ----eval=FALSE---------------------------------------------------------------
# x <- cumsum(rnorm(40))
# y <- 3 * x + rnorm(40)
# date <- Sys.Date() + cumsum(sample(1:3, 40, replace = TRUE)) # unequaly spaced time series
# group <- rep(c("a", "b"), 20)
# 
# df <- data.frame(date, group, y, x)
# 
# slope <- runner(
#   df,
#   function(x) {
#     coefficients(lm(y ~ x, data = x))[2]
#   }
# )
# 
# plot(slope)

## ----eval=FALSE---------------------------------------------------------------
# library(dplyr)
# 
# summ <- df %>%
#   group_by(group) %>%
#   mutate(
#     cumulative_mse = runner(
#       x = .,
#       k = "20 days",
#       idx = "date", # specify column name instead df$date
#       f = function(x) {
#         coefficients(lm(y ~ x, data = x))[2]
#       }
#     )
#   )
# 
# library(ggplot2)
# summ %>%
#   ggplot(aes(x = date, y = cumulative_mse, group = group, color = group)) +
#   geom_line()

## ----eval=FALSE---------------------------------------------------------------
# df %>%
#   group_by(group) %>%
#   run_by(idx = "date", k = "20 days", na_pad = FALSE) %>%
#   mutate(
#     cumulative_mse = runner(
#       x = .,
#       f = function(x) {
#         mean((residuals(lm(y ~ x, data = x)))^2)
#       }
#     ),
#     intercept = runner(
#       x = .,
#       f = function(x) {
#         coefficients(lm(y ~ x, data = x))[1]
#       }
#     ),
#     slope = runner(
#       x = .,
#       f = function(x) {
#         coefficients(lm(y ~ x, data = x))[2]
#       }
#     )
#   )

## ----eval=FALSE---------------------------------------------------------------
# library(parallel)
# 
# numCores <- detectCores()
# cl <- makeForkCluster(numCores)
# 
# runner(
#   x = df,
#   k = 10,
#   idx = "date",
#   f = function(x) sum(x$x),
#   cl = cl
# )
# 
# stopCluster(cl)