Bagging de Cluster Compensados

Si se tiene un escenario con datos desbalanceados (como en datos de fraude, por ejemplo) donde la cantidad de casos positivos es muy poca en comparación con los negativos, es probable que los algoritmos no puedan "aprender" a clasificar correctamente los casos positivos.

Existen diferentes técnicas para balancear los datos  (ver referencia 1, 2 y 3), que en algunos casos soluciona el problema y en otros no.

La siguiente técnica es una propuesta (aun sin validar en detalle) que intenta compensar datos desbalanceados y luego crear un clasificador. Consiste en crear cluster de los casos negativos y compensarlo con la totalidad de casos positivos, para luego crear grupos de algoritmos en cada cluster que puedan "aprender" las diferencias entre los positivos y los diferentes tipos de negativos. Esto crearía diferentes algoritmos "especialistas" en cada cluster.

Esta técnica parece funcionar en escenarios desbalanceados donde el costo del error de falsos positivos es compensado con la ganancia en predicción correcta de "algunos" verdaderos positivos, y donde los algoritmos con set normales predicen cerca del 0% de verdaderos positivos.

Conceptualmente sería así:


PASO 1
Creación y compensación de cluster:

PASO 2
Bagging de cluster compensados:

El siguiente script crea cluster de los verdaderos negativos, y luego añade a cada cluster el total de los verdaderos positivos. Luego de tener estos cluster compensados con los verdaderos positivos, se hace bagging en cada cluster, haciendo el modelo mas estable.

Para medir la eficiencia, se compara el desempeño de la predicción de los algoritmos con cluster compensados versus un algoritmo sin compensar.


El script en R:

# Bagging de cluster compensados
#---------------------------------------------------------------------------
 
# PASO 1. Carga package y datos
library(C50); library(rpart); data(churn); 
library(C50); library(cluster)
library(foreach)
 
# Crea set desvalanceado para Training
Train       <- subset(churnTrain,churn=="no")
Train       <- rbind(Train,subset(churnTrain,churn=="yes")[sample(nrow(Train)*.02),])
Test        <- churnTest
 
clase       <- as.character(unique(Train$churn))
Train_yes   <- Train[Train$churn==clase[clase=="yes"],]
Train_no    <- Train[Train$churn==clase[clase=="no"],]
k           <- 3 # cantidad de cluster 
 
#-----------------------------------------------------------------------------
# PASO 2. crea cluster para el DataSet con churn="no"
Train_ParaCluster <- within(Train_no,
                             rm("state", "area_code", 
                                "international_plan","churn",
                                "voice_mail_plan"))  # elimina variables discretas
 
Grupos            <- pam(Train_ParaCluster,k)        # crea cluster
Train_no$Grupo    <- Grupos$clustering               # asigna cluster a cada caso
 
 
#------------------------------------------------------------------------------
# PASO 3. Crea modelos y  predicciones
 
Iteraciones           <- k*10  #cantidad de bagging en cada cluster
ii                    <- 0
 
Prediccion            <- foreach(i=1:Iteraciones,.combine=cbind) %do% {  
  Train_cluster       <- Train_yes
  Train_cluster$Grupo <- "dummy"
 
  if ( ((i-1)/(k))%%1==0 ) {ii=1} else   {ii=1+ii}
 
  Train_cluster_in    <- Train_no[Train_no$Grupo==ii,]
 
  # set para algoritmos Especialista ---------------------------
  Train_cluster       <- rbind(Train_cluster, 
                               Train_cluster_in[sample(
                                 nrow(Train_cluster_in),
                                 ceiling(nrow(Train_cluster_in)*.25)
                               ),]) 
 
  Train_cluster       <- within(Train_cluster,rm("Grupo"))
 
 
 
  modelo              <- rpart(churn ~., data=Train_cluster, 
                               parms=list(split="information"),
                               method = "class")  
  print(table(Train_cluster$churn))
  print(paste("Algoritmo No.",i))
 
  predict(modelo, Test,type = "class")
}  
 
 
#---------------------------------------------------------------------------------
# PASO 4. Calcula prediccion usando voto mayoritario
Prediccion                 <- as.data.frame(Prediccion)
Prediccion$Cantidad_yes    <- rowSums(Prediccion [, 1:Iteraciones] == 1)
Prediccion$Cantidad_no     <- rowSums(Prediccion [, 1:Iteraciones] == 2)
Prediccion$Prediccion      <- clase[with(Prediccion,(Cantidad_yes>Cantidad_no)+1)]
MC                         <- table(Test[, "churn"],Prediccion[,"Prediccion"])
 
True_Pstvo  <-MC["yes","yes"]/(MC["yes","yes"]+MC["yes","no"])
True_Ngtv  <- MC["no","no"]/(MC["no","no"]+MC["no","yes"])
 
 
#       FIN de Bagging de Cluster Compensados
#############################################################################
 
 
 
 
 
# Script para comparar eficiencia de baggind de cluster versus rpart sin bagging
 
# -------------------------------------------------------------------------
# crea modelo rpart
Train_rpart       <- Train
Modelo.rpart      <-rpart(churn ~ .,data=Train_rpart,
                      parms=list(split="information"),
                      method = "class")
 
#--------------------------------------------------------------------------         
# Crea prediccion, Matriz de confusion, 
# y ratios de prediccion para positivos y negativos
Prediccion.rpart  <- predict (Modelo.rpart , Test,type = "class"); 
MC_rpart          <-table(Test[, "churn"],Prediccion.rpart)  
True_Pstvo_rpart  <-MC_rpart["yes","yes"]/(MC_rpart["yes","yes"]+MC_rpart["yes","no"])
True_Ngtv_rpart   <- MC_rpart["no","no"]/(MC_rpart["no","no"]+MC_rpart["no","yes"])
 
 
# ------------------------------------------------------------------------
# grafico
comparacion <-data.frame( True.Negative=c(True_Ngtv,True_Ngtv_rpart),
                         True.Positive=c(True_Pstvo,True_Pstvo_rpart))
 
plot(comparacion , ylim=c(0,1), xlim=c(0,1))
 
text(comparacion$True.Negative,comparacion$True.Positive,
     labels=c("Bagging de cluster","rpart"),pos=1,cex=.7)

Escenarios pendientes por validar:
1. En Voto Mayoritario, considerar sólo predicción con alta probabilidad (probabilidad >.8)
2. Predecir cluster para Test, y luego predecir la clase sólo con algoritmo especialistas del cluster.
3. Crear algoritmos genéricos con bagging de Training sin cluster, para lograr "algoritmos de control"



Referencias: 
1. https://dl.dropboxusercontent.com/u/59930995/Unbalanced%20Data.pdf
2. http://powerhousedm.blogspot.com.ar/search/label/Balancear%20datos
3. https://www3.nd.edu/~dial/papers/SPRINGER05.pdf

4. http://videolectures.net/ida07_panov_cbars/?q=bagging