R Markdown
Países
- Valor
Valor de todo lo exportado a cada país de destino
Valor promedio
Variabilidad del valor: agrupando por país de destino
Agrupando por valor de exportación
Agrupando países según volúmen de exportación recibida
Principales países de destino de exportación

R Markdown

Este trabajo tiene como motivo principal el mostrar ciertos recursos visuales y de análisis de datos para validar capacidades en el lenguaje de programación R. Para esta secuencia de trabajos, utilize los datos de las exportaciones realizadas por Chile entre 2010 y 2020, datos entregados por la subsecretaría de transporte como parte de un proceso de selección laboral del que forme parte entre mayo y junio del presente año.

Los datos originales fueron facilitados mediante claves de acceso a instancia de base de datos Postgres. Mediante conexión a esta información via API y luego limpieza y consolidación de los datos, procedí a enriquecer los datos mediante conexiones también via API al banco mundial para los datos de PIB y climáticos (mm de lluvia para tener algún factor demográfico para explorar), para lo cual fue necesario, realizar labores de traducción apoyándome de data externa. Posteriormente, alimente los datos con información de geolocalización para realizar proyecciones visuales con los datos de latitud y longitud adquiridos, en primaria instancia, con los vectores regionales de la biblioteca nacional, pero al confirmar cierta imprecisión en los datos, procedí a utilizar los geo-datos del INE.

El trabajo consistía en realizar proyecciones, algoritmos de predicción y de clustering, además de trabajo de exploración y presentación.

Posterior al período de entrega de ciertos requerimientos asociados a estos datos para fines de la selección laboral (4 días en primera instancia y luego 3 días más), continué explorando los datos por iniciativa propia, desarrollando variadas visualizaciones y algoritmos como parte de mi aprendizaje y luego para enseñar para futuras postulaciones a otros cargos, y en eso consiste este documento.

library(data.table)
library(ggthemes)
library(tidyverse)
library(ggthemes)
library(ggrepel)
library(gridExtra)
library(zoo)
library(ggpmisc)
library(kableExtra)
library(ggpubr)
library(stringr)
library(forcats)
library(treemapify)

library(univariateML)
library(wesanderson)
library(ggridges)
library(scales)
library(fmsb)
library(ggformula)
library(qdap)

## Rows: 2,668,403
## Columns: 27
## $ año                                <int> 2011, 2011, 2011, 2011, 2011, 20...
## $ mes                                <int> 10, 10, 10, 10, 10, 10, 10, 10, ...
## $ cod_tipo_carga_operacionexpo       <fct> F, R, R, R, R, F, R, R, R, F, F,...
## $ item_sa_operacionexpo              <int> 3041942, 3021221, 3041942, 60319...
## $ valor                              <dbl> 18311.25, 15667.26, 6023.99, 215...
## $ peso                               <dbl> 2695, 3272, 1029, 1403, 11100, 6...
## $ glosa_regionorigen                 <fct> REGIÓN DE LOS LAGOS, REGIÓN DE L...
## $ nombre_tipo_operacion              <fct> EXPORTACIÓN NORMAL, EXPORTACIÓN ...
## $ nombre_aduana                      <fct> Metropolitana, Metropolitana, Me...
## $ glosa_viatransporte                <fct> AÉREO, AÉREO, AÉREO, AÉREO, AÉRE...
## $ nombre_puerto_embarque             <fct> AEROP. A.M. BENITEZ, AEROP. A.M....
## $ tipo_puerto_embarque               <fct> Aeropuerto, Aeropuerto, Aeropuer...
## $ nombre_puerto_desembarque          <fct> OTROS PUERTOS DE PERÚ NO ESPECIF...
## $ pais_puerto_desembarque            <fct> Perú, Perú, Perú, Perú, Argentin...
## $ zona_geografica_puerto_desembarque <fct> América del Sur, América del Sur...
## $ nombre_pais                        <fct> Perú, Perú, Perú, Perú, Argentin...
## $ continente_pais                    <fct> América, América, América, Améri...
## $ ingles                             <fct> Peru, Peru, Peru, Peru, Argentin...
## $ long                               <dbl> 112.74721, 112.74721, 112.74721,...
## $ lat                                <dbl> 16.65361, 16.65361, 16.65361, 16...
## $ pib                                <dbl> 6453.561, 6453.561, 6453.561, 64...
## $ lluvia                             <int> 1738, 1738, 1738, 1738, 591, 591...
## $ lval                               <dbl> 9, 9, 8, 9, 10, 8, 8, 5, 9, 8, 1...
## $ lpes                               <dbl> 7, 8, 6, 7, 9, 6, 7, 4, 6, 7, 9,...
## $ fecha                              <fct> oct. 2011, oct. 2011, oct. 2011,...
## $ estac                              <fct> pri, pri, pri, pri, pri, pri, pr...
## $ columna                            <fct> sur, sur, sur, sur, sur, sur, su...

Se trabajara sobre una muestrs de 100.000 registros para reducir los costos computacionales.

set.seed(101)
muestra <- datos[sample(nrow(datos), 250000),]

Países

Valor

cien_ppales <- as.character(muestra[, .(.N), .(nombre_pais)][order(-N)][1:120,1][[1]])

Valor de todo lo exportado a cada país de destino

theme_set(theme_tufte())
options(device = Cairo::CairoWin)

Valor promedio

datos %>%
    .[.$nombre_pais %in% cien_ppales, .(valor_x = mean(valor)), by = .(nombre_pais)] %>%
    ggplot(aes(x=fct_reorder(nombre_pais, valor_x), y=valor_x)) +
    geom_point(aes(color = valor_x), size = 2) +
    coord_flip() +
    theme_fivethirtyeight() +
    labs(title = "Valor promedio de las exportaciones a cada país", 
         subtitle = "US$, 2010-2020") +
    theme(plot.title = element_text(size = 14)) +
    scale_color_viridis_c() +
    guides(color = F) + scale_y_continuous(breaks = seq(0,2100000, 300000))

Variabilidad del valor: agrupando por país de destino

Ahora se estudiara en detalle la variabilidad del valor de exportación agrupando por país de destino. Ya se estudio la normalidad del valor de la totalidad de las exportaciones, y ahora se explorará en mayor detalle esta variable en este nivel de granularidad superior.

100 países con mayor nº de exportaciones:

na.omit(muestra) %>% 
  .[.$nombre_pais %in% cien_ppales, .(valor), by = .(nombre_pais)] %>%
    ggplot(aes(x=fct_reorder(nombre_pais, valor), y=log(valor))) +
    geom_boxplot(aes(fill = fct_reorder(nombre_pais, valor))) +
    coord_flip() +
    theme_fivethirtyeight() +
    scale_fill_viridis_d() +
    guides(fill = F) +
    scale_x_discrete(label = function(x) stringr::str_sub(x, -22)) +
    labs(title = "Variabilidad del valor de las exportaciones por país de destino", 
         subtitle = "Muestral") +
    theme(plot.title = element_text(size = 14))

Agrupando por valor de exportación

Los 16 países con más de US350,000 de exportación promedio (promedio poblacional) Se excluye Tuvalu que cumple con la condición pero tiene una sola exportación en la muestra

Para tener una referencia, se enseña la distribución exacta (muestral) para los países que tienen mayor valor promedio de exportación.

Mayoría de países asiáticos. En Africa interesante el caso de Nigeria con más de 100 exportaciones en la muestra con varias exportaciones sobre el millon US$, y en Europa Italia, con más de 2000 exportaciones en la muestra, con varias exportaciones superando el orden de las decenas de millon de dolares (y en menor medida Suiza).
China y Japón los únicos países con varias exportaciones superando el orden de las centenas de millón de dolares -bastante más China- (En tamaño muestral, Corea del Sur cuenta con una observación de estas características)

Distribución muestral

mayor_media <- datos[, .(media = mean(valor), 
                         desv = sd(valor), .N),
                     (ingles)][order(-media)][media > 350000,][c(1:4,6:17),1][[1]] %>%
  as.character() 
a <- list()

for(i in 1:length(mayor_media)) {
  a[[i]] <- data.frame(valor = muestra[muestra$ingles== mayor_media[i], valor], 
           seq= seq_along(muestra[muestra$ingles== mayor_media[i], valor])) %>%
    ggplot() +
    geom_point(aes(seq, valor, color = valor)) +
    theme_fivethirtyeight() +
    scale_color_viridis_c() +
    labs(title = mayor_media[i]) +
    guides(color = F) +
    scale_y_continuous(label = scientific_format(digit = 1)) +
    labs(x = "", y = "")
}
ggarrange(plotlist = a)

Explorando la normalidad del logaritmo del valor de exportación

datos. <- datos[!datos$valor < 0, ]
datos.$valor <- 1.000001+ datos.$valor

na.omit(datos.) %>% .[.$ingles %in% mayor_media, .(valor = log(valor), ingles)] %>%
  ggplot() +
  geom_histogram(aes(x = valor, y =  after_stat(density)),
                 bins = 40,
                 alpha = 0.05, color = "black") +
  geom_rug(aes(x = valor)) +
  stat_function(fun = function(.x){dml(x = .x, obj = mlnorm(datos.[datos.$ingles %in% mayor_media, log(valor)]))},
                aes(color = "normal"),
                size = 1) +
  facet_wrap(~ingles, ncol = 4) +
  theme_fivethirtyeight() +
  labs(title = "Semejanza de la distribución de lo exportado con la distribución log-normal") +
  theme(plot.title = element_text(size = 12))

Variabilidad en el tiempo

5 países con mayor valor promedio

Para esta serie de gráficos elegí visualizar un grado de polinomia muy alto, no porque sea la mejor forma de ajustar la variabilidad de las observaciones, sino que permite visualizar de modo claro (por lo general) esta altamente ruidosa variable (las lineas son demasiado caóticas si se ajustan de modo exacto a los puntos, y logran capturar de modo muy poco eficiente la variabilidad en el caso de regresiones lineales). El otro ajuste que se realiza regularmente en este estudio es la regresión local de loess, que también permite una visualización “suave” de la variabilidad de esta variable en los países.

datos[ingles %in% mayor_media[1:5],
      .(valor = (mean(valor))), by = .(ingles, fecha)][, cuatrim := as.yearqtr(as.yearmon(fecha), format = "%Y-%m")] %>% 
  ggplot(aes(x = cuatrim, y = valor, color = ingles)) +
  stat_smooth(aes(y = valor), method = "lm",
              formula = y ~ poly(x, 21), se = FALSE, size = 1.5) + scale_color_tableau() +
  labs(title = "Evolución (polinomial) del valor promedio de las exportaciones")+
  theme_tufte() +
  theme(plot.title = element_text(size = 12))

Namibia rome con la escala por tener un trimestre con un valor de exportación promedio totalmente atípico.

Caso Namibia

En namibia se observa gran variabilidad en el valor de exportación, superior al resto, y particularmente llamativo como crece en los primeros trimestres de 2010 y posiblemente el mismo periodo de 2011. Año 2010:

datos[ingles == "Namibia" & año == "2010", .(valor = mean(valor)), .(mes, fecha)][order(mes)]

##    mes     fecha     valor
## 1:   1 ene. 2010   6790.00
## 2:   2 feb. 2010   1550.00
## 3:   3 mar. 2010 229046.92
## 4:   4 abr. 2010   4170.00
## 5:   5 may. 2010   5896.68
## 6:   6 jun. 2010   1550.00
## 7:   7 jul. 2010   1579.44
## 8:   8 ago. 2010   1487.18

-El mes de Marzo fue excepcionalmente alto, y totalmente atipico al resto de los meses. Esta irregularidad no persiste a lo largo del trimestre.

Año 2011:

datos[ingles == "Oman" & año == "2011", .(valor = mean(valor)), .(mes, fecha)][order(mes)]

##     mes     fecha       valor
##  1:   1 ene. 2011  984564.600
##  2:   2 feb. 2011 1191853.000
##  3:   3 mar. 2011   62497.476
##  4:   4 abr. 2011  144935.211
##  5:   5 may. 2011    7019.605
##  6:   6 jun. 2011   19043.323
##  7:   7 jul. 2011   38778.351
##  8:   8 ago. 2011   24069.000
##  9:   9 sep. 2011  350956.000
## 10:  10 oct. 2011 1435774.810
## 11:  11 nov. 2011 1723277.070
## 12:  12 dic. 2011 1878359.640

En 2012 se observa gran variabilidad entre los meses (y entre los trimestres). Particularmente alto el ultimo trimestre del año

datos[ingles == "Oman" & año == "2012", .(valor = mean(valor)), .(mes, fecha)][order(mes)]

##     mes     fecha      valor
##  1:   1 ene. 2012   30963.62
##  2:   2 feb. 2012  780184.95
##  3:   3 mar. 2012  147724.67
##  4:   4 abr. 2012  213043.42
##  5:   5 may. 2012   81056.57
##  6:   6 jun. 2012   54552.19
##  7:   7 jul. 2012   16346.07
##  8:   8 ago. 2012  635098.80
##  9:   9 sep. 2012  320654.40
## 10:  10 oct. 2012  211519.20
## 11:  11 nov. 2012 1581485.00
## 12:  12 dic. 2012 1164185.00

En 2012 se reduce vuelven mas homogeneos los meses, pero tambien se puee observar un claro repunte a fines de 2012, no observable en la curva polinomial.

datos[ingles == "Namibia",
      .(valor = (mean(valor))), by = .(ingles, fecha)][, cuatrim := as.yearqtr(as.yearmon(fecha), format = "%Y-%m")] %>% 
  ggplot(aes(x = cuatrim, y = valor, color = valor)) +
  geom_point() + 
  scale_color_viridis_c() +
  stat_smooth(aes(y = valor), method = "lm",
              formula = y ~ poly(x, 21), se = FALSE, alpha = 6) +
  labs(title = "Ajuste polinomial del valor trimestral de exportación media de Namibia")+
  theme_tufte() +
  theme(plot.title = element_text(size = 12)) +
  guides(color = F)

La variabilidad de los primeros meses se exagera enormemente, llegando a numeros logaritmicos totalmente irreales como el exponencial de 80 (tiene 34 ceros…).

Limitando el rango de valores posibles se logra un ajuste mas realista, pero bastante menos suave:

datos[ingles == "Namibia",
      .(valor = (mean(valor))), by = .(ingles, fecha)][, cuatrim := as.yearqtr(as.yearmon(fecha), format = "%Y-%m")] %>% 
  ggplot(aes(x = cuatrim, y = log(valor), color = valor)) +
  geom_point() + 
  scale_color_viridis_c() +
  stat_smooth(aes(y = log(valor)), method = "lm",
              formula = y ~ poly(x, 23), se = FALSE, alpha = 6) +
  labs(title = "El (des)ajuste polinomial del valor trimestral de exportación media de Oman")+
  theme_tufte() +
  theme(plot.title = element_text(size = 12)) +
  guides(color = F) + scale_y_continuous(limits = c(0,30))

Ajuste polinomial del valor promedio mensual de las exportaciones de Namibia

d <- datos[ingles == "Namibia", .(media = mean(valor)), 
           .(mes, año, fecha)][order(año,mes)][, del_prom_prom := percent(media/mean(media))]

d %>% 
  ggplot(aes(as.yearmon(fecha),log(media), group = 1)) + 
  geom_point() + 
  stat_smooth(aes(y = log(media)), 
              method = "lm",
              formula = y ~ poly(x, 21), 
              se = FALSE, size = 1.5) + 
  theme_tufte() + 
  theme(axis.text.x  = element_text(angle = 90)) +
  labs(title = "Evolución del valor logarítmico de las exportaciones de Namibia",
       x = "", y="")+ 
  scale_y_continuous(limits = c(0,30))

El ajuste mensual es bastante mas acertado.

Quitando Namibia para estudiar con mayor claridad del resto de los países:

datos[ingles %in% mayor_media[2:6],
      .(valor = (mean(valor))), by = .(ingles, fecha)][, cuatrim := as.yearqtr(as.yearmon(fecha), format = "%Y-%m")] %>% 
  ggplot(aes(x = cuatrim, y = valor, color = ingles)) +
  stat_smooth(aes(y = valor), method = "lm",
              formula = y ~ poly(x, 21), se = FALSE, size = 1.5) + scale_color_tableau() +
  labs(title = "Evolución (polinomial) del valor promedio de las exportaciones")+
  theme_tufte() +
  theme(plot.title = element_text(size = 12))

(Se agrega Japón) Ahora es Bulgaria quien tiene los mayores valores de exportación. Hay una tendencia persistente de la India a la baja. China pareciera estable con una leve tendencia a la baja, y corea del sur estable.

Quitando Bulgaria para estudiar las tendencias negativas de la India y la China.

datos[ingles %in% mayor_media[3:7],
      .(valor = (mean(valor))), by = .(ingles, fecha)][, cuatrim := as.yearqtr(as.yearmon(fecha), format = "%Y-%m")] %>% 
  ggplot(aes(x = cuatrim, y = valor, color = ingles)) +
  stat_smooth(aes(y = valor), method = "lm",
              formula = y ~ poly(x, 21), se = FALSE, size = 1.5) + scale_color_tableau() +
  labs(title = "Evolución (polinomial) del número de exportaciones hacia USA y China 2010 a 2020")+
  theme_tufte() +
  theme(plot.title = element_text(size = 12))

(Se agrega Taiwan) Ahora se vuelve mas clara la persistente tendencia negativa de la India, y un poco mas clara cierta tendencia a la baja de China. Para todos los países pareciera haber un “peak” a fines de 2010-inicios de 2011.

Segundo subgrupo de los 16 países con mayor valor

datos[ingles %in% mayor_media[8:12],
      .(valor = (mean(valor))), by = .(ingles, fecha)][, cuatrim := as.yearqtr(as.yearmon(fecha), format = "%Y-%m")] %>% 
  ggplot(aes(x = cuatrim, y = valor, color = ingles)) +
  stat_smooth(aes(y = valor), method = "lm",
              formula = y ~ poly(x, 21), se = FALSE, size = 1.5) + scale_color_tableau() +
  labs(title = "Evolución (polinomial) del número de exportaciones hacia USA y China 2010 a 2020")+
  theme_tufte() +
  theme(plot.title = element_text(size = 12))

En este segundo grupo es Oman quien tiene valores atípicos también entre 2010 y 2011 y luego a fines de 2020 una tendencia bastante alarmante.

Caso Oman

Año 2010:

datos[ingles == "Oman" & año == "2010", .(valor = mean(valor)), .(mes, fecha)][order(mes)]

##    mes     fecha       valor
## 1:   1 ene. 2010 1878115.120
## 2:   2 feb. 2010   50715.747
## 3:   3 mar. 2010  123338.577
## 4:   4 abr. 2010   36734.707
## 5:   5 may. 2010   43180.685
## 6:   6 jun. 2010   16733.297
## 7:   7 jul. 2010  548851.238
## 8:   8 ago. 2010    4927.556

-Efectivamente el mes de enero fue excepcionalmente alto. La alza fue solo en este mes -no persistió a lo largo del trimestre. Esto, sumado a un segundo trimestre persistentemente muy flojo.

Año 2011:

datos[ingles == "Oman" & año == "2011", .(valor = mean(valor)), .(mes, fecha)][order(mes)]

##     mes     fecha       valor
##  1:   1 ene. 2011  984564.600
##  2:   2 feb. 2011 1191853.000
##  3:   3 mar. 2011   62497.476
##  4:   4 abr. 2011  144935.211
##  5:   5 may. 2011    7019.605
##  6:   6 jun. 2011   19043.323
##  7:   7 jul. 2011   38778.351
##  8:   8 ago. 2011   24069.000
##  9:   9 sep. 2011  350956.000
## 10:  10 oct. 2011 1435774.810
## 11:  11 nov. 2011 1723277.070
## 12:  12 dic. 2011 1878359.640

Para tener una referencia se estudia el año 2011. Se logra identificar la segunda alza a fines de 2011, que a pesar de que viene antecedida por un trimestre muy flojo, el algoritmo polinomial no refleja este fenómeno con tanta fuerza como el anterior.

datos[ingles == "Oman",
      .(valor = (mean(valor))), by = .(ingles, fecha)][, cuatrim := as.yearqtr(as.yearmon(fecha), format = "%Y-%m")] %>% 
  ggplot(aes(x = cuatrim, y = valor, color = valor)) +
  geom_point() + 
  scale_color_viridis_c() +
  stat_smooth(aes(y = valor), method = "lm",
              formula = y ~ poly(x, 21), se = FALSE, alpha = 6) +
  labs(title = "El (des)ajuste polinomial del valor trimestral de exportación media de Oman")+
  theme_tufte() +
  theme(plot.title = element_text(size = 12)) +
  guides(color = F)

Nota: Puede que el ajuste polinomial, incluso a grado 21, sea insuficiente para capturar variabilidad inter-trimestral significativa del valor de exportacion de los países en el tiempo.

Ajuste de loess para la variabilidad del valor logarítmico:

datos[ingles == "Oman",
      .(valor = (mean(valor))), by = .(ingles, fecha)][, cuatrim := as.yearqtr(as.yearmon(fecha), format = "%Y-%m")] %>% 
  ggplot(aes(x = cuatrim, y = log(valor), color = valor)) +
  geom_point() + 
  scale_color_viridis_c() +
  stat_smooth(se = FALSE, alpha = 6) +
  labs(title = "Ajuste de loess del valor logarítmico trimestral de exportación media de Oman")+
  theme_tufte() +
  theme(plot.title = element_text(size = 12)) +
  guides(color = F)

A nivel de variabilidad mensual

d <- datos[ingles == "Oman", .(media = mean(valor)), 
           .(mes, año, fecha)][order(año,mes)][, del_prom_prom := percent(media/mean(media))]

d %>% 
  ggplot(aes(as.yearmon(fecha),log(media), group = 1)) + 
  geom_point() + 
  stat_smooth(aes(y = log(media)), 
              method = "lm",
              formula = y ~ poly(x, 21), 
              se = FALSE, size = 1.5) + 
  theme_tufte() + 
  theme(axis.text.x  = element_text(angle = 90)) +
  labs(title = "Evolución del valor logarítmico de las exportaciones de Oman",
       x = "", y="")

La curva no logra capturar la amplitud de la variación de Oman. Hay mucha variabilidad y esta es bastate cíclica, lo que imposibilita un ajuste que sea capaz de capturar una gran parte de la variabilidad total (que no quiere decir que sea un mal ajuste).

Quitando Oman:

datos[ingles %in% mayor_media[c(8:10, 12:13)],
      .(valor = (mean(valor))), by = .(ingles, fecha)][, cuatrim := as.yearqtr(as.yearmon(fecha), format = "%Y-%m")] %>% 
  ggplot(aes(x = cuatrim, y = valor, color = ingles)) +
  stat_smooth(aes(y = valor), method = "lm",
              formula = y ~ poly(x, 21), se = FALSE, size = 1.5) + scale_color_tableau() +
  labs(title = "Evolución (polinomial gº21) del promedio de valor trimestral de las exportaciones")+
  theme_tufte() +
  theme(plot.title = element_text(size = 12))

(Agregando Pakistan) Ahora se puede apreciar alta variabilidad, dificil lograr discernir que esta ocurriendo exactamente con cada país, pero Italia muestra tendencia negativa y Pakistan una tendencia al alza (con valores tan pequeños que la tendencia polinomial enseña importantes valores negativos)

Caso Pakistán:

datos[ingles == "Pakistan" & año == "2010", .(valor = mean(valor)), .(mes, fecha)][order(mes)]

##    mes     fecha     valor
## 1:   1 ene. 2010 151264.70
## 2:   2 feb. 2010 125729.49
## 3:   3 mar. 2010 100221.81
## 4:   4 abr. 2010  64595.26
## 5:   5 may. 2010  24617.66
## 6:   6 jun. 2010  96236.76
## 7:   7 jul. 2010 290458.37
## 8:   8 ago. 2010 369347.85
## 9:   9 sep. 2010 212058.65

Hay una baja durísima en el segundo trimestre de Pakistan. La curva polinomial “exagera” tal caida (llega a niveles de -1mmUS$), pero pareciera ser un hallazgo (baja bastante desde el primer trimestra y sube bastante en el tercero).

¿Ocurrirá lo mismo con otros años?

datos[ingles == "Pakistan" & año == "2011", .(valor = mean(valor)), .(mes, fecha)][order(mes)]

##     mes     fecha      valor
##  1:   1 ene. 2011  116862.60
##  2:   2 feb. 2011   51138.67
##  3:   3 mar. 2011  115031.33
##  4:   4 abr. 2011  105052.83
##  5:   5 may. 2011  268074.92
##  6:   6 jun. 2011  117014.63
##  7:   7 jul. 2011  354356.88
##  8:   8 ago. 2011 1308546.65
##  9:   9 sep. 2011  561237.30
## 10:  10 oct. 2011  909654.40
## 11:  11 nov. 2011   35471.60
## 12:  12 dic. 2011   90072.00

Es probable que sea un efecto aislado. Hay bastante ruido en el promedio de valor para los distintos meses.

Mirando el detalle del valor promedio de exportación mensual:

d <- datos[ingles == "Pakistan", .(media = mean(valor)), 
           .(mes, año, fecha)][order(año,mes)][, del_prom_prom := percent(media/mean(media))]

d %>% 
  ggplot(aes(as.yearmon(fecha),log(media), group = 1)) + 
  geom_point() + 
  stat_smooth(aes(y = log(media)), 
              method = "lm",
              formula = y ~ poly(x, 21), 
              se = FALSE, size = 1.5) + 
  theme_tufte() + 
  theme(axis.text.x  = element_text(angle = 90)) +
  labs(title = "Evolución del valor logarítmico de las exportaciones de Pakistan",
       x = "", y="")

Pareciera deberse a un encadenado casual de meses basante flojos, dado que hay muchisima variabilidad en la data (Y se puede esperar tener meses así de flojos cada cierto tiempo de Pakistán)

d <- list(Pakistan = datos[ingles == "Pakistan", .(suma = sum(valor)), 
                           .(año)][order(suma)][, del_total := percent(suma/sum(suma))])
print(d)

## $Pakistan
##      año     suma del_total
##  1: 2010  5480539   2.7947%
##  2: 2020  7405404   3.7763%
##  3: 2011 10288298   5.2464%
##  4: 2016 16405878   8.3660%
##  5: 2015 16825805   8.5801%
##  6: 2012 16832464   8.5835%
##  7: 2013 20805142  10.6093%
##  8: 2019 20812168  10.6129%
##  9: 2017 22966715  11.7116%
## 10: 2014 24862613  12.6784%
## 11: 2018 33417387  17.0408%

Efectivamente el año 2010 fue el más bajo.

Sería intersante si, para Pakistan, el año 2010 fue notoriamente mas bajo que para el resto de los países, porque hay que notar que el año 2010 esta incompleto en la data.

d2 <- list(resto_del_mundo = datos[, .(suma = sum(valor)),
                                   .(año)][order(suma)][, del_total := percent(suma/sum(suma))])
print(d2)

## $resto_del_mundo
##      año        suma del_total
##  1: 2020 22066582723    3.238%
##  2: 2010 47559300410    6.980%
##  3: 2015 57982073719    8.509%
##  4: 2016 58542037963    8.592%
##  5: 2017 64342015459    9.443%
##  6: 2019 66540284424    9.765%
##  7: 2014 70287942640   10.315%
##  8: 2018 71608029852   10.509%
##  9: 2013 72450188278   10.633%
## 10: 2012 73817647682   10.833%
## 11: 2011 76190380071   11.182%

rbind(reshape2::melt(d), reshape2::melt(d2))[variable == "año"] %>%
  ggplot(aes(as.factor(value), 
             as.numeric(sub("%", "",del_total))/100, 
             fill = L1, 
             group = L1)) + 
  geom_bar(position = "dodge", stat = "identity") + 
  theme_minimal() +
  scale_fill_tableau(palette = "Classic Green-Orange 12") + 
  labs(title = "¿Es el año 2010 de Pakistan realmente atípico?", x = "", y ="") +
  scale_y_continuous(labels = percent, breaks = seq(.03, .18, .03)) +
  theme(legend.position = "bottom")

No pareciera ser realmente un año desastroso para Pakistan, es probable que la curva polinomial castigue en exceso a Pakistan (tomando como referencia el resto del mundo, aunque tampoco se aprecia algo tan anormal mirando los años por separado), aunque si se alcanza a ver mayor irregularidad que la del resto de los países.
En la gráfica donde se detectó la irregularidad de Pakistán, también fue posible observar irregularidad de Nigeria y Bahrain, pero bastante inferior.

d3 <- list(datos[ingles == "Pakistan" | ingles == "Nigeria" | ingles == "Bahrain", .(suma = sum(valor)), 
                           .(año, ingles)][order(suma)][, del_total := percent(suma/sum(suma)), .(ingles)])
d3 <- as.data.table(d3)

dato_3p <- split(d3, d3$ingles)[split(d3, d3$ingles) %>% 
                       sapply(., function(y) dim(y)[1] >0)]

n_ <- rbind(reshape2::melt(dato_3p)[,2:5], reshape2::melt(d2))[variable == "año"]
n_$L1 <- factor(n_$L1, levels = c("Pakistan", "resto_del_mundo", "Bahrain", "Nigeria"))
n_ %>%
  ggplot(aes(as.factor(value), 
             as.numeric(sub("%", "",del_total))/100, 
             fill = L1, 
             group = L1)) + 
  geom_bar(position = "dodge", stat = "identity") + 
  theme_minimal() +
  scale_fill_tableau("Classic Green-Orange 12") + 
  labs(title = "Pakista comparado a Bahrain, Nigeria y el resto de los países", subtitle = "Que % de todo lo exportado entre 2010 y 2020 le corresponde a cada año/Por país", x = "", y = "") +
  scale_y_continuous(labels = percent, breaks = seq(.03, .18, .03)) +
  theme(legend.position = "bottom")

Vaya. De echo es Bahrain el país que tiene datos realmente variación extrema desde 2010-2011 hacia 2012. Este salto si se captura en la gráfica polinomial, pero la regresión polinomial captura una variabilidad mas extrema en el caso de Pakistan.

datos[ingles %in% mayor_media[c(10, 12:13)],
      .(valor = (mean(valor))), by = .(ingles, fecha)][, cuatrim := as.yearqtr(as.yearmon(fecha), format = "%Y-%m")] %>% 
  ggplot(aes(x = cuatrim, y = valor, color = ingles)) +
  stat_smooth(aes(y = valor), method = "lm",
              formula = y ~ poly(x, 21), se = FALSE, size = 1.5) + scale_color_tableau() +
  labs(title = "Evolución (polinomial) del número de exportaciones hacia USA y China 2010 a 2020")+
  theme_tufte() +
  theme(plot.title = element_text(size = 12))

En fin. Tal vez sea mejor explorar la curva de loess para ver si captura correctamente este fenómeno.

Ajuste de loess vs el polinómico

datos[ingles %in% mayor_media[c(10, 12:13)],
      .(valor = (mean(valor))), by = .(ingles, fecha)][, cuatrim := as.yearqtr(as.yearmon(fecha), format = "%Y-%m")] %>% 
  ggplot(aes(x = cuatrim, y = valor, color = ingles)) +
  stat_smooth(aes(y = valor), method = "loess", se = FALSE, size = 1.5) + scale_color_tableau() +
  labs(title = "Evolución (polinomial) del número de exportaciones hacia USA y China 2010 a 2020")+
  theme_tufte() +
  theme(plot.title = element_text(size = 12))

A pesar de que uno podría pensar que la curva polinomial de grado 19 se ajusta mejor a los 122 puntos que la curva de loess (aunque habría que estudiar en mayor profundidad esto, la regresión de loess es un ajuste local que puede alcanzar gran precision), en este caso la curva castiga en exceso a Pakistan. La curva de loess es una mejor aproximación del caso Bahrain.

datos[ingles %in% mayor_media[2:6],
      .(valor = (mean(valor))), by = .(ingles, fecha)][, cuatrim := as.yearqtr(as.yearmon(fecha), format = "%Y-%m")] %>% 
  ggplot(aes(x = cuatrim, y = valor, color = ingles)) +
  stat_smooth(aes(y = valor), method = "loess", se = FALSE, size = 1.5) + scale_color_tableau() +
  labs(title = "Evolución (ajustada por loess) del valor promedio de las exportaciones")+
  theme_tufte() +
  theme(plot.title = element_text(size = 12))

El ajuste local es bastante mas crítico con la situación de Bulgaria, y también enseña una preocupante baja en la India, y una tendencia a la estabilización de China.

datos[ingles %in% mayor_media[2:6],
      .(valor = (mean(valor))), by = .(ingles, fecha)][, cuatrim := as.yearqtr(as.yearmon(fecha), format = "%Y-%m")] %>% 
  ggplot(aes(x = cuatrim, y = valor, color = ingles)) +
  stat_smooth(aes(y = valor), method = "lm", se = FALSE, size = 1.5) + scale_color_tableau() +
  labs(title = "Evolución (ajuste lineal) del valor promedio de las exportaciones")+
  theme_tufte() +
  theme(plot.title = element_text(size = 12))

El ajuste lineal es aun mas “pesimista”.

Agrupando países según volúmen de exportación recibida

Principales países de destino de exportación

Grupo 1: Los 12 países con más de 70 mil exportaciones realizadas

(format_table)

Aparente normalidad de las distribuciones

frame_9[, med := log(mean(valor)),
        by = nombre_pais] %>% 
  na.omit(.) %>% 
  ggplot(aes(log(valor),
             y = fct_reorder(nombre_pais, med),
             fill = fct_reorder(nombre_pais, med), height = ..density..)) +
  geom_density_ridges() +
  theme_fivethirtyeight() +
  guides(colour = F, fill = F) +
  scale_fill_viridis_d() +
  scale_x_continuous(breaks = c(0,3,6,9,12,15,18), limits = c(0,22)) +
  labs(title = "Distribución del valor de exportación log-US$ por país", 
       subtitle = "Grupo 1")+
  theme(plot.title = element_text(size = 14))

Los países tienen distribuciones aproximadamente normales del valor de exportación. Chima y Japón presentan colas superiores largas -a escala logarítmica. Las curvas se achatan en los países sudamericanos.

Familias de distribución que mejor se ajusta a la variabilidad del valor de exportación para cada uno de los países

datos. <- frame_9[!frame_9$valor <= 0, ]
datos.$valor <- 1.000001+ datos.$valor

mayor_media <- unique(datos.$nombre_pais)
comp_aic <- list()
lista <- list()
datos.$ingles <- datos.$nombre_pais
for (i in 1:length(mayor_media)) {comp_aic[[i]] <- AIC(
  #mlbetapr(datos[datos$ingles == mayor_media[i], valor]),
  mlexp(datos.[datos.$ingles == mayor_media[i], valor]),
  mlinvgamma(datos.[datos.$ingles == mayor_media[i], valor]),
  mlgamma(datos.[datos.$ingles == mayor_media[i], valor]),
  mllnorm(datos.[datos.$ingles == mayor_media[i], valor]),
  mlrayleigh(datos.[datos.$ingles == mayor_media[i], valor]),
  mlinvgauss(datos.[datos.$ingles == mayor_media[i], valor]),
  mlinvweibull(datos.[datos.$ingles == mayor_media[i], valor]),
  mllgamma(datos.[datos.$ingles == mayor_media[i], valor])
)
lista[[i]] <- comp_aic[[i]] %>% rownames_to_column(var = "distribucion") %>% arrange(AIC)
}
names(lista) <- mayor_media
lista. <- as.data.table(reshape2::melt(lista))[variable == "AIC", ] %>% na.omit(.)

Valor mínimo de cada distribución:

sapply((sapply(unique(lista.$L1), 
       function(x) lista.[lista.$L1 == x, 
                          distribucion][which.min(lista.[lista.$L1 == x, value])])),
       function(y) genX(y, "(", ")"))

##           Perú      Argentina         Brasil          China          Japón 
##      "mllnorm"      "mllnorm"      "mllnorm"      "mllnorm"      "mllnorm" 
## Estados Unidos         Canadá   Países Bajos         México        Ecuador 
##      "mllnorm"      "mllnorm"      "mllnorm"      "mllnorm"      "mllnorm" 
##        Bolivia       Colombia 
##      "mllnorm"      "mllnorm"

lista. %>% 
  ggplot() + 
  geom_col(aes(distribucion, value^.5, fill = ifelse(str_detect(distribucion, "mllnorm"), "tomato2", "black"))) + 
  facet_wrap(~L1, scales = "free_x") + 
  theme_bw() +
  scale_x_discrete(labels = function(y) genX(y, "(", ")")) +
  theme(axis.text.x = element_text(angle = 90), 
        plot.title = element_text()) + 
  guides(fill = F) + 
  #scale_fill_gradientn(colours = rev(viridis::viridis(20))) + 
  scale_fill_tableau() +
  labs(subtitle = "Ajustando familias de distribución a la variabilida de valor de cada país\nPuntaje mediante AIC, escala cuadrática")

La curva que mejor se ajusta a la distribución de valor de cada uno de los países (de este grupo) es la log-normal, a pesar de que la diferencia es bastanta pequeña entre distribuciones de la familia gamma como la gamma misma, la exponencial o la log gamma, y la log-normal (y similar también para la gaussiana invertida).

Explorando la log-normalidad del valor

gf_dens(~ valor | ingles, data = na.omit(datos.) %>% .[sample(nrow(datos.), 50000), .(valor = log(valor), ingles)], color = "#006ba4", alpha = 2, size = 1) %>%
  gf_fitdistr(color = "#c85200", alpha = 2, size = 1) %>%
      gf_fitdistr(dist = "gamma", color = "#ffbc79", subtitle = "Distribución real y distribuciones ajustadas: normal y gamma", alpha = 2, size = 1)

En azul la distribución logaritmica del valor de exportación de cada país, en rojo la distribución normal construida a partir de los valores de media y desviación de cada país, y en naranjo la distribución gamma con los respectivos parametros.

El qqplot también muestra las colas largas superiores de China y Japón, el outlier de Ecuador -que es el mas extremo de este grupo- y el de Argentina y Colombia. Tambien enseña la colas cortas superiores de China, Brasil, Japón y Países bajpos, y colas largas inferiores de varios países sudamericanos.

Variabilidad en el tiempo

Coeficiente de variación del valor

El coeficiente de valor es una métrica que permite la comparación entre las dispersiones de los distintos países (esta ajustada por la media). En el siguiente elemento visual se explora esta métrica, primero construida a partir de la variabilidad de los valores de exportación mensual -para cada año, y luego construida a partir de la variabilidad del valor entre las exportaciones -para cada año.

g1 <- frame_9[,.(.N, suma = sum(valor)), by = .(ingles, año, mes)][
          order(año, mes)][,coef := sd(suma)/sum(suma), by=.(ingles, año)] %>% 
          ggplot(aes(as.factor(año), coef, color = sqrt(coef))) + 
          geom_point(alpha = 0.5, size = 1.7) +
          theme_fivethirtyeight() +
          scale_colour_viridis_c(name = "") +
          facet_wrap(~ ingles) +
          theme(axis.text.x = element_text(angle = 90), plot.subtitle = element_text(size = 12)) +
          guides(color = F)+
          labs(subtitle = "Variación inter-mensual",
               x = "Año", y = "Variación inter-mensual") +
          geom_hline(yintercept = 0.025, linetype = "dashed", color = "tomato2")

g2 <- frame_9[,.(media = mean(valor), coef = sd(valor)/mean(valor)), by = .(ingles, año)] %>%
          ggplot(aes(as.factor(año), coef, color=sqrt(coef))) + 
          geom_point(alpha = 0.8, size = 1.7) +
          theme_fivethirtyeight() +
          scale_colour_viridis_c() +
          facet_wrap(~ ingles) +
          theme(axis.text.x = element_text(angle=90),plot.subtitle = element_text(size = 12),
                legend.position = "none") +
          geom_hline(yintercept = 5, linetype = "dashed", color = 'tomato2') +
          scale_y_continuous(limits=c(0,16)) +
          labs(subtitle = "Variación inter-exportación",
                       x = "", y = "")

g1

Hay 2 observaciones que no se alcanzan a visualizar: Ecuador 2016 y Argentina 2018. Esto lo hice de modo manual, dado que anulan la variabilidad observable entre los puntos (por ser puntos demasiado lejanos). (Se puede decir que anulan la entropia visible en los gráficos)
El primer gráfico estudia la variabilidad entre los meses del valor de exportación, para cada país. El segundo gráfico estudia la variabilidad entre todas las exportaciones ocurridas en cada año, para cada país.
Son métricas complementarias, dado que estudian la dispersión de variabilidad agregada (a nivel mensual), por tanto se tiene en cierta medida un factor de estacionalidad, y el otro a nivel micro, estudia la variabilidad entre todas las exportaciones para un mismo período (año).
La variabilidad de exportación en exportación aumenta de modo sostenido en China (concordante con el crecimiento sostenido en el número de importaciones realizadas de mercancía chilena). Notar que en el año 2018 no esta la observación de Argentina. Esto se debe a que fue tan alta la dispersión este año, que aplana la variabilidad de todas las otras observaciones del resto de los países.
Notar que todos los años 2020 la dispersión inter-mensual se dispara. Esto posiblemente se deba a información incompleta para el último de los meses del año, que es abril. Esta anormalidad desaparece en el gráfico de variabilidad inter-exportación, lo que habla refuerza esta hipótesis.
En USA la variabilida entre los meses es bastante baja, y al contrario, la variación inter-exportación es la mas elevada del grupo.
Argentina, a pesar del año atípico de 2018, sostiene dispersiones bastante bajas en ambas dimensiones.

Variabilidad entre los meses

frame_9[,.(.N, suma = sum(valor)), by = .(ingles, año, mes)][order(año, mes)][,cum1 := cumsum(suma), by=.(ingles, año)][order(-cum1)] %>%
          ggplot(aes(año, log(cum1), color = as.factor(año))) + 
          geom_boxplot(size = .8, alpha = 1) +
          theme_fivethirtyeight() +
          guides(color = 'none') +
          theme(axis.text.x = element_text(angle = 90),
                plot.title = element_text(size = 13)) +
          # scale_colour_brewer("Set2") +
          scale_color_viridis_d(name = "") +
          facet_wrap(~ ingles, ncol=3) +
          labs(title = "Valor de lo exportado a cada destino", 
          subtitle = "Cada observación que describe el boxplot es el acumulado mensual, desde Enero a Diciembre", 
          caption = "Escala logarítmica") +
          scale_x_continuous(breaks = seq(2010,2020,1))

La idea es que cada boxplot resume los montos de valor acumulados en cada año. Es decir, el gráfico toma como valor lo exporto en enero 2010 y este representa el primer punto.

Luego, toma lo que se exporto en febrero y lo suma a lo de enero y este representa el segundo punto(acumulado).

Repite este procedimiento hasta llegar a diciembre, y el resultado son 12 puntos que reflejan los valores acumulados para cada mes, y sobre esto grafica un boxplot. Este tipo de gráficos experimental y atípico puede llegar a servir como herramienta de exploración “innovadora” intentando encontrar patrones de un modo diferente.

Un outlier inferior, como se aprecia en los gráficos, puede representar un enero muy malo o un febrero muy bueno. Uno superior (muy dificil) significaria un diciembre increible.

La mediana es el promedio de lo acumulado entre junio y julio. (por construccion: definición de mediana).

Boxplot corto también implica que lo valores acumulados entre enero y diciembre son relativamente cercanos. Esto puede ocurrir si los primeros meses del año son bastante buenos y el resto de los meses no tanto

Notar que este boxplot de valores acumulados se construye sobre la base del primer mes. Sobre este el resto de su armado trata sobre cuanto se alejan del primer mes el resto de los meses.

En una construcción mas creativa, una podría pensar en boxplot parciales, que se construyen a partir de otros meses referenciales, como febrero o marzo por ejemplo. Si quisiera conocer cuanto se aleja el resto del año de marzo, para un gran numero de países, este tipo de boxplot es ideal.

Y al mismo tiempo puedo comparar el promedio entre los junios y julios, a lo largo de los años, y entre los países (a lo largo de los años tb o mirar la totalidad).

De echo, puedo comprar los eneros a lo largo de los años mirando la punta inferior del boxplot, los diciembre mirando la punta superior del boxplot, el primer cuartil, que es un promedio ponderado (3,75) entre marzo y abril (tiene mas de abril que de marzo), el promedio junio-julio como señale y finalmente el tercer cuartil (donde cierra la “caja”), que es un promedio ponderado (9,25) entre septiembre y octubre (tiene mas de septiembre que de octubre).

Por último se puede mirar las colas inferiores, que serían lo acumulado entre enero y el promedio p. marzo-abril, y las colas superiores que son lo acumulado entre promedio p. septiembre-octubre y diciembre.

Por ejemplo, notar que para Argentina 2018 la separación entre la mediana y el tercer cuartil es atípicamente grande, esto puede derivar en un estudio que revise los meses entre julio y septiembre para resolver el hallazgo.
Luego la distancia entre el primer cuartil y la mediana de Bolivia 2019 también es atípicamente alta, algo atípico ocurrio entre abril y junio-julio.
Y bueno, el crecimiento sostenido de china, la baja progresiva de Argentina, oscilaciones en Brasil, Japan y Bolivia. La estabilidad de las medianas de Colombia (con últimos 3 meses muy buenos en 2012) y oscilaciones en USA.

```

Including Plots

You can also embed plots, for example:

Note that the echo = FALSE parameter was added to the code chunk to prevent printing of the R code that generated the plot.

a51

Christian H

28/7/2020

R Markdown

Países

Valor

Valor de todo lo exportado a cada país de destino

Valor promedio

Variabilidad del valor: agrupando por país de destino

Agrupando por valor de exportación

Los 16 países con más de US350,000 de exportación promedio (promedio poblacional) Se excluye Tuvalu que cumple con la condición pero tiene una sola exportación en la muestra

Distribución muestral

Explorando la normalidad del logaritmo del valor de exportación

Variabilidad en el tiempo

5 países con mayor valor promedio

Caso Namibia

Segundo subgrupo de los 16 países con mayor valor

Caso Oman

Caso Pakistán:

Ajuste de loess vs el polinómico

Agrupando países según volúmen de exportación recibida

Principales países de destino de exportación

Grupo 1: Los 12 países con más de 70 mil exportaciones realizadas

Aparente normalidad de las distribuciones

Familias de distribución que mejor se ajusta a la variabilidad del valor de exportación para cada uno de los países

Valor mínimo de cada distribución:

Explorando la log-normalidad del valor

Variabilidad en el tiempo

Coeficiente de variación del valor

Variabilidad entre los meses

Including Plots