Modelo de Series de tiempo no estacionaria del M2 de EEUU
Rudy Briceño y Angela Avendaño
2025-07-01
Cargamos las librerias y los datos a utilizar para este modelo
Grafica y descomposición de la serie de tiempo no estacionaria
# Gráfico de la serie original con LOESS - CORRECTO
datos$observation_date <- as.Date(datos$observation_date)
puntos_extremos <- datos %>%
filter(WM2NS == max(WM2NS, na.rm = TRUE) | WM2NS == min(WM2NS, na.rm = TRUE)) %>%
mutate(Label = paste0(round(WM2NS, 1), "\n", format(observation_date, "%b %Y")))
ggplot(data = datos, aes(x = observation_date, y = WM2NS)) +
geom_line(color = "grey50", alpha = 0.6, linewidth = 0.7) +
geom_smooth(
method = "loess",
se = TRUE,
color = "#3366FF",
fill = "#99CCFF",
alpha = 0.2,
linewidth = 1.2
) +
geom_label_repel(
data = puntos_extremos,
aes(label = Label),
size = 3,
box.padding = 0.7,
min.segment.length = 0,
segment.color = "grey30"
) +
geom_hline(
yintercept = c(max(datos$WM2NS, na.rm = TRUE), min(datos$WM2NS, na.rm = TRUE)),
linetype = "dotted",
color = "grey60",
alpha = 0.7
) +
labs(
title = "Trayectoria de WM2NS",
subtitle = "Serie temporal con tendencia suavizada (LOESS) y valores extremos",
y = "Valor de WM2NS",
x = "Fecha de Observación",
caption = "Fuente: Federal Reserve Economic Data (FRED)"
) +
scale_x_date(
date_breaks = "1 year",
date_labels = "%Y",
expand = expansion(mult = c(0.02, 0.02))
) +
theme_minimal(base_size = 12) +
theme(
plot.title = element_text(face = "bold", size = 16, hjust = 0.5),
plot.subtitle = element_text(hjust = 0.5, color = "gray30", size = 11),
panel.grid.major = element_line(color = "grey90", linewidth = 0.2),
panel.grid.minor = element_blank(),
panel.background = element_rect(fill = "white", color = NA),
plot.background = element_rect(fill = "white", color = NA),
axis.title = element_text(size = 12),
axis.text = element_text(color = "grey40"),
axis.text.x = element_text(angle = 45, hjust = 1),
plot.caption = element_text(color = "grey50", hjust = 0)
)## `geom_smooth()` using formula = 'y ~ x'
# 2. Medias móviles - CORREGIDO (usar WM2NS en lugar de Valor)
# ------------------------------------------------------------
# Renombrar columnas para mantener consistencia
names(datos)[names(datos) == "WM2NS"] <- "Valor"
names(datos)[names(datos) == "observation_date"] <- "Fecha"
# Calcular medias móviles
datos$Valor.ma <- forecast::ma(datos$Valor, order = 7)
datos$Valor30.ma <- forecast::ma(datos$Valor, order = 30)
# Gráfico de media moviles
datos_long <- datos %>%
select(Fecha,
`Serie original` = Valor,
`Media móvil semanal (7 días)` = Valor.ma,
`Media móvil mensual (30 días)` = Valor30.ma) %>%
pivot_longer(cols = -Fecha,
names_to = "Serie",
values_to = "Valor") %>%
mutate(Serie = factor(Serie, levels = c("Serie original",
"Media móvil semanal (7 días)",
"Media móvil mensual (30 días)")))
# Gráfico con facetas verticales
ggplot(datos_long, aes(x = Fecha, y = Valor, color = Serie)) +
geom_line(linewidth = 0.8) +
scale_color_manual(
values = c(
"Serie original" = "grey60",
"Media móvil semanal (7 días)" = "steelblue",
"Media móvil mensual (30 días)" = "indianred"
)
) +
facet_wrap(~ Serie, ncol = 1, scales = "free_y") + # Paneles verticales
labs(
title = "WM2NS con medias móviles",
subtitle = "Comparación de la serie original y suavizada en paneles separados",
y = "Valor de WM2NS",
x = "Fecha",
caption = "Fuente: Federal Reserve Economic Data (FRED)"
) +
theme_minimal() +
theme(
plot.title = element_text(face = "bold", size = 16, hjust = 0.5),
plot.subtitle = element_text(hjust = 0.5, color = "gray40", size = 11),
legend.position = "none", # Eliminamos la leyenda
panel.grid.major = element_line(color = "grey90", linewidth = 0.2),
panel.grid.minor = element_blank(),
axis.text.x = element_text(angle = 45, hjust = 1),
strip.text = element_text(face = "bold", size = 10),
strip.background = element_rect(fill = "grey95", color = NA)
)## Warning: Removed 36 rows containing missing values or values outside the scale range
## (`geom_line()`).
ggplot(datos) +
geom_line(aes(x = Fecha, y = Valor, color = "Serie original"),
alpha = 0.5, linewidth = 0.7) +
geom_line(aes(x = Fecha, y = Valor.ma, color = "Media móvil semanal (7 días)"),
linewidth = 1) +
geom_line(aes(x = Fecha, y = Valor30.ma, color = "Media móvil mensual (30 días)"),
linewidth = 1.2) +
scale_color_manual(
name = "Leyenda",
values = c(
"Serie original" = "grey60",
"Media móvil semanal (7 días)" = "steelblue",
"Media móvil mensual (30 días)" = "indianred"
)
) +
labs(
title = "WM2NS con medias móviles",
subtitle = "Suavización de la serie con medias móviles de 7 y 30 días",
y = "Valor de WM2NS",
x = "Fecha",
caption = "Fuente: Federal Reserve Economic Data (FRED)"
) +
theme_minimal() +
theme(
plot.title = element_text(face = "bold", size = 16, hjust = 0.5),
plot.subtitle = element_text(hjust = 0.5, color = "gray40", size = 11),
legend.position = "bottom",
legend.title = element_blank(),
panel.grid.major = element_line(color = "grey90", linewidth = 0.2),
panel.grid.minor = element_blank(),
axis.text.x = element_text(angle = 45, hjust = 1)
)## Warning: Removed 6 rows containing missing values or values outside the scale range
## (`geom_line()`).## Warning: Removed 30 rows containing missing values or values outside the scale range
## (`geom_line()`).
Descomposición de la serie de tiempo no estacionaria
# Calcular la descomposición
count_ma <- ts(na.omit(datos$Valor30.ma), frequency = 52) # Cambiado a frecuencia semanal (52 semanas/año)
# Verificar si tenemos suficientes datos
if (length(count_ma) > 0) {
decomp <- stl(count_ma, s.window = "periodic")
deseasonal_inf <- seasadj(decomp)
# Crear un data frame con los componentes
decomp_df <- data.frame(
Fecha = time(decomp$time.series) %>%
as.numeric() %>%
as.Date(origin = "1970-01-01"),
Original = as.numeric(decomp$time.series[, "trend"] +
decomp$time.series[, "seasonal"] +
decomp$time.series[, "remainder"]),
Tendencia = as.numeric(decomp$time.series[, "trend"]),
Estacionalidad = as.numeric(decomp$time.series[, "seasonal"]),
Residual = as.numeric(decomp$time.series[, "remainder"])
)
# Función para crear gráficos consistentes
crear_grafico_componente <- function(data, y_var, titulo, color) {
ggplot(data, aes(x = Fecha, y = .data[[y_var]])) +
geom_line(color = color, linewidth = 0.8) +
labs(title = titulo, y = "Valor", x = "") +
theme_minimal() +
theme(
plot.title = element_text(face = "bold", size = 12, hjust = 0.5),
panel.grid.minor = element_blank(),
axis.text.x = element_text(angle = 45, hjust = 1, size = 8)
)
}
# Crear los gráficos individuales
g1 <- crear_grafico_componente(decomp_df, "Original", "Serie Original", "black")
g2 <- crear_grafico_componente(decomp_df, "Tendencia", "Componente de Tendencia", "blue")
g3 <- crear_grafico_componente(decomp_df, "Estacionalidad", "Componente Estacional", "red")
g4 <- crear_grafico_componente(decomp_df, "Residual", "Componente Residual", "darkgreen")
plot(g1)
plot(g2)
plot(g3)
plot(g4)
# Combinar en un solo gráfico
grid.arrange(
g1, g2, g3, g4,
nrow = 4,
top = textGrob("Descomposición STL de WM2NS",
gp = gpar(fontface = "bold", fontsize = 16))
)
} else {
message("No hay suficientes datos para realizar la descomposición STL")
}
## Prueba de raiz unitaria
## Prueba de raiz unitaria
adf.test(count_ma, alternative = "stationary")##
## Augmented Dickey-Fuller Test
##
## data: count_ma
## Dickey-Fuller = -0.672, Lag order = 13, p-value = 0.9731
## alternative hypothesis: stationaryggplot(datos, aes(x = Fecha, y = Valor)) +
geom_line() +
ggtitle("Serie Original antes de ADF")
# Primera diferencia
count_ma_diff <- diff(count_ma, differences = 1)
# Volver a realizar la prueba
adf.test(na.omit(count_ma_diff), alternative = "stationary")## Warning in adf.test(na.omit(count_ma_diff), alternative = "stationary"):
## p-value smaller than printed p-value##
## Augmented Dickey-Fuller Test
##
## data: na.omit(count_ma_diff)
## Dickey-Fuller = -6.4261, Lag order = 13, p-value = 0.01
## alternative hypothesis: stationary# Diferencia estacional (ej: 52 semanas)
count_ma_seasdiff <- diff(count_ma, lag = 52)
tseries::kpss.test(count_ma)## Warning in tseries::kpss.test(count_ma): p-value smaller than printed p-value##
## KPSS Test for Level Stationarity
##
## data: count_ma
## KPSS Level = 22.125, Truncation lag parameter = 8, p-value = 0.01autoplot(ts(count_ma_diff)) +
labs(title = "Serie después de primera diferenciación",
y = "WM2NS (Diferenciado)", x = "observation_date")