Calcolo della media mobile


185

Sto cercando di usare R per calcolare la media mobile su una serie di valori in una matrice. La normale ricerca nella mailing list R non è stata molto utile. Non sembra esserci una funzione integrata in R mi permetterà di calcolare le medie mobili. Alcuni pacchetti ne forniscono uno? O devo scrivere il mio?

Risposte:


140
  • Rolling Means / Maximums / Medians in the zoo package (rollmean)
  • MovingAverages in TTR
  • ma in previsione

1
Qual è la media mobile in R che non contiene valori futuri di un dato timestamp? Ho controllato forecast::mae contiene tutto il vicinato, non giusto.
hhh,

214

Oppure puoi semplicemente calcolarlo usando il filtro, ecco la funzione che uso:

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

Se si utilizza dplyr, fare attenzione a specificare stats::filternella funzione sopra.


49
Vorrei sottolineare che "side = 2" può essere un'opzione importante nei casi d'uso di molte persone che non vogliono trascurare. Se vuoi solo informazioni finali nella tua media mobile, dovresti usare side = 1.
evanrsparks,

36
Alcuni anni dopo, ma dplyr ora ha una funzione di filtro, se hai questo pacchetto caricato usastats::filter
blmoore

sides = 2è equivalente a align = "center" per lo zoo :: rollmean o RcppRoll :: roll_mean. sides = 1è equivalente all'allineamento "giusto". Non vedo un modo per eseguire l'allineamento "a sinistra" o calcolare con dati "parziali" (2 o più valori)?
Matt L.,

29

L'uso cumsumdovrebbe essere sufficiente ed efficiente. Supponendo di avere un vettore x e si desidera una somma parziale di n numeri

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

Come sottolineato nei commenti di @mzuther, ciò presuppone che non ci siano NA nei dati. per far fronte a questi sarebbe necessario dividere ciascuna finestra per il numero di valori non NA. Ecco un modo per farlo, incorporando il commento di @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

Ciò ha ancora il problema che se tutti i valori nella finestra sono NA allora ci sarà una divisione per errore zero.


8
Un aspetto negativo di questa soluzione è che non è in grado di gestire i dispersi:cumsum(c(1:3,NA,1:3))
Jthorpe,

Puoi farlo facilmente gestire le NA cx <- c(0, cumsum(ifelse(is.na(x), 0, x))).
Ricardo Cruz,

@Ricardo Cruz: potrebbe essere meglio rimuovere le NA e regolare di conseguenza la lunghezza del vettore. Pensa a un vettore con molti NA: gli zeri tirano la media verso zero, mentre rimuovendo i NA lascia la media così com'è. Dipende tutto dai tuoi dati e dalla domanda a cui vuoi rispondere, ovviamente. :)
mzuther,

@mzuther, ho aggiornato la risposta seguendo i tuoi commenti. Grazie per l'input. Penso che il modo corretto di gestire i dati mancanti non sia l'estensione della finestra (rimuovendo i valori NA), ma facendo una media di ciascuna finestra con il denominatore corretto.
pipefish

1
rn <- cn [(n + 1): lunghezza (cx)] - cx [1: (lunghezza (cx) - n)] dovrebbe effettivamente essere rn <- cn [(n + 1): lunghezza (cx)] - cn [1: (lunghezza (cx) - n)]
adrianmcmenamin

22

In data.table 1.12.0 nuova frollmeanfunzione è stata aggiunta per calcolare rapido e preciso a rotazione media con cura la gestione NA, NaNe +Inf, -Infvalori.

Poiché non esiste un esempio riproducibile nella domanda, non c'è molto altro da affrontare qui.

Puoi trovare maggiori informazioni su ?frollmeannel manuale, disponibile anche online all'indirizzo ?frollmean.

Esempi dal manuale seguente:

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

10

Il caToolspacchetto ha una media di rotazione molto veloce / min / max / sd e poche altre funzioni. Ho lavorato solo con runmeane runsde sono i più veloci di tutti gli altri pacchetti citati fino ad oggi.


1
Questo e spettacolare! È l'unica funzione che lo fa in un modo semplice e piacevole. Ed è il 2018 ora ...
Felipe Gerard,

9

È possibile utilizzare RcppRollper medie mobili molto veloci scritte in C ++. Basta chiamare la roll_meanfunzione. I documenti sono disponibili qui .

Altrimenti, questo (più lento) per loop dovrebbe fare il trucco:

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

3
Potete per favore spiegarmi in dettaglio, come funziona questo algoritmo? Perché non riesco a capire l'idea
Daniel Yefimov,

Per prima cosa inizializza un vettore della stessa lunghezza con res = arr. Quindi c'è un ciclo che scorre a partire da no, il 15 ° elemento, fino alla fine dell'array. ciò significa che il primo sottoinsieme di cui prende la media è arr[1:15]che riempie il punto res[15]. Ora preferisco impostare al res = rep(NA, length(arr))posto di res = arrogni elemento res[1:14]uguale a NA piuttosto che un numero, dove non potremmo prendere una media completa di 15 elementi.
Evan Friedland,

7

In effetti RcppRollè molto buono.

Il codice pubblicato da cantdutchthis deve essere corretto nella quarta riga alla finestra da correggere:

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

Un altro modo, che gestisce i dispersi, è dato qui .

Un terzo modo, migliorando il codice cantdutchthis per calcolare o meno le medie parziali, è il seguente:

  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

Al fine di integrare la risposta di cantdutchthis e 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)

2

Ecco un codice di esempio che mostra come calcolare una media mobile centrata e una media mobile finale usando la rollmeanfunzione dal pacchetto 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

Anche se un po 'lento, ma puoi anche usare zoo :: rollapply per eseguire calcoli sulle matrici.

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

dove x è il set di dati, FUN = mean è la funzione; puoi anche cambiarlo in min, max, sd ecc. e la larghezza è la finestra scorrevole.


2
Non è lento ;. Confrontandolo con la base R, è molto più veloce. set.seed(123); x <- rnorm(1000); system.time(apply(embed(x, 5), 1, mean)); library(zoo); system.time(rollapply(x, 5, mean)) Sulla mia macchina è così veloce che restituisce un tempo di 0 secondi.
G. Grothendieck,

1

Si può usare il runnerpacchetto per spostare le funzioni. In questo caso mean_runfunzione. Il problema cummeanè che non gestisce i NAvalori, ma lo mean_runfa. runneril pacchetto supporta anche serie temporali irregolari e windows può dipendere dalla data:

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

Si possono anche specificare altre opzioni come lage ruotare solo atindici specifici. Altro nella documentazione relativa a pacchetti e funzioni .


1

Il pacchetto slider può essere utilizzato per questo. Ha un'interfaccia che è stata appositamente progettata per sembrare simile a Purrr. Accetta qualsiasi funzione arbitraria e può restituire qualsiasi tipo di output. I frame di dati sono persino ripetuti su righe. Il sito pkgdown è qui .

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

Il sovraccarico di slider e data.table frollapply()dovrebbe essere piuttosto basso (molto più veloce dello zoo). frollapply()sembra essere un po 'più veloce per questo semplice esempio qui, ma nota che richiede solo input numerici e che l'output deve essere un valore numerico scalare. le funzioni di scorrimento sono completamente generiche ed è possibile restituire qualsiasi tipo di dati.

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
Aggiungi una descrizione per ulteriori dettagli.
Farbod Ahmadian

Si prega di mettere in relazione la risposta alla domanda e includere alcuni risultati che mostrano che la domanda ha avuto risposta. Vedi Come rispondere per indicazioni su come ottenere una buona risposta.
Peter
Utilizzando il nostro sito, riconosci di aver letto e compreso le nostre Informativa sui cookie e Informativa sulla privacy.
Licensed under cc by-sa 3.0 with attribution required.