이동 평균 계산

R을 사용하여 행렬의 일련의 값에 대한 이동 평균을 계산하려고합니다. 일반적인 R 메일 링리스트 검색은 그다지 도움이되지 못했습니다. R 에는 내장 함수 가 없어 움직이는 평균을 계산할 수 있습니다. 패키지가 하나를 제공합니까? 아니면 내가 직접 써야합니까?

• 동물원 패키지의 롤링 평균 / 최대 / 중앙값 (롤 평균)
• TTR의 평균 이동
• 엄마는 예측

또는 필터를 사용하여 간단히 계산할 수 있습니다. 다음은 내가 사용하는 기능입니다.

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

를 사용하는 경우 위 기능에서 dplyr주의해서 지정 stats::filter하십시오.

사용 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이면 0으로 나누기 오류가 발생한다는 문제가 있습니다.

에서 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

이 caTools패키지는 매우 빠른 롤링 평균 / 최소 / 최대 / sd를 가지며 다른 기능은 거의 없습니다. 난 단지와 함께 작업 한 runmean및 runsd그들은 지금까지 언급 한 다른 패키지의 가장 빠른입니다.

RcppRollC ++로 작성된 매우 빠른 이동 평균에 사용할 수 있습니다 . 그냥 roll_mean함수를 호출하십시오 . 문서는 여기 에서 찾을 수 있습니다 .

그렇지 않으면이 (느린) for 루프가 트릭을 수행해야합니다.

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

실제로 RcppRoll매우 좋습니다.

cantdutch 가 게시 한 코드는 네 번째 줄에서 수정하여 창에 고정시켜야합니다.

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

cantdutchthis 와 Rodrigo 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)

다음은 동물원 패키지 의 함수를 사용하여 중심 이동 평균 및 후행 이동 평균 을 계산하는 방법을 보여주는 예제 코드 입니다.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

조금 느리지 만 zoo :: rollapply를 사용하여 행렬 계산을 수행 할 수도 있습니다.

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

여기서 x는 데이터 세트이고 FUN = 평균은 함수입니다. min, max, sd 등으로 변경할 수도 있으며 width는 롤링 창입니다.

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특정 인덱스 만 롤업 할 수도 있습니다 . 패키지 및 기능 설명서에 자세히 설명되어 있습니다.

슬라이더 패키지를 사용할 수 있습니다. 그것은 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