我正在尝试使用R来计算矩阵中一系列值的移动平均值。正常的R邮件列表搜索虽然不是很有帮助。 R中似乎没有built-in function允许我计算移动平均线。有任何套餐提供吗？或者我需要自己编写吗？
答案 0 :(得分：188)
或者您可以使用过滤器简单地计算它，这是我使用的函数：
ma <- function(x, n = 5){filter(x, rep(1 / n, n), sides = 2)}
如果您使用dplyr，请注意在上面的函数中指定stats::filter。
答案 1 :(得分：123)
答案 2 :(得分：24)
使用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，则会出现除零错误。
答案 3 :(得分：9)
在 data.table 1.12.0 中添加了新的frollmean函数，以计算快速而精确的滚动，这意味着必须谨慎处理NA，NaN和{{ 1}}，+Inf个值。
由于该问题中没有可复制的示例，因此这里没有更多要解决的问题。
您可以在手册中找到有关-Inf的更多信息，也可以在?frollmean在线获得。
以下手册中的示例：
?frollmean答案 4 :(得分：8)
您可以将RcppRoll用于使用C ++编写的快速移动平均值。只需调用roll_mean函数即可。可以找到文档here。
否则，这个（较慢的）for循环应该可以解决问题：
ma <- function(arr, n=15){
res = arr
for(i in n:length(arr)){
res[i] = mean(arr[(i-n):i])
}
res
}
答案 5 :(得分：8)
caTools包具有非常快的滚动平均值/最小值/最大值/标准差以及其他一些功能。我只使用runmean和runsd，它们是迄今为止提到的其他任何软件包中最快的。
答案 6 :(得分：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
}
另一种处理错失的方法是here。
第三种方法，改进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,...)]
}
}
答案 7 :(得分：4)
为了补充cantdutchthis和Rodrigo Remedio;
的答案%qtconsole答案 8 :(得分：4)
这是示例代码，显示了如何使用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
答案 9 :(得分：2)
EDIT ：非常高兴地添加了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)
}
答案 10 :(得分：2)
您可以通过以下方式计算窗宽为x的向量k的移动平均值：
apply(embed(x, k), 1, mean)
答案 11 :(得分：1)
一个人可以使用runner包来移动功能。在这种情况下，mean_run函数。 cummean的问题在于它不处理NA的值，但是mean_run可以处理：
library(runner)
set.seed(11)
x1 <- rnorm(15)
x2 <- sample(c(rep(NA,5), rnorm(15)), 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
答案 12 :(得分：1)
滑块包可用于此目的。它具有专门设计的感觉类似于purrr的界面。它接受任何任意函数，并且可以返回任何类型的输出。数据帧甚至逐行迭代。 pkgdown网站为here。
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()的开销都应该很低（比Zoo快得多）。 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
答案 13 :(得分：0)
虽然有点慢，但是您也可以使用zoo :: rollapply对矩阵进行计算。
reqd_ma <- rollapply(x, FUN = mean, width = n)
其中x是数据集，FUN =平均值是函数；您还可以将其更改为min，max，sd等，并且宽度是滚动窗口。
答案 14 :(得分：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))
}
答案 15 :(得分：0)
这是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))]
}
答案 16 :(得分：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的公式对数据框中的一个（或全部）列进行此操作。