我试着用R来计算矩阵中一系列值的移动平均值。R中似乎没有一个内置函数可以让我计算移动平均线。有任何软件包提供这样的服务吗?还是需要我自己写?


当前回答

事实上,RcppRoll非常好。

cantdutchthis发布的代码必须在窗口的第四行进行修正:

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

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

第三种方法,改进cantdutch这段代码来计算部分平均与否,如下:

  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,...)]
  }
}

其他回答

事实上,RcppRoll非常好。

cantdutchthis发布的代码必须在窗口的第四行进行修正:

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

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

第三种方法,改进cantdutch这段代码来计算部分平均与否,如下:

  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,...)]
  }
}

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

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

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

下面的示例代码展示了如何使用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

滑块包可以用于此。它有一个专门设计的界面,感觉类似呜呜声。它接受任何任意函数,并可以返回任何类型的输出。数据帧甚至按行迭代。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

滑块和数据的开销。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

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

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

其中x为数据集,FUN = mean为函数;你也可以改变它为min, max, sd等,宽度是滚动窗口。