#1.- INTRODUCCIÓN

Los árboles de decisión son modelos predictivos formados por reglas binarias (si/no) con las que se consigue repartir las observaciones en función de sus atributos y predecir así el valor de la variable respuesta.

Muchos métodos predictivos generan modelos globales en los que una única ecuación se aplica a todo el espacio muestral. Cuando el caso de uso implica múltiples predictores, que interaccionan entre ellos de forma compleja y no lineal, es muy difícil encontrar un único modelo global que sea capaz de reflejar la relación entre las variables. Los métodos estadísticos y de machine learning basados en árboles engloban a un conjunto de técnicas supervisadas no paramétricas que consiguen segmentar el espacio de los predictores en regiones simples, dentro de las cuales es más sencillo manejar las interacciones. Es esta característica la que les proporciona gran parte de su potencial.

Los modelos Random Forest están formados por un conjunto de árboles de decisión individuales, cada uno entrenado con una muestra ligeramente distinta de los datos de entrenamiento generada mediante bootstrapping. La predicción de una nueva observación se obtiene agregando las predicciones de todos los árboles individuales que forman el modelo.

Ventajas

Los árboles son fáciles de interpretar aun cuando las relaciones entre predictores son complejas.

Los modelos basados en un solo árbol (no es el caso de Random Forest y Boosting) se pueden representar gráficamente aun cuando el número de predictores es mayor de 3.

Los árboles pueden, en teoría, manejar tanto predictores numéricos como categóricos sin tener que crear variables dummy o one-hot-encoding. En la práctica, esto depende de la implementación del algoritmo que tenga cada librería.

Al tratarse de métodos no paramétricos, no es necesario que se cumpla ningún tipo de distribución específica.

Por lo general, requieren mucha menos limpieza y preprocesado de los datos en comparación con otros métodos de aprendizaje estadístico (por ejemplo, no requieren estandarización).

No se ven muy influenciados por outliers.

Si para alguna observación, el valor de un predictor no está disponible, a pesar de no poder llegar a ningún nodo terminal, se puede conseguir una predicción empleando todas las observaciones que pertenecen al último nodo alcanzado. La precisión de la predicción se verá reducida pero al menos podrá obtenerse.

Son muy útiles en la exploración de datos, permiten identificar de forma rápida y eficiente las variables (predictores) más importantes.

Son capaces de seleccionar predictores de forma automática.

Pueden aplicarse a problemas de regresión y clasificación.

IDEA INTUITIVA Los árboles de regresión son el subtipo de árboles de predicción que se aplica cuando la variable respuesta es continua. En términos generales, en el entrenamiento de un árbol de regresión, las observaciones se van distribuyendo por bifurcaciones (nodos) generando la estructura del árbol hasta alcanzar un nodo terminal. Cuando se quiere predecir una nueva observación, se recorre el árbol acorde al valor de sus predictores hasta alcanzar uno de los nodos terminales. La predicción del árbol es la media de la variable respuesta de las observaciones de entrenamiento que están en ese mismo nodo terminal

Introducción al algoritmo de random forest Random forest es uno de los denóminados en Machine Learning como métodos de ensamble (ensemble method), esto es, son técnicas que convinan múltiples algoritmos, permitiendo alcanzar una mayor precisión y estabilidad del modelo resultante. Los tres métodos más comunes son: Bagging, Boosting and Stacking. RF es del primero de ellos.

Por tanto, RF es un método de ensamble que permite construir una multitud de árboles decisión en la fase de entrenamiento, posibilitando corregir aspectos como el sobre ajuste (sesgo-varianza), y mejorando el resultado final. Permite tareas de clasificación, regresión y otras (como determinar la importancia relativa de las variables en un mdelo de aprendizaje).

RF trabaja de la siguiente manera: construye árboles de decisión individuales,los cuales crecen hasta su máxima extensión posible sin ue medie un proceso de poda. Para ello, se emplean con los datos de entrenamiento, pero incluyendo datos ligeramente distintos en cada árbol (bootstrapping). La predicción final, mediante un algoritmo de RF, es la media de las predicciones de todos los árboles que lo forman.

En RF es importante considerar toda una serie de hipeparámetros:

ntree: número de árboles a incluir en el modelo de RF.

mtry: número de variables predictoras como candidatas en cada ramifiación. Por defecto, apra problemas de casificación será la raiz cuadrada del número de variables, y para regresión número de variables dividido entre 3.

sampsize: el número de muestras sobre las cuales entrenar.

nodesize: mínimo número de muestras dentro de los nodos terminales. Para casos de clasificación, por defecto será 2, y para regresión será 5.

maxnodes: máximo número de nodos terminales. Por defecto, no se planifica un proceso de poda, dejando crecer los árboles hasta su límite máximo.

Características del caso de estudio El conjunto de datos ha sido previamente trabajado (limpiado de su forma original en kaggle ) en cuanto a:

análisis descriptivo

limpieza de anomalías, missing y outliers

peso predictivo de las variables mediante random forest

discretización de las variables continuas para facilitar la interpretación posterior

El objetivo del caso es predecir la probabilidad de que un determinado cliente puede abandonar (churn) la empresa. La explicación de esta conducta estará basada en toda una serie de variables predictoras que se pueden clasificar en cuatro grupos:

Churn: la variable TARGET, con puntuaciones de 0 (no abandonó la empresa) y 1 (sí abandonó la empresa)

Servicios contratados: phone, multiple lines, internet, online security, online backup, device protection, tech support, and streaming TV and movies.

Información sobre cuentas dle cliente: how long they’ve been a customer, contract, payment method, paperless billing, monthly charges, and total charges.

Variables demográficas: gender, age range, and if they have partners and dependents

Tras estudiar el peso predictivo de estas variables sobre la TARGET, finalmente se redujo el número de predictores a 6: Internet Service, Contract, Payment Method, tenure, Monthly Charges y Total Charges.

Proceso Entorno El primer punto tratará sobre la preparación del entorno, donde se mostrará la descarga de las librerías empleadas y la importación de datos.

Análisis descriptivo Se mostrarán y explicarán las funciones empleadas en este paso, dividiéndolas en tres grupos: Análisis inicial, Tipología de datos y Análisis descriptivo (gráficos).

Modelización Se preparará lo necesario para modelizar, mediante dos pasos:

Preparar funciones: Matriz de confusión Métricas

Umbrales

Curva ROC y AUC

Particiones del dataset en dos grupos: training (70%) y test (30%) Modelización con Random Forest Por motivos didácticos, se dividirá en seis pasos: Paso 1. Primer modelo

Paso 2. Segundo modelo

Paso 3. Predict

Paso 4. Umbrales

Paso 5. Matriz de confusión

Paso 6. Métricas definitivas

#2.- PRÁCTICA

#dar de alta la URL con los datos 
url_churn <- "https://raw.githubusercontent.com/AdSan-R/MachineLearning_R/main/dataset/TelcoChurn.csv"
# leer el archivo .csv
datos_churn <- read.csv(url_churn)
# Bibliotecas
library(pacman)
p_load("DT", "data.table", "dplyr", "tidyr", "ggplot2", "ROCR", "DataExplorer", "randomForest", "xfun")
# Mostrar tabla interactiva de datos
datatable(datos_churn)
# Desactivar la notación científica
options(scipen = 999)

ANÁLISIS DESCRIPTIVO

df1 <- datos_churn
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
str(df1)
## '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" ...
# Convertir en factor
df1 <- mutate_if(df1, is.character, as.factor) # Identifica las variables character y las transforma en factores

str(df1)
## '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 ...
# Análisis de frecuencias a los factores
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 DESCRIPTIVO GRÁFICO

plot_intro(df1)

No tenemos datos ausentes.

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.

Modelización

1.-Matriz de confusión 2.-Métricas 3.-Umbrales 4.-Curva ROC y AUC

# MATRIZ DE CONFUSIÓN

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)
}

Función 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)
}
# Curva de ROC
#--------------------------------------

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

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

# 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

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
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.

MODELO 2

rf2<-randomForest(TARGET ~ InternetService + Contract + PaymentMethod + tenure_DISC + TotalCharges_DISC,train,importance=T)
rf2
## 
## Call:
##  randomForest(formula = TARGET ~ InternetService + Contract +      PaymentMethod + tenure_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: 22.42%
## Confusion matrix:
##      No  Si class.error
## No 3138 443   0.1237085
## Si  663 690   0.4900222

PREDICCIONES

rf2_predict <- predict(rf2, test, type = 'prob')[,2]
head(rf2_predict)
##     1     2     3     4     5     6 
## 0.482 0.000 0.078 0.000 0.634 0.000

Lanzamos un “head” para ver los 6 primeros. Lo que quiere decir que: el sujeto 1 tendrá una probabilidad de clasificarse como 1 (Sí churn) del 48,2%. El segundo de 0,0%, etc.

plot(rf2_predict~test$TARGET)

umb_rf2<-umbrales(test$TARGET, rf2_predict)
umb_rf2
##    umbral  acierto precision cobertura       F1
## 1    0.05 75.64347  50.33289  73.25581 59.66851
## 2    0.10 77.12107  52.78638  66.08527 58.69191
## 3    0.15 77.88370  54.20712  64.92248 59.08289
## 4    0.20 79.69495  58.15217  62.20930 60.11236
## 5    0.25 80.21926  59.40410  61.82171 60.58879
## 6    0.30 80.40991  59.84991  61.82171 60.81983
## 7    0.35 80.40991  59.84991  61.82171 60.81983
## 8    0.40 80.64824  60.41667  61.82171 61.11111
## 9    0.45 80.55291  60.38462  60.85271 60.61776
## 10   0.50 80.02860  60.94808  52.32558 56.30865
## 11   0.55 80.60057  63.26034  50.38760 56.09493
## 12   0.60 80.60057  63.26034  50.38760 56.09493
## 13   0.65 80.40991  65.39589  43.21705 52.04201
## 14   0.70 80.40991  65.39589  43.21705 52.04201
## 15   0.75 80.40991  65.39589  43.21705 52.04201
## 16   0.80 80.40991  65.39589  43.21705 52.04201
## 17   0.85 79.93327  66.10169  37.79070 48.08878
## 18   0.90 79.40896  67.07317  31.97674 43.30709
## 19   0.95 79.07531  67.74194  28.48837 40.10914

Como puede observarse en la tabla anterior, el indicador F1 crece a medida que los umbrales aumentan (esto es, se maximiza progresivamente la F1), pero llega a un punto que empieza a decrecer: umbral de 0.4.

umbral_final_rf2<-umb_rf2[which.max(umb_rf2$F1),1]
umbral_final_rf2
## [1] 0.4

MATRIZ DE CONFUSIÓN

confusion(test$TARGET,rf2_predict,umbral_final_rf2)
##     
## real FALSE TRUE
##   No  1373  209
##   Si   197  319
rf2_metricas <- filter(umb_rf2,umbral==umbral_final_rf2)
rf2_metricas
##   umbral  acierto precision cobertura       F1
## 1    0.4 80.64824  60.41667  61.82171 61.11111
# Creamos el objeto de prediction
rf2_prediction<-prediction(rf2_predict, test$TARGET)
# visualizamos la ROC
roc(rf2_prediction)

rf2_metricas<-cbind(rf2_metricas, AUC=round(auc(rf2_prediction),2)*100)
print(t(rf2_metricas))
##               [,1]
## umbral     0.40000
## acierto   80.64824
## precision 60.41667
## cobertura 61.82171
## F1        61.11111
## AUC       82.00000

Obtenemos las métricas definitivas añadiendo la métrica AUC, que indica el porcentaje de predicción del modelo, un 82% (> 75%), lo que indica que es un buen modelo.