knitr::opts_chunk$set(echo = TRUE, error=TRUE)

# cargamos paquetes
library(tidyverse)
## ── Attaching packages ────────────────────────────────────────────────────────────────────────────────────────────────────── tidyverse 1.3.0 ──
## ✓ ggplot2 3.3.2     ✓ purrr   0.3.4
## ✓ tibble  3.0.3     ✓ dplyr   1.0.1
## ✓ tidyr   1.1.1     ✓ stringr 1.4.0
## ✓ readr   1.3.1     ✓ forcats 0.5.0
## ── Conflicts ───────────────────────────────────────────────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()
library(patchwork)

Series de tiempo

Consideramos la ventas semanales de un producto a lo largo de 5 años, transformaremos la variable de ventas utilizando el logaritmo.

  1. Describe que observas en la gráfica.

Las ventas parecen tener un comportamiento estacional a lo largo de los años, sobre todo durante los últimos cuatro el comportamiento es más parecido. En el primer año de datos, el nivel de ventas está muy por debajo del resto. A lo largo del tiempo, se aprecia una tendencia positiva en las ventas.

ventas <- read_csv("ventas_semanal.csv")
## Parsed with column specification:
## cols(
##   period = col_double(),
##   sales.kg = col_double()
## )
head(ventas)
## # A tibble: 6 x 2
##   period sales.kg
##    <dbl>    <dbl>
## 1      1     686.
## 2      2     768.
## 3      3     895.
## 4      4     774.
## 5      5     955.
## 6      6     853.
glimpse(ventas)
## Rows: 260
## Columns: 2
## $ period   <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 1…
## $ sales.kg <dbl> 685.537, 768.234, 894.643, 773.501, 954.600, 852.853, 851.08…
ggplot(ventas, aes(x = period, y = log(sales.kg))) + 
  geom_line(size = 0.3)

Intentaremos usar suavizamiento para capturar los distintos tipos de variación que observamos en la serie.

  1. Utiliza un suavizador loess para capturar la tendencia de la serie.
ggplot(ventas, aes(x = period, y = log(sales.kg))) +
  geom_line(size = 0.3) +
  geom_smooth(method = "loess", span=0.7 , degree = 1, se = FALSE, size = 1, 
              #rellenamos span incrementando su valor hasta tener un suavizamiento apropiado
    color = "red")
## Warning: Ignoring unknown parameters: degree
## `geom_smooth()` using formula 'y ~ x'

fit_trend <- loess(log(sales.kg) ~ period, ventas, span = 0.7, degree = 1)

Aquí comprobamos que eliminamos tendencia:

ggplot(ventas, aes(x = period, y = fit_trend$residuals)) +
  geom_line(size = 0.3) + labs(y="residuales suavizamiento tendencia")

  1. Ahora calcula los residuales de este ajuste y descríbelos mediante un suavizamiento más fino. Verifica que se ha estimado la mayor parte de la tendencia, e intenta capturar la variación estacional de los residuales.
ggplot(ventas, aes(x = period, y = fit_trend$residuals)) + #+ #rellena res.trend.1
  geom_line(size = 0.3) +
  labs(y="residuales suavizamiento estacionalidad") +
  geom_smooth(method = "loess", span=0.2 , degree = 2, se = FALSE, size = 1, 
              #rellenamos span reduciendo hasta tener una mejor captura de la variación estacional
    color = "blue")  
## Warning: Ignoring unknown parameters: degree
## `geom_smooth()` using formula 'y ~ x'

fit_season <- loess(fit_trend$residuals ~ period, ventas, span = 0.2, degree = 2)
  1. Grafica los residuales obtenidos después de ajustar el componente estacional para estudiar la componente de mayor frecuencia.
ggplot(ventas, aes(x = period, y = fit_season$residuals)) + #+ #rellena res.est1.1
  geom_line(size = 0.3) +
  labs(y="residuales componente más frecuente",title = "Residuales")+
  geom_smooth(method = "loess", span=0.06 , degree = 1, se = FALSE, size = 1, 
    color = "green")  
## Warning: Ignoring unknown parameters: degree
## `geom_smooth()` using formula 'y ~ x'

fit_season_high <- loess(fit_season$residuals ~ period, ventas, span = 0.06, degree = 1)
  1. Extra opcional. Ahora que tenemos nuestra primera estimación de cada una de las componentes, podemos regresar a hacer una mejor estimación de la tendencia. La ventaja de volver es que ahora podemos suavizar más sin que en nuestra muestra compita tanto la variación estacional. Por tanto puedes suavizar un poco menos.

Probamos bajando el valor de span (de 0.7 a 0.4) para suavizar un poco menos

ggplot(ventas, aes(x = period, y = log(sales.kg))) +
  geom_line(size = 0.3) +
  geom_smooth(method = "loess", span=0.4 , degree = 1, se = FALSE, size = 1, 
              #rellenamos span incrementando su valor hasta tener un suavizamiento apropiado
    color = "red")
## Warning: Ignoring unknown parameters: degree
## `geom_smooth()` using formula 'y ~ x'

fit_trend_2 <- loess(log(sales.kg) ~ period, ventas, span = 0.4, degree = 1)

ggplot(ventas, aes(x = period, y = fit_trend_2$residuals)) +
  geom_line(size = 0.3) + labs(y="residuales suavizamiento tendencia")

ggplot(ventas, aes(x = period, y = fit_trend_2$residuals)) + #+ #rellena res.trend.1
  geom_line(size = 0.3) +
  labs(y="residuales suavizamiento estacionalidad") +
  geom_smooth(method = "loess", span=0.2 , degree = 2, se = FALSE, size = 1, 
              #rellenamos span reduciendo hasta tener una mejor captura de la variación estacional
    color = "blue")  
## Warning: Ignoring unknown parameters: degree
## `geom_smooth()` using formula 'y ~ x'

fit_season_2 <- loess(fit_trend_2$residuals ~ period, ventas, span = 0.2, degree = 2)
ggplot(ventas, aes(x = period, y = fit_season_2$residuals)) + #+ #rellena res.est1.1
  geom_line(size = 0.3) +
  labs(y="residuales componente más frecuente",title = "Residuales")+
  geom_smooth(method = "loess", span=0.06 , degree = 1, se = FALSE, size = 1, 
    color = "green")  
## Warning: Ignoring unknown parameters: degree
## `geom_smooth()` using formula 'y ~ x'

fit_season_high_2 <- loess(fit_season$residuals ~ period, ventas, span = 0.06, degree = 1)

Y luego comparamos residuales de ambas estimaciones:

res_est1<-ggplot(ventas, aes(x = period, y = fit_season_high$residuals)) +
  geom_line(size = 0.3)+
  geom_smooth(method = "loess", span = 0.06, color="orange",
                method.args = list(degree=1, family = "symmetric"))
res_est2<-ggplot(ventas, aes(x = period, y = fit_season_high_2$residuals))+
  geom_line(size = 0.3)+
  geom_smooth(method = "loess", span = 0.06, color="orange",
                method.args = list(degree=1, family = "symmetric"))
res_est1+res_est2
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'

  1. Visualiza el ajuste, genera una gráfica de páneles, en cada uno muestra una componente de la serie de tiempo y los residuales.

Primero guardamos nuestras estimaciones en un dataset

estimaciones<-ventas  %>%
  mutate(logventas=log(ventas$sales.kg),tendencia=fit_trend_2$fitted,estacionalidad=fit_season_2$fitted,masfrecuente=fit_season_high_2$fitted,residuales=fit_season_high_2$residuals)

head(estimaciones)
## # A tibble: 6 x 7
##   period sales.kg logventas tendencia estacionalidad masfrecuente residuales
##    <dbl>    <dbl>     <dbl>     <dbl>          <dbl>        <dbl>      <dbl>
## 1      1     686.      6.53      6.73        -0.0819    -0.00435    -0.112  
## 2      2     768.      6.64      6.73        -0.0690     0.000909   -0.0204 
## 3      3     895.      6.80      6.74        -0.0566     0.00413     0.112  
## 4      4     774.      6.65      6.74        -0.0449     0.00701    -0.0524 
## 5      5     955.      6.86      6.75        -0.0339     0.00884     0.141  
## 6      6     853.      6.75      6.75        -0.0235     0.0121      0.00988
desc_serietiempo<- estimaciones %>%
  select(period,tendencia,estacionalidad,masfrecuente,residuales) %>%
  mutate(ajuste_centrado = tendencia - mean(tendencia)) %>%
  gather(componente, valor, estacionalidad:ajuste_centrado) %>%
  mutate(componente=recode(componente,ajuste_centrado="Tendencia",estacionalidad="Estacionalidad",masfrecuente="Componente Más Frecuente",
                           residuales="Residual")) %>%
  mutate(componente = fct_relevel(componente, "Tendencia", "Estacionalidad","Componente Más Frecuente", "Residual"))
## Warning: attributes are not identical across measure variables;
## they will be dropped
#summary(desc_serietiempo)

ggplot(desc_serietiempo, aes(x = period, y = valor,colour = componente)) +
    facet_wrap(~ componente,  ncol = 1) +
    geom_point(size=0.5)

  1. Genera una gráfica de cuantiles para los residuales.
ggplot(ventas, aes(sample = fit_trend_2$residuals)) +
  geom_qq(distribution = stats::qunif) +
  labs(y="Residuales",x="",title="Gráfica de cuantiles para Residuales de Tendencia")

ggplot(ventas, aes(sample = fit_season_2$residuals)) +
  geom_qq(distribution = stats::qunif) +
  labs(y="Residuales",x="",title="Gráfica de cuantiles para Residuales de Componente Estacional")

ggplot(ventas, aes(sample = fit_season_high_2$residuals)) +
  geom_qq(distribution = stats::qunif) +
  labs(y="Residuales",x="",title="Gráfica de cuantiles para Residuales de Componente Más Frecuente")