Preprocesamiento

Reducción de Dimensionalidad



Santiago Banchero
Juan Manuel Fernández
Eloísa Píccoli

Minería de Datos - UBA

• Reducción de dimensionalidad
  • Low Variance Factor
  • Atributos altamente correlacionados
  • Variables Importantes (Random Forest)

library(readr)
data_completo <- as.data.frame(read_csv("https://raw.githubusercontent.com/dm-uba/dm-uba.github.io/master/2021/laboratorios/LAB06/auto-mpg.csv"))

# Adaptamos los atributos para el análisis 
colnames(data_completo)[7] <- 'model_year'
data_completo$model_year <- as.factor(data_completo$model_year)
data_completo[, 4] <- sapply(data_completo[, 4], as.numeric)
data_completo$origin <- as.factor(data_completo$origin)
data_completo$cylinders <- as.factor(data_completo$cylinders)

library(tidyverse)
library(knitr)
# Agrupamos las variables según su tipo
numericas <- data_completo %>% select_if(is.numeric) %>% as.data.frame()
categoricas <- data_completo %>% select_if(negate(is.numeric)) %>% as.data.frame()

# Copiamos las variables numericas en un nuevo df para no pisarlo
lvf = na.omit(numericas)
# Normalizamos los datos (Min-Max) a un rango 0-1
for(i in 1:ncol(lvf)) {
  lvf[,i] <- (lvf[,i]-min(lvf[,i]))/(max(lvf[,i])-min(lvf[,i]))
  }
# Calculamos la varianza para cada atributo
varianzas<-sort(round(apply(lvf, 2, var),4))

acceleration          mpg   horsepower       weight displacement 
      0.0270       0.0431       0.0438       0.0580       0.0731 

Vamos a hacer el análisis “a mano”:

# Calculo matriz de correlación
matriz.correlacion<-round(cor(numericas, use = "complete.obs"),3)

Para facilitar la detección de candidatos podemos hacer un heatmap.

library(gplots)

# Excluyo triangulo inferior para mayor claridad
matriz.correlacion[lower.tri(matriz.correlacion)] <- NA

heatmap.2(abs(matriz.correlacion),
          cellnote = matriz.correlacion, 
          notecol="black", 
          main = "Correlación",
          trace="none",        
          margins =c(11,11),  
          col=terrain.colors(4,rev = FALSE),  
          dendrogram="none",
          symm= T, 
          Rowv=F,# Ordena la diagonal (en vez de dendograma)  
          breaks=c(0.79, 0.85, 0.9, 0.99, 1))

Los breaks son los cortes para la asignación de colores.

library(caret)
alta.correlacion <- findCorrelation(cor(numericas, use = "complete.obs"), cutoff=0.85, names=TRUE, verbose= TRUE)

Compare row 3  and column  2 with corr  0.897 
  Means:  0.807 vs 0.699 so flagging column 3 
Compare row 2  and column  4 with corr  0.933 
  Means:  0.761 vs 0.636 so flagging column 2 
All correlations <= 0.85 

Por cada par de atributos que superen el umbral propone eliminar el de mayor correlación promedio:

[1] "horsepower"   "displacement"

Pondera la contribución de los atributos a la correcta clasificación de la clase mediante dos métricas:

Mean Decrease Accuracy: Cuánta precisión pierde el modelo en promedio al eliminar la variable

Mean Decrease Gini: Cuánto contribuye la variable en promedio a la pureza/homogeneidad del nodo.

library(randomForest)
model_rf<-randomForest(origin ~ ., data = na.exclude(data_completo[,c(1:8)]), importance=TRUE)

En ambos casos, valores más altos implican mayor importancia.

knitr::kable(round(importance(model_rf)[,c(4:5)],2),"pipe")