Medias Móviles
Miguel Arquez Abdala
16/6/2020
library("tidyverse")
library("lubridate")
library("fpp2")
library("zoo")Las medias móviles son métodos de suaviamiento por ventanas (donde la medida de cálculo es el promedio)
SMA (simple moving average)
Promedio simple de un número de periodos específico de 5 periodos:
\[
y_{t} = \frac{y_{t-2}+y_{t-1}+y_{t}+y_{t+1}+y_{t+2}}{5}
\] Podemos calcular la media móvil con la función rollmean de la librería zoo
savings <- economics %>%
select(date, srate = psavert) %>%
mutate(srate_ma01 = rollmean(srate, k = 13, fill = NA),
srate_ma02 = rollmean(srate, k = 25, fill = NA),
srate_ma03 = rollmean(srate, k = 37, fill = NA),
srate_ma05 = rollmean(srate, k = 61, fill = NA),
srate_ma10 = rollmean(srate, k = 121, fill = NA))
savings## # A tibble: 574 x 7
## date srate srate_ma01 srate_ma02 srate_ma03 srate_ma05 srate_ma10
## <date> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1967-07-01 12.6 NA NA NA NA NA
## 2 1967-08-01 12.6 NA NA NA NA NA
## 3 1967-09-01 11.9 NA NA NA NA NA
## 4 1967-10-01 12.9 NA NA NA NA NA
## 5 1967-11-01 12.8 NA NA NA NA NA
## 6 1967-12-01 11.8 NA NA NA NA NA
## 7 1968-01-01 11.7 12.1 NA NA NA NA
## 8 1968-02-01 12.3 11.9 NA NA NA NA
## 9 1968-03-01 11.7 11.8 NA NA NA NA
## 10 1968-04-01 12.3 11.7 NA NA NA NA
## # ... with 564 more rows\(k\) es el tamaño de la ventana, y a medida que aumenta \(k\) más “ruido” se elimina en la serie de tiempo. Sin embargo también deseamos mantener la misma estructura de datos sin perder tanta información, luego necesitamos un balance entre eliminar el ruido y mantener la estructura.
savings %>%
gather(metric, value, srate:srate_ma10) %>%
ggplot(aes(date, value, color = metric)) +
geom_line()## Warning: Removed 252 row(s) containing missing values (geom_path).
Podemos analizar este comportamiento con el MSE y el MAPE, donde como se espera, ambas metricas aumentan cuando \(k\) se hace más grande
savings %>%
gather(metric, value, srate_ma01:srate_ma10) %>%
group_by(metric) %>%
summarise(MSE = mean((srate - value)^2, na.rm = TRUE),
MAPE = mean(abs((srate - value)/srate), na.rm = TRUE))## `summarise()` ungrouping output (override with `.groups` argument)## # A tibble: 5 x 3
## metric MSE MAPE
## <chr> <dbl> <dbl>
## 1 srate_ma01 0.381 0.0573
## 2 srate_ma02 0.561 0.0742
## 3 srate_ma03 0.704 0.0840
## 4 srate_ma05 0.783 0.0932
## 5 srate_ma10 1.25 0.131Media móvil para
savings.ts <- economics %>%
select(srate = psavert) %>%
ts(start = c(1967, 7), frequency = 12)
head(savings.ts, 30)## Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
## 1967 12.6 12.6 11.9 12.9 12.8 11.8
## 1968 11.7 12.3 11.7 12.3 12.0 11.7 10.7 10.5 10.6 10.8 10.6 11.1
## 1969 10.3 9.7 10.2 9.7 10.1 11.1 11.8 11.5 11.6 11.4 11.6 11.8autoplot(savings.ts, series = "Data") +
autolayer(ma(savings.ts, 13), series = "1 yr MA") +
autolayer(ma(savings.ts, 61), series = "5 yr MA") +
autolayer(ma(savings.ts, 121), series = "10 yr MA") +
xlab("Date") +
ylab("Savings Rate")## Warning: Removed 12 row(s) containing missing values (geom_path).## Warning: Removed 60 row(s) containing missing values (geom_path).## Warning: Removed 120 row(s) containing missing values (geom_path).
Podemos usar las medias móviles para pronósticas, con un enfoque parecido al naive:
\[ y_{t+1} = \frac{y_{t-4}+y_{t-3}+y_{t-2}+y_{t-1}+y_{t}}{5} \] En ese caso \(y_{t+1}\) es igual a la media móvil de los cinco periodos anteriores
savings_tma <- economics %>%
select(date, srate = psavert) %>%
mutate(srate_tma = rollmean(srate, k = 12, fill = NA, align = "right"))
tail(savings_tma, 12)## # A tibble: 12 x 3
## date srate srate_tma
## <date> <dbl> <dbl>
## 1 2014-05-01 7.4 6.87
## 2 2014-06-01 7.4 6.92
## 3 2014-07-01 7.5 6.99
## 4 2014-08-01 7.2 7.03
## 5 2014-09-01 7.4 7.08
## 6 2014-10-01 7.2 7.16
## 7 2014-11-01 7.3 7.25
## 8 2014-12-01 7.6 7.35
## 9 2015-01-01 7.7 7.4
## 10 2015-02-01 7.9 7.45
## 11 2015-03-01 7.4 7.45
## 12 2015-04-01 7.6 7.47savings_tma %>%
gather(metric, value, -date) %>%
ggplot(aes(date, value, color = metric)) +
geom_line()## Warning: Removed 11 row(s) containing missing values (geom_path).
Medias moviles de medias moviles
Esto es util con medias moviles pares, que están desbalanceadas, ya que su valor está más a favor de las ultimas observaciones.
\[ y_{t} = \frac{y_{t-1}+y_{t}+y_{t+1}+y_{t+2}}{4} \]
Al crear una media móvil de una media movil con \(k\) par tenemos una media móvil simetrica (y por lo tanto más precisa) Aplicando una media móvil de \(k=2\) a la MA anterior tenemos:
\[ y_{t} = \frac{1}{8} y_{t-2} + \frac{1}{4}y_{t-1} + \frac{1}{4}y_{t} + \frac{1}{4}y_{t+1} +\frac{1}{8}y_{t+2} \]
que es conocida como 2x4-MA
elecsales.df <- data.frame(year = time(elecsales), sales = elecsales)
elecsales.df %>%
mutate(ma2 = rollmean(sales, k = 2, fill = NA),
ma2x4 = ma(sales, order = 4, centre = TRUE)) %>%
gather(ma, value, ma2:ma2x4) %>%
ggplot(aes(x = year)) +
geom_point(aes(y = sales)) +
geom_line(aes(y = value, color = ma))## Don't know how to automatically pick scale for object of type ts. Defaulting to continuous.
## Don't know how to automatically pick scale for object of type ts. Defaulting to continuous.## Warning: Removed 5 row(s) containing missing values (geom_path).
Medias móviles ponderadas
La media movil de una media movil tambien puede ser pensada como una media movil simetrica que tienen distintos pesos en cada observación. Por ejemplo, en el caso de la 2x4-MA anterior los pesos era \(\brack{\frac{1}{8},\frac{1}{4}, \frac{1}{4},\frac{1}{4}, \frac{1}{8}}\). De manera generalizada:
\[ \hat{T_{t}} = \sum_{j=-k}^ka_{j}y_{t+j} \] Donde \(k = \frac{(m-1)}{2}\) y los pesos son \(\brack{a_{-k},...,a_{k}}\). La suma de los pesos debe ser igual a 1 y que además sean simetricos: \(a_{-j} = a_{-j}\). La media movil simple m-MA es un caso especial de la media movil ponderada donde todos los pesos son iguales a \(\frac{1}{m}\). Una ventaja de las medias moviles ponderadas es que producen una estimación del ciclo tendencias más suave. Hay dos medidas populares de pesos en medias moviles, la de Spencer y la de Henderson
autoplot(AirPassengers, series = "Data") +
autolayer(ma(AirPassengers, order = 12, centre = T), series = "2x12-MA") +
ggtitle("Monthly Airline Passengers (1949-60)") +
labs(x = NULL, y = "Passengers")## Warning: Removed 12 row(s) containing missing values (geom_path).