Ejercicios gráficas y transformaciones

library(tidyverse)

── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.1.4     ✔ readr     2.1.5
✔ forcats   1.0.0     ✔ stringr   1.5.1
✔ ggplot2   3.4.4     ✔ tibble    3.2.1
✔ lubridate 1.9.3     ✔ tidyr     1.3.0
✔ purrr     1.0.2     
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(fpp3)

── Attaching packages ────────────────────────────────────────────── fpp3 0.5 ──
✔ tsibble     1.1.3     ✔ fable       0.3.3
✔ tsibbledata 0.4.1     ✔ fabletools  0.3.4
✔ feasts      0.3.1     
── Conflicts ───────────────────────────────────────────────── fpp3_conflicts ──
✖ lubridate::date()    masks base::date()
✖ dplyr::filter()      masks stats::filter()
✖ tsibble::intersect() masks base::intersect()
✖ tsibble::interval()  masks lubridate::interval()
✖ dplyr::lag()         masks stats::lag()
✖ tsibble::setdiff()   masks base::setdiff()
✖ tsibble::union()     masks base::union()

library(ggplot2)

global_economy

# A tsibble: 15,150 x 9 [1Y]
# Key:       Country [263]
   Country     Code   Year         GDP Growth   CPI Imports Exports Population
   <fct>       <fct> <dbl>       <dbl>  <dbl> <dbl>   <dbl>   <dbl>      <dbl>
 1 Afghanistan AFG    1960  537777811.     NA    NA    7.02    4.13    8996351
 2 Afghanistan AFG    1961  548888896.     NA    NA    8.10    4.45    9166764
 3 Afghanistan AFG    1962  546666678.     NA    NA    9.35    4.88    9345868
 4 Afghanistan AFG    1963  751111191.     NA    NA   16.9     9.17    9533954
 5 Afghanistan AFG    1964  800000044.     NA    NA   18.1     8.89    9731361
 6 Afghanistan AFG    1965 1006666638.     NA    NA   21.4    11.3     9938414
 7 Afghanistan AFG    1966 1399999967.     NA    NA   18.6     8.57   10152331
 8 Afghanistan AFG    1967 1673333418.     NA    NA   14.2     6.77   10372630
 9 Afghanistan AFG    1968 1373333367.     NA    NA   15.2     8.90   10604346
10 Afghanistan AFG    1969 1408888922.     NA    NA   15.0    10.1    10854428
# ℹ 15,140 more rows

¿Cómo ha sido la evolución de la economía de los países en el tiempo?

La economía ha presentado un crecimiento exponencial, que detonó entre los 1980 y los 2000, presentando ya una aceleración mayor después de los 2000.

¿Cuál país tiene el mayor PIB per cápita?

Monaco

global_economy |>
  autoplot(GDP/Population) +
  theme(legend.position = "none")

Warning: Removed 3242 rows containing missing values (`geom_line()`).

global_economy |>
  mutate(gdp_per_capita = GDP/Population) |> #Compute GDP per capita
  select(-c(Code, Growth:Exports)) |> #remover columnas
  filter(Year %in% 2010:2017) |>
  as_tibble() |>
  group_by(Country) |>
  summarise(mean_gdppc = mean(gdp_per_capita, na.rm = TRUE)) |>
  arrange(desc(mean_gdppc))

# A tibble: 263 × 2
   Country          mean_gdppc
   <fct>                 <dbl>
 1 Monaco              163978.
 2 Liechtenstein       162023.
 3 Luxembourg          108327.
 4 Norway               88913.
 5 Bermuda              86347.
 6 Switzerland          82544.
 7 Isle of Man          80996.
 8 Macao SAR, China     76201.
 9 Qatar                75931.
10 Australia            59099.
# ℹ 253 more rows

global_economy

# A tsibble: 15,150 x 9 [1Y]
# Key:       Country [263]
   Country     Code   Year         GDP Growth   CPI Imports Exports Population
   <fct>       <fct> <dbl>       <dbl>  <dbl> <dbl>   <dbl>   <dbl>      <dbl>
 1 Afghanistan AFG    1960  537777811.     NA    NA    7.02    4.13    8996351
 2 Afghanistan AFG    1961  548888896.     NA    NA    8.10    4.45    9166764
 3 Afghanistan AFG    1962  546666678.     NA    NA    9.35    4.88    9345868
 4 Afghanistan AFG    1963  751111191.     NA    NA   16.9     9.17    9533954
 5 Afghanistan AFG    1964  800000044.     NA    NA   18.1     8.89    9731361
 6 Afghanistan AFG    1965 1006666638.     NA    NA   21.4    11.3     9938414
 7 Afghanistan AFG    1966 1399999967.     NA    NA   18.6     8.57   10152331
 8 Afghanistan AFG    1967 1673333418.     NA    NA   14.2     6.77   10372630
 9 Afghanistan AFG    1968 1373333367.     NA    NA   15.2     8.90   10604346
10 Afghanistan AFG    1969 1408888922.     NA    NA   15.0    10.1    10854428
# ℹ 15,140 more rows

Grafique las siguientes series de tiempo y transfórmelas y/o ajústelas si lo considera necesario. ¿Qué efecto tuvo la transformación?

En la primera gráfica apliqué una transformación logarítmica que me permitió ver la gráfica más parecido a una recta.
En la segunda apliqué Box-Cox con lambda = 0.1, ya que fue la que acomodaba la gráfica de una forma más recta.
En la tercera gráfica apliqué una descomposición que aparentemente no fue la mejor, pues ninguna de las transformaciones que apliqué me dio a entender muy bien el contenido de la tabla.
En la última gráfica apliqué una Box-Cox con lambda = 1, que permitió ver la gráfica con una línea recta, y una estacionalidad un poco variable pero dentro de un rango razonable.

¿Es útil realizar una transformación de Box-Cox a los datos canadian_gas? ¿Por qué sí o por qué no?

Sí resultó útil, ya que nos permite observar la tendencia que estaba un poco viciada por la estacionalidad, la cual ahora es muy evidente.

—– PIB Estados Unidos ———

PIB_USA = global_economy |>
  mutate(log(GDP)) |>
  filter(Country == "United States") |>
  select(-c(Code, GDP:Population)) 
  

autoplot(PIB_USA)

Plot variable not specified, automatically selected `.vars = log(GDP)`

PIB_USA

# A tsibble: 58 x 3 [1Y]
# Key:       Country [1]
   Country        Year `log(GDP)`
   <fct>         <dbl>      <dbl>
 1 United States  1960       27.0
 2 United States  1961       27.1
 3 United States  1962       27.1
 4 United States  1963       27.2
 5 United States  1964       27.3
 6 United States  1965       27.3
 7 United States  1966       27.4
 8 United States  1967       27.5
 9 United States  1968       27.6
10 United States  1969       27.7
# ℹ 48 more rows

—- PIB México ———

PIB_MEX = global_economy |>
  filter(Country == "Mexico") |>
  select(-c(Code, Growth:Population))

BoxCox_MEX = global_economy |>
  filter(Country == "Mexico") |>
  select(-c(Code,Growth:Population)) |>
  autoplot(box_cox(GDP, lambda = 0.1))

BoxCox_MEX

—- Demanda de electricidad en el estado de Victoria (Australia) ———

DEM_VIC <- vic_elec |>
  autoplot(Demand)

ELEC_VIC_Decomp <- vic_elec |> 
  model(
    clasica = classical_decomposition(Demand, 
                                      type = "additive")
  )

elec_components <- ELEC_VIC_Decomp |> 
  components()

elec_components

# A dable: 52,608 x 7 [30m] <Australia/Melbourne>
# Key:     .model [1]
# :        Demand = trend + seasonal + random
   .model  Time                Demand trend seasonal  random season_adjust
   <chr>   <dttm>               <dbl> <dbl>    <dbl>   <dbl>         <dbl>
 1 clasica 2012-01-01 00:00:00  4383.   NA      1.49  NA             4381.
 2 clasica 2012-01-01 00:30:00  4263. 4240.    -1.49  25.2           4265.
 3 clasica 2012-01-01 01:00:00  4049. 4060.     1.49 -12.2           4047.
 4 clasica 2012-01-01 01:30:00  3878. 3960.    -1.49 -81.0           3879.
 5 clasica 2012-01-01 02:00:00  4036. 3954.     1.49  80.8           4035.
 6 clasica 2012-01-01 02:30:00  3866. 3865.    -1.49   1.71          3867.
 7 clasica 2012-01-01 03:00:00  3694. 3704.     1.49 -11.2           3693.
 8 clasica 2012-01-01 03:30:00  3562. 3563.    -1.49   0.522         3563.
 9 clasica 2012-01-01 04:00:00  3433. 3447.     1.49 -15.2           3432.
10 clasica 2012-01-01 04:30:00  3359. 3371.    -1.49  -9.87          3361.
# ℹ 52,598 more rows

elec_components |> 
  autoplot()

Warning: Removed 1 row containing missing values (`geom_line()`).

—- Canadian Gas ———

canadian_gas

# A tsibble: 542 x 2 [1M]
      Month Volume
      <mth>  <dbl>
 1 1960 Jan  1.43 
 2 1960 Feb  1.31 
 3 1960 Mar  1.40 
 4 1960 Apr  1.17 
 5 1960 May  1.12 
 6 1960 Jun  1.01 
 7 1960 Jul  0.966
 8 1960 Aug  0.977
 9 1960 Sep  1.03 
10 1960 Oct  1.25 
# ℹ 532 more rows

Volumen_normal <- canadian_gas |>
  autoplot(Volume) + 
  ggtitle("Producción de gas (datos reales)")

#prueba_menos0.5 <- canadian_gas |>
  #autoplot(box_cox(Volume, lambda = -0.5)) +
  #ggtitle("Box-Cox, lambda = -0.5")

#prueba_0 <- canadian_gas |>
  #autoplot(box_cox(Volume, lambda = 0)) +
  #ggtitle("Box-Cox, lambda = (0)")

#prueba_0.1 <- canadian_gas |>
  #autoplot(box_cox(Volume, lambda = 0.1)) +
  #ggtitle("Box-Cox, lambda = 0.1")

prueba_1 = canadian_gas |>
  autoplot(box_cox(Volume, lambda = 1)) +
  ggtitle("Box-Cox, lambda = 1")

prueba_1

El dataset fma::plastics tiene información de las ventas mensuales (medidas en miles) del producto A para un productor de plásticos, a lo largo de cinco años.

Grafique la serie de tiempo para el producto A. ¿Identifica algún componente de tendencia-ciclo y/o estacional?

Sí, existe una estacionalidad anual que tiene tendencia alcista.

Utilice una descomposición clásica multiplicativa para calcular el componente de tendencia y estacional. ¿Los resultados coinciden con su respuesta al inciso i)?

Calcule y grafique los datos desestacionalizados.

Cambie, manualmente, una observación para que sea un outlier (p. ej., sume 500 a una observación). Vuelva a estimar los datos desestacionalizados.

¿Cuál fue el efecto de ese outlier? ¿Hace alguna diferencia que el outlier se encuentre cerca del final de la serie o más alrededor del centro?

En mi caso seleccioné el primero dato para modificarlo, y el resultado fue un pico al inicio de la serie, se nota como la tendencia empieza mucho más arriba que antes, y se ve un pico en la serie original.
En la gráfica de los datos des-estacionalizados se puede ver como si tuviera dos curvas, una al inicio y una al final.

tab <- as_tsibble(fma::plastics)

Registered S3 method overwritten by 'quantmod':
  method            from
  as.zoo.data.frame zoo

tab

# A tsibble: 60 x 2 [1M]
      index value
      <mth> <dbl>
 1 0001 Jan   742
 2 0001 Feb   697
 3 0001 Mar   776
 4 0001 Apr   898
 5 0001 May  1030
 6 0001 Jun  1107
 7 0001 Jul  1165
 8 0001 Aug  1216
 9 0001 Sep  1208
10 0001 Oct  1131
# ℹ 50 more rows

Plastics_Decomp <- tab |> 
  model(
    clasica = classical_decomposition(value, 
                                      type = "multiplicative")
  )

plastics_components <- Plastics_Decomp |> 
  components()

plastics_components

# A dable: 60 x 7 [1M]
# Key:     .model [1]
# :        value = trend * seasonal * random
   .model     index value trend seasonal random season_adjust
   <chr>      <mth> <dbl> <dbl>    <dbl>  <dbl>         <dbl>
 1 clasica 0001 Jan   742   NA     0.767 NA              967.
 2 clasica 0001 Feb   697   NA     0.710 NA              981.
 3 clasica 0001 Mar   776   NA     0.777 NA              999.
 4 clasica 0001 Apr   898   NA     0.910 NA              986.
 5 clasica 0001 May  1030   NA     1.04  NA              986.
 6 clasica 0001 Jun  1107   NA     1.16  NA              957.
 7 clasica 0001 Jul  1165  977.    1.16   1.02          1001.
 8 clasica 0001 Aug  1216  977.    1.23   1.02           992.
 9 clasica 0001 Sep  1208  977.    1.23   1.00           981.
10 clasica 0001 Oct  1131  978.    1.19   0.972          951.
# ℹ 50 more rows

plastics_components |> 
  autoplot()

Warning: Removed 6 rows containing missing values (`geom_line()`).

des_est <- plastics_components |>
  autoplot((season_adjust))

des_est

tab2 <- tab |>
  mutate(valor = if_else(value == 742, 1484, value)) |>
  select(-value)

tab2

# A tsibble: 60 x 2 [1M]
      index valor
      <mth> <dbl>
 1 0001 Jan  1484
 2 0001 Feb   697
 3 0001 Mar   776
 4 0001 Apr   898
 5 0001 May  1030
 6 0001 Jun  1107
 7 0001 Jul  1165
 8 0001 Aug  1216
 9 0001 Sep  1208
10 0001 Oct  1131
# ℹ 50 more rows

Plastics_Decomp_2 <- tab2 |> 
  model(
    clasica = classical_decomposition(valor, 
                                      type = "multiplicative")
  )

plastics_components_2 <- Plastics_Decomp_2 |> 
  components()

plastics_components_2

# A dable: 60 x 7 [1M]
# Key:     .model [1]
# :        valor = trend * seasonal * random
   .model     index valor trend seasonal random season_adjust
   <chr>      <mth> <dbl> <dbl>    <dbl>  <dbl>         <dbl>
 1 clasica 0001 Jan  1484   NA     0.768 NA             1933.
 2 clasica 0001 Feb   697   NA     0.711 NA              980.
 3 clasica 0001 Mar   776   NA     0.777 NA              999.
 4 clasica 0001 Apr   898   NA     0.911 NA              986.
 5 clasica 0001 May  1030   NA     1.05  NA              985.
 6 clasica 0001 Jun  1107   NA     1.16  NA              956.
 7 clasica 0001 Jul  1165 1008.    1.16   1.00          1008.
 8 clasica 0001 Aug  1216  977.    1.23   1.01           992.
 9 clasica 0001 Sep  1208  977.    1.23   1.00           980.
10 clasica 0001 Oct  1131  978.    1.19   0.972          951.
# ℹ 50 more rows

plastics_components_2 |> 
  autoplot()

Warning: Removed 6 rows containing missing values (`geom_line()`).

des_est_2 <- plastics_components_2 |>
  autoplot((season_adjust))

des_est_2