base R windowing

window-apply.R

window_apply <- function(x, n = 1, fun = mean) {
  fun <- match.fun(fun)
  if (n == 0) {
    return(x)
  }

  s <- seq_along(x)
  lower <- s - n
  upper <- s + n
  
  bad <- lower < 1
  upper[bad] <- upper[bad] + abs(lower[bad]) + 1L
  lower[bad] <- which(bad)

  bad <- upper > length(x)
  lower[bad] <- lower[bad] - (upper[bad] - length(x))
  upper[bad] <- which(bad)

  vapply(
    seq_along(x),
    function(i) {
      fun(x[lower[i]:upper[i]])
    },
    NA_real_
  )
}