Preprocesamiento

Detección de valores atípicos

Santiago Banchero
Juan Manuel Fernández
Eloísa Piccoli

Minería de Datos - UBA

• Análisis gráfico de outliers: Boxplot
• Técnicas univariadas para detección de outliers:
  • Rango intercuartil
  • Desvíos de la media
  • Z-Score y Z-Score Modificado
• Técnicas Multivariadas
  • Local Outlier Factor (LOF)
  • Distancia de Mahalanobis
  • Isolation Forest

Utilizaremos el dataset StudentsPerformance.csv de Kaggle para analizar outliers

dataset_original = read.csv('StudentsPerformance.csv')
data = dataset_original$writing.score

Nota: Se necesita estar loggueado a Kaggle para poder acceder al link.

summary(data)

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  10.00   57.75   69.00   68.05   79.00  100.00 

hist(data, main ="Histograma de Calificaciones")

Los puntos por encima o por debajo de los bigotes del Boxplot son considerados atípicos.

En este ejemplo identificamos 5 valores atípicos

boxplot(data,ylab="Calificaciones")
title("Boxplot Exámen Escrito")

Q1 = as.numeric(quantile(data)["25%"])

Q1 llamado 25% en el vector de cuartiles: 57.75

Q3 = as.numeric(quantile(data)[4])

Q3 por posicion en el vector: 79

IQR_Manual = Q3 - Q1

Rango intercuartil calculado manualmente: 21.25

IQR = IQR(data)

Rango intercuartil: 21.25

# Importancia de conocer el dominio: ¿Calificación mayor a 100 puntos?
lim_sup = Q3 + 1.5*IQR

lim_sup: 110.875

lim_inf = Q1 - 1.5*IQR

lim_inf: 25.875

# Los valores atípicos identificados son:
sort(data[data < lim_inf]) 

[1] 10 15 19 22 23

boxplot_info = boxplot(data)

boxplot_info_Q1 = boxplot_info$stats[1]

Bigote Inferior Boxplot: 27

Límite inferior IQR:  25.875

El objeto Boxplot usa como corte un dato observado en la distribución, mientras que IQR toma un valor teórico. Sin embargo, para este ejemplo, ambos resultados coinciden

unique(sort(data[data < boxplot_info_Q1 ] )) # Outliers Boxplot

[1] 10 15 19 22 23

Otra alternativa para detección de outliers es utilizar N desvíos de alguna medida de tendencia central:

N =3 # Para este ejemplo utilizamos 3 desvíos
desvio <- sd(data)
print(desvio)

[1] 15.19566

outliers_max<-mean(data)+N*desvio
print(outliers_max)

[1] 113.641

outliers_min<-mean(data)-N*desvio
print(outliers_min)

[1] 22.46703

unique(sort(data[data < outliers_min])) # 4 valores

[1] 10 15 19 22

plot(data, main="Diagrama de Dispersión")
abline(h=c(outliers_max,outliers_min), col="red",lty=5)
legend(1,35 , legend=c("0utliers_min"),col="red", lty=5)

# Creo un nuevo vector con los valores de Z-Score
data_zscore = (data-mean(data))/sd(data)

Si definimos el umbral inferior como -3 el resultado será igual al ejemplo anterior donde N=3 desvíos de la media

umbral =-3
unique(sort(data_zscore[data_zscore < umbral])) 

[1] -3.820434 -3.491392 -3.228159 -3.030734

unique(sort(data[data_zscore < umbral])) # Filtrando variable original

[1] 10 15 19 22

mediana = median(data)
MAD = median(abs(data-mediana))
Zm = ((0.6745*(data - median(data))) / MAD)

Con un umbral de -3.5 solo identificamos 1 Outlier

umbral_Zm = -3.5 
unique(sort(Zm[Zm < umbral_Zm])) 

[1] -3.617773

unique(sort(data[Zm < umbral_Zm])) # Filtrando variable original

[1] 10

data <- dataset_original[,c(6:8)] # Agregamos exámenes

¿Y si obtenemos baja calificación en dos materias pero alta en Matemáticas?

data<- within(data, math.score[math.score == 18 & writing.score == 28]  <- 80)
data<- within(data, math.score[math.score == 26 & reading.score == 31] <- 82)

# Guardamos los nombres de los registros modificados
modificados = which(data$math.score == 80 & data$writing.score == 28 | data$math.score == 82 & data$reading.score == 31)

library(scatterplot3d) # Observamos los 3 exámenes

scatterplot3d(data$math.score, data$reading.score, data$writing.score,
color=ifelse(data$math.score==80 & data$writing.score == 28 |data$math.score==82 & data$reading.score == 31, 
"red", "black"))

Los boxplots no detectan outliers en el bigote superior. Sin embargo, en conjunto, los nuevos puntos se alejan de la nube.

vector_medias = colMeans(data) 
matriz_var_cov = cov(data)

# Creamos una variable con la distancia
data$maha = sqrt(mahalanobis(data,vector_medias,matriz_var_cov))

# Los 3 registros mas distantes
top_maha <- head(data[order(data$maha,decreasing = TRUE),],3)

    math.score reading.score writing.score     maha
467         82            31            38 5.996136
18          80            32            28 5.754061
60           0            17            10 4.522533

modificados # Los registros modificados resultaron los más distantes

[1]  18 467

library(Rlof)

# Score para K vecinos
data$LOF_score<-lof(data[,c(1:3)], k=5) 

# Los 3 registros más distantes
top_LOF <- head(data[order(data$LOF_score,decreasing = TRUE),],3) 

    math.score reading.score writing.score LOF_score
18          80            32            28  3.585731
467         82            31            38  3.337698
60           0            17            10  2.360896

Comparando los resultados de Mahalanobis

    math.score reading.score writing.score     maha
467         82            31            38 5.996136
18          80            32            28 5.754061
60           0            17            10 4.522533

library(isotree)
set.seed(1)

# Ajustamos un modelo 
data$iso <- isolation.forest(data[,c(1:3)], ntrees = 3, output_score=TRUE)$score

    math.score reading.score writing.score       iso
18          80            32            28 0.7932898
467         82            31            38 0.7932898
60           0            17            10 0.7655258
981          8            24            23 0.7655258

Nota: Este algoritmo soporta variables categóricas, sin embargo, se mantuvo el análisis sobre las variables de calificaciones para obtener resultados comparables.