Introducción

Esta práctica de laboratorio tiene como objetivo abordar nuevas técnicas correspondientes a la etapa de Preprocesamiento del Proceso de Descubrimiento de Conocimiento, puntualmente el análisis, detección y tratamiento de valores atípicos (en adelante, outliers).

Para la exploración de estos temas, se utilizará el IDE R-Studio del lenguaje de programación R, a efectos de ejercitar los conceptos abordados en las clases teóricas.

Consignas

A partir del dataset MPI_national.csv, se solicita trabajar sobre las siguientes consignas:

Fuente de datos

1. Sobre los datos

1.a. Cargue 1 y explore el dataset: explique en qué consiste el mismo y qué rango poseen

las variables numéricas.

Para comenzar cargamos las librerías necesarias para esta práctica:

library(pacman)
pacman::p_load(tidyverse, DT, plotly, gplots, patchwork, plotly)
options(warn=-1)

Luego cargamos el dataset a analizar:

read_csv <- function(name) {
  read.csv(
    paste('https://raw.githubusercontent.com/adrianmarino/dm/master/datasets/', name, '.csv', sep=''), 
    header = TRUE, 
    sep = ','
  )
}

raw_dataset <- read_csv('MPI_national')

Columnas:

bullets <- function(list) cat(paste('-', list), sep = '\n')
bullets(names(raw_dataset))
## - ISO
## - Country
## - MPI.Urban
## - Headcount.Ratio.Urban
## - Intensity.of.Deprivation.Urban
## - MPI.Rural
## - Headcount.Ratio.Rural
## - Intensity.of.Deprivation.Rural

Renombramos las columnas del dataset a nombres mas cortos y reemplazamos valores nulos:

dataset <- raw_dataset %>%
  rename(
    country_code = ISO,
    country      = Country,
    urban_mpi    = MPI.Urban,
    urban_hc     = Headcount.Ratio.Urban,
    urban_iod    = Intensity.of.Deprivation.Urban,
    rural_mpi    = MPI.Rural,
    rural_hc     = Headcount.Ratio.Rural,
    rural_iod    = Intensity.of.Deprivation.Rural
  ) %>% 
  replace_na(list(
    urban_mpi = 0,
    urban_hc  = 0,
    urban_iod = 0,
    rural_mpi = 0,
    rural_hc  = 0,
    rural_iod = 0
  ))

Columnas:

bullets(names(dataset))
## - country_code
## - country
## - urban_mpi
## - urban_hc
## - urban_iod
## - rural_mpi
## - rural_hc
## - rural_iod
dataset.num <- dataset %>% 
  select(ends_with('mpi') | ends_with('hc') | ends_with('iod'))

Columnas:

bullets(names(dataset.num))
## - urban_mpi
## - rural_mpi
## - urban_hc
## - rural_hc
## - urban_iod
## - rural_iod

Calculamos en rango de las variables y separame en rural vs urban:

dataset.num %>%
  summarise_all(range)  %>% 
  select(starts_with('urban'))
dataset.num %>%
  summarise_all(range)  %>% 
  select(starts_with('rural'))

Comparando rural vs urban se aprecia que los rangos son mayores para rural. Esto nos dice que en los países con altos niveles de pobreza (este dataset), la mayor pobreza se concentra en las zonas rurales.

1.b. Elija algún método abordado en el material visto hasta ahora y realice un breve

análisis sobre la distribución de las variables numéricas.

dataset.num.scaled <- dataset.num %>% mutate_all(scale)
as.vector(unlist(dataset.num.scaled['urban_mpi']))
##   [1] -0.83617098 -0.83617098 -0.83617098 -0.83617098 -0.82549779 -0.82549779
##   [7] -0.82549779 -0.82549779 -0.82549779 -0.81482460 -0.81482460 -0.81482460
##  [13] -0.81482460 -0.81482460 -0.80415142 -0.80415142 -0.80415142 -0.79347823
##  [19] -0.79347823 -0.79347823 -0.79347823 -0.78280504 -0.78280504 -0.77213186
##  [25] -0.77213186 -0.76145867 -0.75078548 -0.75078548 -0.74011229 -0.74011229
##  [31] -0.74011229 -0.72943911 -0.72943911 -0.71876592 -0.71876592 -0.69741954
##  [37] -0.68674636 -0.67607317 -0.66539998 -0.64405361 -0.63338042 -0.63338042
##  [43] -0.62270723 -0.62270723 -0.60136086 -0.53732173 -0.53732173 -0.52664855
##  [49] -0.50530217 -0.49462899 -0.47328261 -0.46260942 -0.41991667 -0.41991667
##  [55] -0.40924349 -0.36655074 -0.36655074 -0.32385799 -0.15308699 -0.12106743
##  [61] -0.03568193 -0.02500874  0.01768401  0.02835719  0.06037676  0.09239632
##  [67]  0.09239632  0.13508907  0.20980138  0.23114775  0.28451369  0.33787963
##  [73]  0.35922600  0.36989919  0.43393831  0.46595787  0.51932381  0.55134337
##  [79]  0.57268975  0.57268975  0.58336293  0.58336293  0.67942162  0.91423174
##  [85]  1.04230999  1.04230999  1.11702230  1.18106142  1.18106142  1.21308099
##  [91]  1.28779330  1.39452517  1.57596936  1.59731573  1.61866210  2.05626279
##  [97]  2.10962872  2.24838016  2.25905334  2.29107291  2.91011777  4.06282200

Veamos los histogramas de cada variable:

g_hist <- function(
  values, 
  name = '', 
  font_size = 7, 
  cant_bins = 30,
  colour = 'blue'
) {
  qplot(
      values, 
      geom     = "histogram", 
      main     = paste('Histograma', name),  
      xlab     = name,
      ylab     = 'Frecuencia', 
      binwidth = diff(range(values)) / cant_bins,
      fill     = "green"
    ) + 
    theme(text = element_text(size = font_size)) +
    guides(fill=FALSE)
}
g_hist_df <- function(df, col) g_hist(as.vector(unlist(df[col])), col)

# Generamos los histogramas para zonas urbanas
u1 <- g_hist_df(dataset.num.scaled, 'urban_mpi')
u2 <- g_hist_df(dataset.num.scaled, 'urban_hc')
u3 <- g_hist_df(dataset.num.scaled, 'urban_iod')

# Y los mismos para zonas Rurales
r1 <- g_hist_df(dataset.num.scaled, 'rural_mpi')
r2 <- g_hist_df(dataset.num.scaled, 'rural_hc')
r3 <- g_hist_df(dataset.num.scaled, 'rural_iod')

# Y los graficamos en paralelo para facilitar la comparación
(u1 | u2 | u3) / (r1 | r2 | r3)

Aqui se aprecia mejor el sesgo positivo de hc y mpi tanto rural como urbano, aunque en zonas parece ser mayor. Luego iod al es lo mas parecido a una normal en este dataset.

Calculemos el desvio:

dataset.sd <- dataset.num %>%
  summarise_all(sd)  %>% 
  select(starts_with('urban'))

dataset.sd[order(names(dataset.sd))]
dataset.sd <- dataset.num %>%
  summarise_all(sd)  %>% 
  select(starts_with('rural'))

dataset.sd[order(names(dataset.sd))]

Sucede lo mismo que con los histogramas zonas rurales tiene mayor dispersión.

2. Tratamineto de outlayers

2.a. Verifique graficamente la existencia de outliers en cada uno de los atributos.

Comparemos las distribuciones:

p <- dataset.num.scaled %>%
      pivot_longer(
        ., 
        cols = c(
          urban_mpi, 
          rural_mpi, 
          urban_hc, 
          rural_hc, 
          urban_iod, 
          rural_iod
        ), 
        names_to = "Variables", 
        values_to = "Frecuencia"
      ) %>%
      ggplot(aes(x = Variables, y = Frecuencia, fill = Variables)) +
      geom_boxplot(width=0.1) + 
      geom_jitter(shape=16, position=position_jitter(0.2))

ggplotly(p)

Se aprecia que en las zonas urbanas hay mas tendencia a tener valores atípicos(outlayers). Es probable que las distribuciones estén sesgadas. En este caso seguramente están inclinadas a derecha(valores mas altos).

Veamos cuales son los outlayers de urban_mpi:

rigote.superior <- boxplot(dataset.num$urban_mpi)$stats[5]
graphics.off()
dataset %>%
  filter(urban_mpi > rigote.superior)  %>%
  select(country)
rigote.superior <- boxplot(dataset.num$urban_hc)$stats[5]
graphics.off()
dataset %>%
  filter(urban_hc > rigote.superior)  %>%
  select(country)

¿Existen atributos que poseen valores atípicos?

  • Encontramos que Chad y South Sudan son países con outlayers para mpi.
  • Luego Chad para hc.

2.b. Seleccione uno de los features del dataset que a su entender posea outiers y aplique

las técnicas de análisis univariadas vistas en clase (IRQ, SD, y Z-SCORE) y compare los resultados.

Selecciono urban_mpi por se la variable con mas outlayers.

Rango Intercuantil

variable <- dataset$urban_mpi

Q3 <- as.numeric(quantile(variable)['75%'])
Q1 <- as.numeric(quantile(variable)['25%'])
IQR <- Q3 - Q1

LIM_SUP <- Q3 + (1.5*IQR)
LIM_INF <- Q1 - (1.5*IQR)

bullets(list(LIM_INF, LIM_SUP))
## - -0.1705
## - 0.3035

Validemos que se trata de nuestros outlayers:

dataset %>%
  filter(urban_mpi > LIM_SUP)  %>%
  select(country)

Z-Score (Modificado)

variable_median <- median(variable)
MAD             <- median(abs(variable - variable_median))
COSTN           <- 0.6745
ZScore          <- (COSTN * (variable - variable_median)) / MAD
SD.Umbral <- 3.5
Outlayers <- ZScore[ZScore > SD.Umbral]

length(Outlayers)
## [1] 11

Veamos que paises corresponden a estos outlayers:

bullets(dataset$country[ZScore > SD.Umbral])
## - Burundi
## - Burkina Faso
## - Congo, Democratic Republic of the
## - Ethiopia
## - Sierra Leone
## - Niger
## - Central African Republic
## - Liberia
## - Somalia
## - Chad
## - South Sudan
p <- ggplot(data = data.frame(x=seq(length(ZScore)), y=ZScore), aes(x, y)) + 
  geom_point(col='orange') +
  geom_hline(
    aes(yintercept = median(ZScore), color='Median'), 
    linetype='dashed', 
    size=0.3
  ) +
  geom_hline(
    aes(yintercept = SD.Umbral, color='Umbral del ZScore'), 
    linetype='dashed', 
    size=0.3
  ) +
  labs(
    y="ZScore de Urban MPI", 
    title = 'Outlayers de Urban MPI usando el método ZScore (Modificado)'
  )

ggplotly(p)

2.c. Observe qué ocurre con la distribución de la feature elegida en caso de eliminar los

outliers. Grafique un boxplot de con la nueva distribución. Concluya al respecto.

values <- ZScore[ZScore <= SD.Umbral]
length(values)
## [1] 91
p <- ggplot(data = data.frame(x=seq(length(values)), y=values), aes(x, y)) + 
  geom_point(color='orange') +
  geom_hline(
    aes(yintercept = median(values), color='Median'), 
    linetype='dashed', 
    size=0.3
  ) +
  geom_hline(
    aes(yintercept = SD.Umbral, color='Umbral del ZScore'), 
    linetype='dashed', 
    size=0.3
  ) +
  labs(
    y="ZScore de Urban MPI", 
    title = 'Outlayers de Urban MPI usando el método ZScore (Modificado)'
  )

ggplotly(p)
dataset_without_urban_mpi_outlayers <- subset(dataset, ZScore <= SD.Umbral)
nrow(dataset_without_urban_mpi_outlayers)
## [1] 91
p <- dataset_without_urban_mpi_outlayers %>%
      pivot_longer(
        ., 
        cols = c(
          urban_mpi
        ), 
        names_to = "Variables", 
        values_to = "Frecuencia"
      ) %>%
      ggplot(aes(x = Variables, y = Frecuencia, fill = Variables)) +
      geom_boxplot(width=0.1) + 
      geom_jitter(shape=16, position=position_jitter(0.2))

ggplotly(p)
rigote.superior <- boxplot(dataset_without_urban_mpi_outlayers$urban_mpi)$stats[5]
graphics.off()
dataset_without_urban_mpi_outlayers %>%
  filter(urban_mpi >= rigote.superior)  %>%
  select(country)

Se aprecia que se eliminaron los outlayers. Luego, en el limite superior se encuentra el país Guinea-Bissau.

2.d. Extienda el análisis a 3 variables y analice si existen valores atípicos utilizando algún método multivariado.

 

Realizado por Adrian Marino

adrianmarino@gmail.com