224

我正在尝试使用 R 计算矩阵中一系列值的移动平均值。R 中似乎没有内置函数可以让我计算移动平均线。是否有任何套餐提供一个?还是我需要自己写?

4

17 回答 17

236

或者您可以简单地使用过滤器计算它,这是我使用的函数:

ma <- function(x, n = 5){filter(x, rep(1 / n, n), sides = 2)}

如果使用dplyr,请注意在上面的函数中指定stats::filter

于 2011-02-01T12:06:50.387 回答
160
  • zoo包中的滚动均值/最大值/中位数(rollmean)
  • TTR中的移动平均线
  • 马在预测
于 2009-04-13T13:06:55.380 回答
33

使用cumsum应该是充分和有效的。假设你有一个向量x并且你想要n 个数字的运行总和

cx <- c(0,cumsum(x))
rsum <- (cx[(n+1):length(cx)] - cx[1:(length(cx) - n)]) / n

正如@mzuther 在评论中指出的那样,这假设数据中没有 NA。处理这些需要将每个窗口除以非 NA 值的数量。这是一种方法,结合了@Ricardo Cruz 的评论:

cx <- c(0, cumsum(ifelse(is.na(x), 0, x)))
cn <- c(0, cumsum(ifelse(is.na(x), 0, 1)))
rx <- cx[(n+1):length(cx)] - cx[1:(length(cx) - n)]
rn <- cn[(n+1):length(cx)] - cn[1:(length(cx) - n)]
rsum <- rx / rn

这仍然存在一个问题,如果窗口中的所有值都是 NA,那么将出现除以零错误。

于 2015-08-12T20:26:21.840 回答
31

data.table 1.12.0中添加了新frollmean函数来计算快速和精确的滚动平均值,仔细NA处理NaN+Inf-Inf

由于问题中没有可重复的示例,因此这里没有更多要解决的问题。

您可以在手册中找到有关的更多信息?frollmean,也可以在线获取?frollmean

以下手册中的示例:

library(data.table)
d = as.data.table(list(1:6/2, 3:8/4))

# rollmean of single vector and single window
frollmean(d[, V1], 3)

# multiple columns at once
frollmean(d, 3)

# multiple windows at once
frollmean(d[, .(V1)], c(3, 4))

# multiple columns and multiple windows at once
frollmean(d, c(3, 4))

## three above are embarrassingly parallel using openmp
于 2018-12-22T15:00:29.947 回答
12

caTools软件包具有非常快速的滚动平均值/最小值/最大值/标准差和其他一些功能。我只使用过runmean并且runsd它们是迄今为止提到的任何其他软件包中最快的。

于 2013-08-21T17:11:53.500 回答
10

您可以使用RcppRoll用 C++ 编写的非常快速的移动平均线。只需调用该roll_mean函数。文档可以在这里找到。

否则,这个(较慢的)for循环应该可以解决问题:

ma <- function(arr, n=15){
  res = arr
  for(i in n:length(arr)){
    res[i] = mean(arr[(i-n):i])
  }
  res
}
于 2015-01-16T14:49:35.207 回答
7

事实上RcppRoll非常好。

cantdutchthis发布的代码必须在第四行更正到窗口被修复:

ma <- function(arr, n=15){
  res = arr
  for(i in n:length(arr)){
    res[i] = mean(arr[(i-n+1):i])
  }
  res
}

这里给出了另一种处理缺失的方法。

第三种方法,改进cantdutchthis代码以计算或不计算部分平均值,如下:

  ma <- function(x, n=2,parcial=TRUE){
  res = x #set the first values

  if (parcial==TRUE){
    for(i in 1:length(x)){
      t<-max(i-n+1,1)
      res[i] = mean(x[t:i])
    }
    res

  }else{
    for(i in 1:length(x)){
      t<-max(i-n+1,1)
      res[i] = mean(x[t:i])
    }
    res[-c(seq(1,n-1,1))] #remove the n-1 first,i.e., res[c(-3,-4,...)]
  }
}
于 2016-03-13T02:02:15.557 回答
7

下面是示例代码,展示了如何使用zoo包中的函数计算居中移动平均线和尾随移动平均线。rollmean

library(tidyverse)
library(zoo)

some_data = tibble(day = 1:10)
# cma = centered moving average
# tma = trailing moving average
some_data = some_data %>%
    mutate(cma = rollmean(day, k = 3, fill = NA)) %>%
    mutate(tma = rollmean(day, k = 3, fill = NA, align = "right"))
some_data
#> # A tibble: 10 x 3
#>      day   cma   tma
#>    <int> <dbl> <dbl>
#>  1     1    NA    NA
#>  2     2     2    NA
#>  3     3     3     2
#>  4     4     4     3
#>  5     5     5     4
#>  6     6     6     5
#>  7     7     7     6
#>  8     8     8     7
#>  9     9     9     8
#> 10    10    NA     9
于 2020-04-23T03:59:27.933 回答
5

为了补充 cantdutchthisRodrigo Remedio 的答案;

moving_fun <- function(x, w, FUN, ...) {
  # x: a double vector
  # w: the length of the window, i.e., the section of the vector selected to apply FUN
  # FUN: a function that takes a vector and return a summarize value, e.g., mean, sum, etc.
  # Given a double type vector apply a FUN over a moving window from left to the right, 
  #    when a window boundary is not a legal section, i.e. lower_bound and i (upper bound) 
  #    are not contained in the length of the vector, return a NA_real_
  if (w < 1) {
    stop("The length of the window 'w' must be greater than 0")
  }
  output <- x
  for (i in 1:length(x)) {
     # plus 1 because the index is inclusive with the upper_bound 'i'
    lower_bound <- i - w + 1
    if (lower_bound < 1) {
      output[i] <- NA_real_
    } else {
      output[i] <- FUN(x[lower_bound:i, ...])
    }
  }
  output
}

# example
v <- seq(1:10)

# compute a MA(2)
moving_fun(v, 2, mean)

# compute moving sum of two periods
moving_fun(v, 2, sum)
于 2017-06-29T14:22:55.180 回答
3

您可以计算x窗口宽度为的向量的移动平均值k

apply(embed(x, k), 1, mean)
于 2020-09-17T20:51:16.913 回答
2

滑块包可用于此。它的界面经过专门设计,感觉类似于 purrr。它接受任意函数,并且可以返回任何类型的输出。数据帧甚至可以逐行迭代。pkgdown 站点在这里

library(slider)

x <- 1:3

# Mean of the current value + 1 value before it
# returned as a double vector
slide_dbl(x, ~mean(.x, na.rm = TRUE), .before = 1)
#> [1] 1.0 1.5 2.5


df <- data.frame(x = x, y = x)

# Slide row wise over data frames
slide(df, ~.x, .before = 1)
#> [[1]]
#>   x y
#> 1 1 1
#> 
#> [[2]]
#>   x y
#> 1 1 1
#> 2 2 2
#> 
#> [[3]]
#>   x y
#> 1 2 2
#> 2 3 3

滑块和 data.table 的开销frollapply()应该非常低(比动物园快得多)。frollapply()对于这里的这个简单示例,看起来要快一些,但请注意,它只接受数字输入,并且输出必须是标量数值。滑块函数是完全通用的,您可以返回任何数据类型。

library(slider)
library(zoo)
library(data.table)

x <- 1:50000 + 0L

bench::mark(
  slider = slide_int(x, function(x) 1L, .before = 5, .complete = TRUE),
  zoo = rollapplyr(x, FUN = function(x) 1L, width = 6, fill = NA),
  datatable = frollapply(x, n = 6, FUN = function(x) 1L),
  iterations = 200
)
#> # A tibble: 3 x 6
#>   expression      min   median `itr/sec` mem_alloc `gc/sec`
#>   <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl>
#> 1 slider      19.82ms   26.4ms     38.4    829.8KB     19.0
#> 2 zoo        177.92ms  211.1ms      4.71    17.9MB     24.8
#> 3 datatable    7.78ms   10.9ms     87.9    807.1KB     38.7
于 2020-03-24T18:43:12.413 回答
2

编辑:非常高兴地添加side参数,例如Date向量过去 7 天的移动平均值(或总和,或...)。


对于只想自己计算的人来说,无非是:

# 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

但是让它独立于 会很有趣mean(),因此您可以计算任何“移动”函数!

# 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)
}
于 2020-07-18T17:50:21.220 回答
1

虽然有点慢,但您也可以使用 zoo::rollapply 对矩阵执行计算。

reqd_ma <- rollapply(x, FUN = mean, width = n)

其中 x 是数据集,FUN = mean 是函数;您也可以将其更改为 min、max、sd 等,width 是滚动窗口。

于 2018-09-11T04:34:26.353 回答
1

可以使用runner包来移动功能。在这种情况下mean_run功能。问题cummean在于它不处理NA值,但mean_run可以。runner包还支持不规则的时间序列和窗口可以依赖于日期:

library(runner)
set.seed(11)
x1 <- rnorm(15)
x2 <- sample(c(rep(NA,5), rnorm(15)), 15, replace = TRUE)
date <- Sys.Date() + cumsum(sample(1:3, 15, replace = TRUE))

mean_run(x1)
#>  [1] -0.5910311 -0.2822184 -0.6936633 -0.8609108 -0.4530308 -0.5332176
#>  [7] -0.2679571 -0.1563477 -0.1440561 -0.2300625 -0.2844599 -0.2897842
#> [13] -0.3858234 -0.3765192 -0.4280809

mean_run(x2, na_rm = TRUE)
#>  [1] -0.18760011 -0.09022066 -0.06543317  0.03906450 -0.12188853 -0.13873536
#>  [7] -0.13873536 -0.14571604 -0.12596067 -0.11116961 -0.09881996 -0.08871569
#> [13] -0.05194292 -0.04699909 -0.05704202

mean_run(x2, na_rm = FALSE )
#>  [1] -0.18760011 -0.09022066 -0.06543317  0.03906450 -0.12188853 -0.13873536
#>  [7]          NA          NA          NA          NA          NA          NA
#> [13]          NA          NA          NA

mean_run(x2, na_rm = TRUE, k = 4)
#>  [1] -0.18760011 -0.09022066 -0.06543317  0.03906450 -0.10546063 -0.16299272
#>  [7] -0.21203756 -0.39209010 -0.13274756 -0.05603811 -0.03894684  0.01103493
#> [13]  0.09609256  0.09738460  0.04740283

mean_run(x2, na_rm = TRUE, k = 4, idx = date)
#> [1] -0.187600111 -0.090220655 -0.004349696  0.168349653 -0.206571573 -0.494335093
#> [7] -0.222969541 -0.187600111 -0.087636571  0.009742884  0.009742884  0.012326968
#> [13]  0.182442234  0.125737145  0.059094786

还可以指定其他选项,例如lag, 并仅滚动at特定索引。功能文档中的更多内容。

于 2019-10-27T08:09:56.113 回答
1

这是一个简单的函数,filter演示了一种使用填充处理开始和结束 NA 的方法,并filter使用自定义权重计算加权平均值(由 支持):

wma <- function(x) { 
  wts <- c(seq(0.5, 4, 0.5), seq(3.5, 0.5, -0.5))
  nside <- (length(wts)-1)/2
  # pad x with begin and end values for filter to avoid NAs
  xp <- c(rep(first(x), nside), x, rep(last(x), nside)) 
  z <- stats::filter(xp, wts/sum(wts), sides = 2) %>% as.vector 
  z[(nside+1):(nside+length(x))]
}
于 2020-07-19T23:55:36.683 回答
0
vector_avg <- function(x){
  sum_x = 0
  for(i in 1:length(x)){
    if(!is.na(x[i]))
      sum_x = sum_x + x[i]
  }
  return(sum_x/length(x))
}
于 2020-07-16T12:11:49.693 回答
0

我使用聚合以及由 rep() 创建的向量。这具有使用 cbind() 一次在数据框中聚合多于 1 列的优点。以下是长度为 1000 的向量 (v) 的移动平均值为 60 的示例:

v=1:1000*0.002+rnorm(1000)
mrng=rep(1:round(length(v)/60+0.5), length.out=length(v), each=60)
aggregate(v~mrng, FUN=mean, na.rm=T)

请注意,rep 中的第一个参数是根据向量的长度和要平均的数量,简单地为移动范围获取足够的唯一值;第二个参数保持长度等于向量长度,最后一个参数重复第一个参数的值与平均周期相同的次数。

总的来说,您可以使用多个函数(中值、最大值、最小值) - 例如所示的平均值。同样,可以使用带有 cbind 的公式在数据框中的多个(或所有)列上执行此操作。

于 2020-12-07T15:17:15.937 回答