Calcolo della media mobile

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?

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

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.

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.

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

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.

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

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

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)

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

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.

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 .

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

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