Расчет скользящей средней

186

Я пытаюсь использовать R для вычисления скользящего среднего по ряду значений в матрице. Обычный поиск по списку рассылки R не очень помог. Кажется, в R нет встроенной функции, которая позволяла бы мне вычислять скользящие средние. Какие-нибудь пакеты предоставляют? Или мне нужно написать свое?

Джаред
источник

Ответы:

141
f3lix
источник
1
Что такое скользящее среднее в R, не содержащее будущих значений данной временной метки? Я проверил, forecast::maи он содержит все окрестности, не так.
чхв
214

Или вы можете просто рассчитать его с помощью фильтра, вот функция, которую я использую:

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

Если вы используете dplyr, будьте осторожны, чтобы указать stats::filterв функции выше.

Матти Пастелл
источник
49
Я должен отметить, что "сторон = 2" может быть важным вариантом в случаях использования многих людей, которые они не хотят упускать из виду. Если вы хотите, чтобы в скользящем среднем значении была только конечная информация, вы должны использовать сторон = 1.
evanrsparks
36
Несколько лет спустя, но dplyr теперь имеет функцию фильтра, если вы загрузили этот пакет, используйтеstats::filter
blmoore
sides = 2эквивалентно align = "center" для zoo :: rollmean или RcppRoll :: roll_mean. sides = 1эквивалентно «правильному» выравниванию. Я не вижу способа выполнить «левое» выравнивание или вычислить с «частичными» данными (2 или более значений)?
Мэтт Л.
29

Использование 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, тогда будет ошибка деления на ноль.

морская игла
источник
8
Одним из недостатков этого решения является то, что оно не может обрабатывать пропуски:cumsum(c(1:3,NA,1:3))
Jthorpe
Вы можете легко заставить его обрабатывать NA, делая cx <- c(0, cumsum(ifelse(is.na(x), 0, x))).
Рикардо Крус
@Ricardo Cruz: может быть, лучше удалить NA и соответственно отрегулировать длину вектора. Подумайте о векторе с большим количеством NA - нули сместят среднее значение к нулю, а удаление NA оставит среднее как есть. Конечно, все зависит от ваших данных и вопроса, на который вы хотите ответить. :)
mzuther
@mzuther, я обновил ответ после ваших комментариев. Спасибо за вклад. Я думаю, что правильный способ борьбы с отсутствующими данными заключается не в расширении окна (путем удаления значений NA), а в усреднении каждого окна по правильному знаменателю.
Pipefish
1
rn <- cn [(n + 1): длина (cx)] - cx [1: (длина (cx) - n)] на самом деле должно быть rn <- cn [(n + 1): длина (cx)] - cn [1: (длина (cx) - n)]
adrianmcmenamin
22

В 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
jangorecki
источник
10

caToolsПакет очень быстро прокатки среднего / мин / макс / SD и несколько других функций. Я только работал с, runmeanи runsdони являются самыми быстрыми из всех других пакетов, упомянутых на сегодняшний день.

Eddi
источник
1
Это круто! Это единственная функция, которая делает это простым и понятным способом. И сейчас 2018 год ...
Фелипе Джерард
9

Вы можете использовать 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
}
cantdutchthis
источник
3
Не могли бы вы объяснить мне подробнее, как работает этот алгоритм? Потому что я не могу понять идею
Даниил Ефимов
Сначала он инициализирует вектор такой же длины с res = arr. Затем есть цикл, который повторяется, начиная nс 15-го элемента или до конца массива. это означает, что самое первое подмножество, которое он имеет в виду, arr[1:15]заполняет место res[15]. Теперь я предпочитаю устанавливать res = rep(NA, length(arr))вместо res = arrтак, чтобы каждый элемент res[1:14]равнялся NA, а не числу, где мы не могли бы взять полное среднее из 15 элементов.
Эван Фридланд
7

На самом деле 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,...)]
  }
}
Родриго Ремедио
источник
5

Для того, чтобы дополнить ответ cantutchthis и Родриго Ремедио ;

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)
Кристобаль Алькасар
источник
2

Вот пример кода, показывающий, как вычислить центрированную скользящую среднюю и скользящую среднюю с использованием rollmeanфункции из пакета zoo .

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
Я люблю кодировать
источник
1

Хотя и немного медленно, но вы также можете использовать zoo :: rollapply для выполнения вычислений на матрицах.

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

где x - набор данных, FUN = mean - функция; Вы также можете изменить его на min, max, sd и т. д., а width - это скользящее окно.

Гарима Гулати
источник
2
Это не медленно; Сравнивая это с базой R, это намного быстрее. set.seed(123); x <- rnorm(1000); system.time(apply(embed(x, 5), 1, mean)); library(zoo); system.time(rollapply(x, 5, mean)) На моей машине это так быстро, что возвращает время 0 секунд.
Г. Гротендик,
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определенные индексы. Подробнее в документации по комплектации и функциям .

GoGonzo
источник
1

Пакет слайдера может быть использован для этого. Он имеет интерфейс, который был специально разработан, чтобы чувствовать себя похожим на мурлыканье. Он принимает любую произвольную функцию и может возвращать любой тип вывода. Кадры данных даже повторяются по строкам. Сайт 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
Дэвис Воган
источник
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))
}
Мохамед Галия
источник
2
Пожалуйста, добавьте описание для более подробной информации.
Фарбод Ахмадиан
Пожалуйста, свяжите свой ответ с вопросом и включите некоторые результаты, которые показывают, что на вопрос был дан ответ. См. Как ответить, чтобы получить рекомендации по правильному ответу.
Питер