Bosque aleatorio (random forest)

Tecnica de random forest

Random forest (o random forests) también conocidos en castellano como ‘“Bosques Aleatorios”’ es una combinación de árboles predictores tal que cada árbol depende de los valores de un vector aleatorio probado independientemente y con la misma distribución para cada uno de estos. Es una modificación sustancial de bagging que construye una larga colección de árboles no correlacionados y luego los promedia.

El algoritmo para inducir un random forest fue desarrollado por Leo Breiman1 y Adele Cutler y Random forest es su marca de fábrica. El término aparece de la primera propuesta de Random decision forest, hecha por Tin Kam Ho de Bell Labs en 1995. El método combina la idea de bagging de Breiman y la selección aleatoria de atributos, introducida independientemente por Ho,23 Amit y Geman,4 para construir una colección de árboles de decisión con variación controlada.

La selección de un subconjunto aleatorio de atributos es un ejemplo del método random subspace, el que, según la formulación de Ho, es una manera de llevar a cabo la discriminación estocástica propuesta por Eugenio Kleinberg.

En muchos problemas el rendimiento del algoritmo random forest es muy similar a la del boosting, y es más simple de entrenar y ajustar. Como consecuencia, el Random forest es popular y ampliamente utilizado.

¿Cómo se construye un modelo random forest?

Cada árbol se construye así:

1.- Dado que el número de casos en el conjunto de entrenamiento es N. Una muestra de esos N casos se toma aleatoriamente pero CON REEMPLAZO. Esta muestra será el conjunto de entrenamiento para construir el árbol i.

2.- Si existen M varibles de entrada, un número m<M se especifica tal que para cada nodo, m variables se seleccionan aleatoriamente de M. La mejor división de estos m atributos es usado para ramificar el árbol. El valor m se mantiene constante durante la generación de todo el bosque.

3.- Cada árbol crece hasta su máxima extensión posible y NO hay proceso de poda.

4.- Nuevas instancias se predicen a partir de la agregación de las predicciones de los x árboles (mayoría de votos para clasificación, promedio para regresión)

Aplicando Random Forest

Características

  • Random Forest se considera como la “panacea” en todos los problemas de ciencia de datos.

  • Útil para regresión y clasificación.

  • Un grupo de modelos “débiles”, se combinan en un modelo robusto.

  • Sirve como una técnica para reducción de la dimensionalidad.

  • Se generan múltiples árboles (a diferencia de CART).

  • Cada árbol da una clasificación (vota por una clase). Y el resultado es la clase con mayor número de votos en todo el bosque (forest).

  • Para regresión, se toma el promedio de las salidas (predicciones) de todos los árboles

Referencias

Ejercicio de random forest

Ejercicio de deteccion de Churn, abandono de empresas, ¿Que es lo que hace que las personas abandonen las empresas de telecomunicaciones?

library(pacman)
p_load(randomForest, DataExplorer, ROCR, ggplot2, tidyr, dplyr, data.table, xfun)

Importar datos

# Importamos los datos y los incluimos en un data frame llamado df1
df1 <- fread("TelcoChurn.csv")
options(scipen=999) #Desactivar la notación científica

Análisis exploratorio de datos (EDA)

  • Conociendo los datos
head(df1) 
##    InternetService       Contract             PaymentMethod tenure_DISC
## 1:             DSL Month-to-month          Electronic check     Grupo 1
## 2:             DSL       One year              Mailed check     Grupo 2
## 3:             DSL Month-to-month              Mailed check     Grupo 1
## 4:             DSL       One year Bank transfer (automatic)     Grupo 3
## 5:     Fiber optic Month-to-month          Electronic check     Grupo 1
## 6:     Fiber optic Month-to-month          Electronic check     Grupo 1
##    MonthlyCharges_DISC TotalCharges_DISC TARGET
## 1:             Grupo 1           Grupo 1     No
## 2:             Grupo 2           Grupo 3     No
## 3:             Grupo 2           Grupo 1     Si
## 4:             Grupo 2           Grupo 3     No
## 5:             Grupo 3           Grupo 1     Si
## 6:             Grupo 4           Grupo 2     Si
  • Conociendo la estructura de los datos
str(df1)
## Classes 'data.table' and 'data.frame':   7032 obs. of  7 variables:
##  $ InternetService    : chr  "DSL" "DSL" "DSL" "DSL" ...
##  $ Contract           : chr  "Month-to-month" "One year" "Month-to-month" "One year" ...
##  $ PaymentMethod      : chr  "Electronic check" "Mailed check" "Mailed check" "Bank transfer (automatic)" ...
##  $ tenure_DISC        : chr  "Grupo 1" "Grupo 2" "Grupo 1" "Grupo 3" ...
##  $ MonthlyCharges_DISC: chr  "Grupo 1" "Grupo 2" "Grupo 2" "Grupo 2" ...
##  $ TotalCharges_DISC  : chr  "Grupo 1" "Grupo 3" "Grupo 1" "Grupo 3" ...
##  $ TARGET             : chr  "No" "No" "Si" "No" ...
##  - attr(*, ".internal.selfref")=<externalptr>

Puede observarse que todas son “chr”, esto es, “character”, por tanto, vamos a pasarlas a Factor.

Tipologia de datos

df1 <- mutate_if(df1, is.character, as.factor) #identifica todas las variables character y transformarlas en factores

str(df1) #estructura de la base de datos después de la transformación
## Classes 'data.table' and 'data.frame':   7032 obs. of  7 variables:
##  $ InternetService    : Factor w/ 3 levels "DSL","Fiber optic",..: 1 1 1 1 2 2 2 1 2 1 ...
##  $ Contract           : Factor w/ 3 levels "Month-to-month",..: 1 2 1 2 1 1 1 1 1 2 ...
##  $ PaymentMethod      : Factor w/ 4 levels "Bank transfer (automatic)",..: 3 4 4 1 3 3 2 4 3 1 ...
##  $ tenure_DISC        : Factor w/ 4 levels "Grupo 1","Grupo 2",..: 1 2 1 3 1 1 2 1 2 4 ...
##  $ MonthlyCharges_DISC: Factor w/ 4 levels "Grupo 1","Grupo 2",..: 1 2 2 2 3 4 3 1 4 2 ...
##  $ TotalCharges_DISC  : Factor w/ 4 levels "Grupo 1","Grupo 2",..: 1 3 1 3 1 2 3 1 3 3 ...
##  $ TARGET             : Factor w/ 2 levels "No","Si": 1 1 2 1 2 2 1 1 2 1 ...
##  - attr(*, ".internal.selfref")=<externalptr>

Ahora se puede observar que todas las variables son de tipo “Factor”

lapply(df1,summary) #mostrar la distribución de frecuencias en cada categoría de todas las variables
## $InternetService
##         DSL Fiber optic          No 
##        2416        3096        1520 
## 
## $Contract
## Month-to-month       One year       Two year 
##           3875           1472           1685 
## 
## $PaymentMethod
## Bank transfer (automatic)   Credit card (automatic)          Electronic check 
##                      1542                      1521                      2365 
##              Mailed check 
##                      1604 
## 
## $tenure_DISC
## Grupo 1 Grupo 2 Grupo 3 Grupo 4 
##    2723    1308    1182    1819 
## 
## $MonthlyCharges_DISC
## Grupo 1 Grupo 2 Grupo 3 Grupo 4 
##    1758    1761    1755    1758 
## 
## $TotalCharges_DISC
## Grupo 1 Grupo 2 Grupo 3 Grupo 4 
##    1758    1758    1758    1758 
## 
## $TARGET
##   No   Si 
## 5163 1869

Análisis gráfico

plot_intro(df1) #gráfico para observar la distribución de variables y los casos missing por columnas, observaciones y filas

Como se ha trabajado previamente, no existen casos missing, por lo que podemos seguir el análisis descriptivo

#Análisis visual de frecuencias de cada categoría por variable
df1 %>% 
  gather() %>% 
  ggplot(aes(value)) +
  geom_bar()+
  facet_wrap(~ key, scales = "free")+
  theme(axis.text=element_text(size=4))
## Warning: attributes are not identical across measure variables;
## they will be dropped

En los gráficos anteriores pueden observarse las categorías de cada variable, algunas de ellas dicotomizadas previamente, por lo que haremos un repaso de cada una:

Internet Service: tiene tres niveles: DSL, Fiber optic, No. 

Contract (tipo de contrato): tiene tres niveles, Month-to-month, One year, Two years.

Payment Method: con tres niveles, Bank transfer, Credit card, Electronic check.

Tenure: variable originalmente cuantitativa, que se discretizó en cuatro categorías por cuartiles.

Monthly Charges: se discretizó en cuatro categorías. Grupo 1 (<= 35.59), Grupo 2 (> 35.59 & <= 70.35), Grupo 3 (> 70.35 & <= 89.86), Grupo 4 (> 89.86).

Total Charges: se discretizó en cuatro categorías. Grupo 1 (<= 401.4), Grupo 2 (> 401.4 & <= 1397.5), Grupo 3 (> 1397.5 & <= 3794.7), Grupo 4 (> 3794.7).

TARGET: con dos niveles Sí han abandonado (churn), No han abandonado (churn).

Parece que la distribución de frecuencias en todas las variables es aceptable, incluso en la variable TARGET, que suele dar más problemas.

Modelizacion

Preparando funciones

  • Matriz de confusión

  • Métricas

  • Umbrales

  • Curva ROC y AUC

Funcion para la matriz de confusion

Función para la matriz de confusión En esta función se prepara la matriz de confusión se observa qué casos coinciden entre la puntuación real (obtenida por cada sujeto) y la puntuación predicha (“puntuación”) por el modelo, estableciendo previmente un límite (“umbral”) para ello)

confusion<-function(real,scoring,umbral){ 
  conf<-table(real,scoring>=umbral)
  if(ncol(conf)==2) return(conf) else return(NULL)
}

Funcion para métricas de los modelos

Los indicadores a observar serán:

Acierto (accuracy) = (TRUE POSITIVE + TRUE NEGATIVE) / TODA LA POBLACIÓN

Precisión = TRUE POSITIVE / (TRUE POSITIVE + FALSE POSITIVE)

Cobertura (recall, sensitivity) = TRUE POSITIVE / (TRUE POSITIVE + FALSE NEGATIVE)

F1 = 2* (precisión * cobertura) (precisión + cobertura)

metricas<-function(matriz_conf){
  acierto <- (matriz_conf[1,1] + matriz_conf[2,2]) / sum(matriz_conf) *100
  precision <- matriz_conf[2,2] / (matriz_conf[2,2] + matriz_conf[1,2]) *100
  cobertura <- matriz_conf[2,2] / (matriz_conf[2,2] + matriz_conf[2,1]) *100
  F1 <- 2*precision*cobertura/(precision+cobertura)
  salida<-c(acierto,precision,cobertura,F1)
  return(salida)
}

Funcion para probar distintos umbrales

Con esta función se analiza el efecto que tienen distintos umbrales sobre los indicadores de la matriz de confusión (precisión y cobertura). Lo que buscaremnos será aquél que maximice la relación entre cobertura y precisión (F1).

umbrales<-function(real,scoring){
  umbrales<-data.frame(umbral=rep(0,times=19),acierto=rep(0,times=19),precision=rep(0,times=19),cobertura=rep(0,times=19),F1=rep(0,times=19))
  cont <- 1
  for (cada in seq(0.05,0.95,by = 0.05)){
    datos<-metricas(confusion(real,scoring,cada))
    registro<-c(cada,datos)
    umbrales[cont,]<-registro
    cont <- cont + 1
  }
  return(umbrales)
}

Funciones para calcular la curva ROC y el AUC

Por último, se preapra una función para calcular la curva ROC y el AUC.

Curva ROC (Relative Operating Characteristic): resentación gráfica de la relación entre la cobertura (proporción de verdaderos positivos) y la especificidad (razón de falsos positivos). Muestra el rendimiento del modelo en todos los umbrales de clasificación.

AUC (Area Under The Curve): mide el área que queda debajo de la curva. Indica en qué medida el modelo será capaz de clasificar adecuadamente. La AUC tiene un rango entre 0 y 1. Si es igual o cercano a 0.5, no tiene capacidad discriminativa.

roc<-function(prediction){
  r<-performance(prediction,'tpr','fpr')
  plot(r)
}

auc<-function(prediction){
  a<-performance(prediction,'auc')
  return(a@y.values[[1]])
}

Particiones de training (70%) y test (30%)

Se divide la muestra en dos partes:

Training o entrenamiento (70% de la muestra): servirá para entrenar al modelo de clasificación.

Test (30%): servirá para validar el modelo. La característica fundamental es que esta muestra no debe haber tenido contacto previamente con el funcionamiento del modelo.

# Lanzamos una semilla para que salgan siempre los mismos datos
set.seed(12345)

# Creamos los dataframes

# Generamos una variable aleatoria con una distribución 70-30
df1$random<-sample(0:1,size = nrow(df1),replace = T,prob = c(0.3,0.7)) 

train<-filter(df1,random==1)
test<-filter(df1,random==0)

#Eliminamos ya la random
df1$random <- NULL

Modelizacion con random forest

rf<-randomForest(TARGET ~ InternetService + Contract + PaymentMethod + tenure_DISC + MonthlyCharges_DISC + TotalCharges_DISC,train,importance=T)
rf
## 
## Call:
##  randomForest(formula = TARGET ~ InternetService + Contract +      PaymentMethod + tenure_DISC + MonthlyCharges_DISC + TotalCharges_DISC,      data = train, importance = T) 
##                Type of random forest: classification
##                      Number of trees: 500
## No. of variables tried at each split: 2
## 
##         OOB estimate of  error rate: 21.52%
## Confusion matrix:
##      No  Si class.error
## No 3099 482   0.1345993
## Si  580 773   0.4286770

Empleamos la función randomForest, que nos da la siguiente información:

Type of random forest: classification (ya que trabajamos con una TARGET binaria)

Number of trees: 500 árboles analizados

No. of variables tried at each split: número de variables seleccionadas para cada árbol = 2

OOB estimate of error rate: 21.52%

Además aporta una matriz de confusión

Visualizacion de importancia relativa de cada variable del modelo

varImpPlot(rf)

Aporta dos indicadores TASA DE ACIERTO (MeanDecreaseAccuracy) y el ÍNDICE DE GINI. Aunque normalmente coinciden, pueden no hacerlo.

Interpretación:

Se puede observar que:

En los dos indicadores, la variable con puntuación casi nula es MonthlyCharges_DISC.

Las siguientes variables con menos peso, en el primer indicador, es PaymentMethod, y en el segundo es TotalCharges_DISC.

Se opta por eliminar del modelo a la variable MonthlyCharges_DISC y quedarnos con las otras dos.

Descarga este codigo y datos

Codigo

xfun::embed_file("RandomForest.Rmd")

Download RandomForest.Rmd

Datos

xfun::embed_file("TelcoChurn.csv")

Download TelcoChurn.csv