Calculating moving average

前端 未结 16 1777
夕颜
夕颜 2020-11-21 23:55

I\'m trying to use R to calculate the moving average over a series of values in a matrix. The normal R mailing list search hasn\'t been very helpful though. There doesn\'t s

16条回答
  •  再見小時候
    2020-11-22 00:47

    EDIT: took great joy in adding the side parameter, for a moving average (or sum, or ...) of e.g. the past 7 days of a Date vector.


    For people just wanting to calculate this themselves, it's nothing more than:

    # x = vector with numeric data
    # w = window length
    y <- numeric(length = length(x))
    
    for (i in seq_len(length(x))) {
      ind <- c((i - floor(w / 2)):(i + floor(w / 2)))
      ind <- ind[ind %in% seq_len(length(x))]
      y[i] <- mean(x[ind])
    }
    
    y
    

    But it gets fun to make it independent of mean(), so you can calculate any 'moving' function!

    # our working horse:
    moving_fn <- function(x, w, fun, ...) {
      # x = vector with numeric data
      # w = window length
      # fun = function to apply
      # side = side to take, (c)entre, (l)eft or (r)ight
      # ... = parameters passed on to 'fun'
      y <- numeric(length(x))
      for (i in seq_len(length(x))) {
        if (side %in% c("c", "centre", "center")) {
          ind <- c((i - floor(w / 2)):(i + floor(w / 2)))
        } else if (side %in% c("l", "left")) {
          ind <- c((i - floor(w) + 1):i)
        } else if (side %in% c("r", "right")) {
          ind <- c(i:(i + floor(w) - 1))
        } else {
          stop("'side' must be one of 'centre', 'left', 'right'", call. = FALSE)
        }
        ind <- ind[ind %in% seq_len(length(x))]
        y[i] <- fun(x[ind], ...)
      }
      y
    }
    
    # and now any variation you can think of!
    moving_average <- function(x, w = 5, side = "centre", na.rm = FALSE) {
      moving_fn(x = x, w = w, fun = mean, side = side, na.rm = na.rm)
    }
    
    moving_sum <- function(x, w = 5, side = "centre", na.rm = FALSE) {
      moving_fn(x = x, w = w, fun = sum, side = side, na.rm = na.rm)
    }
    
    moving_maximum <- function(x, w = 5, side = "centre", na.rm = FALSE) {
      moving_fn(x = x, w = w, fun = max, side = side, na.rm = na.rm)
    }
    
    moving_median <- function(x, w = 5, side = "centre", na.rm = FALSE) {
      moving_fn(x = x, w = w, fun = median, side = side, na.rm = na.rm)
    }
    
    moving_Q1 <- function(x, w = 5, side = "centre", na.rm = FALSE) {
      moving_fn(x = x, w = w, fun = quantile, side = side, na.rm = na.rm, 0.25)
    }
    
    moving_Q3 <- function(x, w = 5, side = "centre", na.rm = FALSE) {
      moving_fn(x = x, w = w, fun = quantile, side = side, na.rm = na.rm, 0.75)
    }
    

提交回复
热议问题