Berechnung des gleitenden Durchschnitts

Ich versuche, mit R den gleitenden Durchschnitt über eine Reihe von Werten in einer Matrix zu berechnen. Die normale Suche nach R-Mailinglisten war jedoch nicht sehr hilfreich. Es scheint keine eingebaute Funktion in R zu geben, mit der ich gleitende Durchschnitte berechnen kann. Bieten irgendwelche Pakete eines an? Oder muss ich meine eigenen schreiben?

• Rolling Means / Maximums / Medians im Zoo- Paket (Rollmean)
• MovingAverages in TTR
• ma in Prognose

Oder Sie können es einfach mit einem Filter berechnen. Hier ist die Funktion, die ich verwende:

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

Wenn Sie verwenden dplyr, achten Sie darauf, stats::filterin der obigen Funktion anzugeben .

Die Verwendung cumsumsollte ausreichend und effizient sein. Angenommen, Sie haben einen Vektor x und möchten eine laufende Summe von n Zahlen

cx <- c(0,cumsum(x))
rsum <- (cx[(n+1):length(cx)] - cx[1:(length(cx) - n)]) / n

Wie in den Kommentaren von @mzuther ausgeführt, wird davon ausgegangen, dass die Daten keine NAs enthalten. Um mit diesen umzugehen, müsste jedes Fenster durch die Anzahl der Nicht-NA-Werte geteilt werden. Hier ist eine Möglichkeit, den Kommentar von @Ricardo Cruz aufzunehmen:

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

Dies hat immer noch das Problem, dass, wenn alle Werte im Fenster NAs sind, ein Fehler durch Division durch Null auftritt.

In data.table 1.12.0 neue frollmeanFunktion wurde hinzugefügt , schnelle und exakte mittleren rollen zu berechnen sorgfältig Handhabung NA, NaNund +Inf, -InfWerte.

Da es in der Frage kein reproduzierbares Beispiel gibt, gibt es hier nicht viel mehr zu besprechen.

Weitere Informationen finden Sie ?frollmeanim Handbuch, das auch online unter verfügbar ist ?frollmean.

Beispiele aus dem folgenden Handbuch:

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

Das caToolsPaket hat einen sehr schnell rollenden Mittelwert / min / max / sd und einige andere Funktionen. Ich habe nur mit runmeanund gearbeitet runsdund sie sind die schnellsten aller anderen bisher genannten Pakete.

Sie können RcppRollfür sehr schnell gleitende Durchschnitte verwenden, die in C ++ geschrieben sind. Rufen Sie einfach die roll_meanFunktion auf. Dokumente finden Sie hier .

Andernfalls sollte diese (langsamere) for-Schleife den Trick ausführen:

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

In der Tat RcppRollist sehr gut.

Der von cantdutchthis gepostete Code muss in der vierten Zeile korrigiert werden, um das Fenster zu fixieren:

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

Ein anderer Weg, der mit Fehlschlägen umgeht, ist hier angegeben .

Ein dritter Weg, um diesen Code zu verbessern, um Teilmittelwerte zu berechnen oder nicht, folgt:

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

Um die Antwort von cantdutchthis und Rodrigo Remedio zu ergänzen ;

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)

Hier ist ein Beispielcode, der zeigt, wie ein zentrierter gleitender Durchschnitt und ein nachlaufender gleitender Durchschnitt mithilfe der rollmeanFunktion aus dem Zoo- Paket berechnet werden .

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

Man kann das runnerPaket zum Verschieben von Funktionen verwenden. In diesem Fall mean_runFunktion. Das Problem dabei cummeanist, dass es keine NAWerte verarbeitet, aber mean_runtut. runnerPaket unterstützt auch unregelmäßige Zeitreihen und Fenster können vom Datum abhängen:

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

Man kann auch andere Optionen wie angeben lagund nur atbestimmte Indizes rollen . Mehr in der Paket- und Funktionsdokumentation .

Obwohl etwas langsam, können Sie aber auch zoo :: rollapply verwenden, um Berechnungen für Matrizen durchzuführen.

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

wobei x der Datensatz ist, ist FUN = Mittelwert die Funktion; Sie können es auch in min, max, sd usw. ändern und width ist das rollende Fenster.

Hierfür kann das Slider-Paket verwendet werden. Es hat eine Schnittstelle, die speziell dafür entwickelt wurde, sich ähnlich wie purrr anzufühlen. Es akzeptiert jede beliebige Funktion und kann jede Art von Ausgabe zurückgeben. Datenrahmen werden sogar zeilenweise iteriert. Die pkgdown Seite ist hier .

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

Der Overhead von Slider- und Datentabellen frollapply()sollte ziemlich gering sein (viel schneller als im Zoo). frollapply()scheint für dieses einfache Beispiel hier etwas schneller zu sein, aber beachten Sie, dass nur numerische Eingaben erforderlich sind und die Ausgabe ein skalarer numerischer Wert sein muss. Schiebereglerfunktionen sind vollständig allgemein gehalten, und Sie können einen beliebigen Datentyp zurückgeben.

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