이동 평균 계산

이동 평균 계산

R을 사용하여 행렬의 일련의 값에 대한 이동 평균을 계산하려고 합니다.R에는 이동 평균을 계산할 수 있는 내장 함수가 없는 것 같습니다.제공되는 패키지가 있습니까?아니면 제가 직접 써야 하나요?

또는 필터를 사용하여 간단히 계산할 수 있습니다. 제가 사용하는 함수는 다음과 같습니다.

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

사용하는 경우dplyr해서 을지할때합니다야해주를 지정합니다.stats::filter상기의 기능으로

• 동물원 패키지의 롤링 평균/최대값/중간값(롤 평균)
• TTR의 이동 평균
• 주요 예보

용사를 합니다.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 오류에 의한 나눗셈이 발생한다는 문제를 가지고 있습니다.

in data.table 1.12.0 newfrollmean되었습니다.NA,NaN그리고.+Inf,-Inf가치.

질문에 재현 가능한 예가 없기 때문에 여기서 더 이상 다룰 것이 없습니다.

에 대한 자세한 정보를 확인할 수 있습니다.?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패키지는 매우 빠른 롤링 평균/min/max/sd를 가지며 다른 기능은 거의 없습니다.나는 오직 함께 일했습니다.runmean그리고.runsd그리고 그것들은 지금까지 언급된 다른 패키지들 중에서 가장 빠릅니다.

다음은 중앙 이동 평균과 후행 이동 평균을 계산하는 방법을 보여주는 예제 코드입니다.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

사용할 수 있습니다.RcppRollC++로 작성된 매우 빠른 이동 평균의 경우.그냥 전화하세요.roll_mean기능.문서는 여기에서 찾을 수 있습니다.

그렇지 않은 경우 루프에 대한 이(느림)는 다음과 같은 효과는 다음과 같습니다.

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
}

또 다른 방법은, 누락을 처리하는 것입니다.

세 번째 방법은 부분 평균을 계산하거나 계산하지 않도록 이 코드를 개선하는 것입니다.

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

cantdutch this와 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)

벡 의 이 평 계 있 수 니 다 습 할 산 터 을 균 동 ▁of ▁the ▁average ▁you ▁moving ▁calculate ▁a 다 ▁vector 벡 터 니 ▁may습 있 수xk기준:

apply(embed(x, k), 1, mean)

슬라이더 패키지를 사용할 수 있습니다.그것은 purr과 유사하게 느껴지도록 특별히 설계된 인터페이스를 가지고 있습니다.임의의 함수를 사용할 수 있으며 모든 유형의 출력을 반환할 수 있습니다.데이터 프레임은 행 단위로 반복됩니다.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.는 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

편집: 추가에 큰 기쁨을 누렸습니다.side들어 합계 매개 변수입니다.Date벡터의

---

이를 직접 계산하고자 하는 사람들에게는 다음과 같은 것에 지나지 않습니다.

# 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)
}

약간 느리지만 zoo:: rollapply를 사용하여 행렬에 대한 계산을 수행할 수도 있습니다.

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

여기서 x는 데이터 세트, FUN = 평균은 함수입니다. 최소값, 최대값, sd 등으로 변경할 수 있으며 너비는 롤링 윈도우입니다.

사람들은 이동 기능을 위해 패키지를 사용할 수 있습니다.이 경우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특정 인덱스.패키지 및 기능 설명서에 자세히 나와 있습니다.

다음은 의 간단한 기능입니다.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))]
}

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))
}

rep()에 의해 생성된 벡터와 함께 aggregate를 사용합니다.이렇게 하면 cbind()를 사용하여 데이터 프레임에 한 번에 둘 이상의 열을 집계할 수 있습니다.다음은 길이가 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가 있는 공식을 사용할 수 있습니다.

언급URL : https://stackoverflow.com/questions/743812/calculating-moving-average