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)