10 Caso de estudio: muestra desbalanceda y k-folds

Objetivos del capítulo

Al finalizar la lectura de este capítulo el lector estará en capacidad de:

Encontrar en R el mejor modelo de clasificación empleando como criterio de validación k-fold.
Encontrar en R el mejor modelo de clasificación a partir de una muestra desbalanceda.

10.1 Introducción

En este capítulo aplicaremos todo lo estudiado hasta el momento. A lo largo del libro hemos desarrollado un ejemplo para datos de varias campañas de marketing directo de una institución bancaria portuguesa (Moro et al., 2014). En cada capítulo aplicábamos un modelo diferente de clasificación intentando responder la pregunta de negocios: ¿se puede construir un modelo que pueda predecir si un cliente adquirirá o no el producto bancario?.

Adicionalmente, en cada uno de los capítulos empleamos para realizar la validación cruzada de cada modelo el método de retención o holdout method (Ver Sección 2.2.1 para una discusión del método). El método de retención implica reservar una proporción de la muestra (en nuestro caso el 20%) para realizar la evaluación del modelo que es estimado o entrenado con el restante 80% de la muestra.

Recordemos que es una buena práctica realizar una validación cruzada de un modelo para evitar un posible overfitting o sobreajustes del modelo. La validación cruzada nos permite evaluar la capacidad predictiva del modelo de una manera más robusta al probarlo en diferentes conjuntos de datos. En la Sección 2.2 discutimos otras metodologías para hacer validación cruzada, una de ellas (y tal vez la más usada en la práctica) es $k$ iteraciones o k-fold Cross-validation.

El método k-folds implica dividir de manera aleatoria la muestra completa en $k grupos$ de aproximadamente el mismo tamaño. Para cada uno de los $k$ grupos (o iteraciones) se emplean los restantes $k-1$ grupos como muestra de estimación y el grupo $k$ de observaciones se emplea como muestra de evaluación para la cual se calculan las respectivas métricas deseadas para los modelos a comparar. Y finalmente, para obtener la métrica para todo el ejercicio se calcula el promedio de las $k$ métricas calculadas para cada modelo (Ver Figura 2.3). En este capítulo estudiaremos cómo implementar el método de k-folds en R.

Otro tema que hemos evadido en el libro, es el tema de las muestras desbalanceadas. En este Capítulo discutiremos brevemente que opciones tenemos para solucionar el sesgo que puede producir una muestra desbalanceada y cómo implementar esto en R.

10.1.1 Sobre las muestras desbalanceadas

Una muestra desbalanceada, en el contexto de modelos de clasificación en ciencia de datos, se refiere a una muestra en el que las clases que se quieren predecir están representadas por un número desproporcionado de observaciones. Esto significa que una clase puede estar subrepresentada en comparación con otras clases en el conjunto de datos. Recordemos, que como lo discutimos en el Capítulo 3, si la muestra tiene “muy pocos” valores de una de las clases de la variable dependiente se puede producir un problema de sesgo por datos desbalanceados. Dicho sesgo se puede solucionar utilizando técnicas de muestreo para equilibrar las clases. Algunas de estas técnicas incluyen el submuestreo de la clase mayoritaria o el sobremuestreo de la clase minoritaria. Otra opción es utilizar algoritmos de clasificación que sean menos sensibles al desbalance de clases, como el Random Forest (Ver Capítulo 8) o el Support Vector Machine (Ver Capítulo 9). Cómo solucionar ese problema se discutirá en parte en el Capítulo 10.

En el ejercicio realizado en todos los capítulos hemos empleado una muestra en la que la proporción de clientes que adquirieron el producto era de 11.27%. Si bien es discutible, en el Capítulo 3 argumentamos que esa muestra era relativamente balanceada entre los no y los yes. Esta afirmación es muy discutible. Algunos autores como Chawla et al. (2002), Weiss & Provost (2003) y Garcı́a et al. (2010) consideran que una muestra está desbalanceada cuando una clase representa menos del 20% de las observaciones totales. Otros autores como Batista et al. (2004), He & Garcia (2009) y Weiss & Provost (2003) argumentan que el umbral debería ser 10%. No existe un consenso sobre que umbral debería emplearse para determinar cuándo una muestra se considera desbalanceada, pues puede depender del problema específico y del dominio de aplicación.

Para solucionar el problema de una muestra desbalanceada, existen varias técnicas que se pueden aplicar, las cuales se pueden dividir en dos categorías:

Modificación del conjunto de datos (muestreo de datos)
Modificación del algoritmo (asignación de pesos)

La primera aproximación implica modificar, por muestreo aleatorio, la composición de los datos originales de tal manera que no estén desbalanceados. Entre las técnicas de remuestreo encontramos:

Submuestreo (Down-sampling): Se eliminan aleatoriamente individuos de la clase mayoritaria para equilibrar la distribución de las clases. Sobremuestreo (Up-sampling): Se “crean nuevos” individuos de la clase minoritaria para aumentar su tamaño. Existen diferentes técnicas para realizar el sobremuestreo, como la generación de datos “sintéticos” o el remuestreo con reemplazo.
SMOTE (Synthetic Minority Over-sampling Technique o Técnica de muestreo sintético de minorías): Es una técnica de sobremuestreo que genera nuevos ejemplos de la clase minoritaria a partir de sus vecinos más cercanos a la vez que genera un muestreo descendente de la clase mayoritaria.

Por otro lado, entre las técnicas que modifican el algoritmo encontramos el ajuste de pesos o ponderaciones. En este caso se asignan diferentes pesos a las clases durante el entrenamiento del modelo, dando mayor importancia a la clase minoritaria. En últimas, se impone un peso mayor cuando se cometen errores en la clase minoritaria.

También se puede “lidiar” con este problema empleando métricas que no sean sensibles al desbalance de datos, como la precisión por clase o el F1-score. Otra opción es emplear algoritmos específicos para datos desbalanceados. Por ejemplo, existen algunos algoritmos de machine learning que están diseñados específicamente para manejar el desbalance de datos, como el Random Oversampling Ensemble (ROSE) o el AdaBoost.

Más adelante en este capítulo emplearemos la técnica de remuestreo Down-sampling para balancear nuestra muestra. Pero antes hablemos de los datos que emplearemos, el contexto y la pregunta de negocio.

10.2 La pregunta de negocio y los datos

Una gran superficie está preparando sus rebajas habituales de fin de año. El departamento de mercadeo lanzará una oferta similar a la lanzada el año anterior: la afiliación oro a un precio de $499 durante el evento de fin de año. La afiliación oro ofrece un 20% de descuento en todas las compras del año por un pago que regularmente es de $999. La oferta solo sería válida para los clientes actuales. Además la oferta implicaría una campaña telefónica en la que se llamaría a los clientes (Raza, 2023).

La gerencia cree que la mejor forma de reducir los costos de la campaña es crear un modelo que clasifique a los clientes que podrían adquirir la oferta y solo llamar a aquellos clientes con alta probabilidad de comprar la oferta.

Contamos con una base de datos con 22 variables que recopila los resultados de la campaña similar del año anterior. Los datos fueron provistos por Raza (2023) y están disponibles en el archivo superstore_data.csv⁶⁹.

Las variables con las que se cuentan son:

Response (target): 1 si el cliente aceptó la oferta en la última campaña, 0 en caso contrario.
ID: ID único de cada cliente.
Year_Birth: Edad del cliente.
Complain: 1 si el cliente se quejó en los últimos 2 años.
Dt_Customer: fecha de inscripción del cliente en la gran superficie.
Education: nivel de estudios del cliente.
Marital: estado civil del cliente.
Kidhome: número de niños pequeños en el hogar del cliente.
Teenhome: número de adolescentes en el hogar del cliente.
Income: ingresos familiares anuales del cliente.
MntFishProducts: gasto en productos de pescadería en los últimos 2 años.
MntMeatProducts: gasto en productos cárnicos en los últimos 2 años
MntFruits: gasto en productos de fruta en los últimos 2 años.
MntSweetProducts: gasto en productos dulces en los últimos 2 años
MntWines: gasto en productos vinícolas en los últimos 2 años.
MntGoldProds: gasto en productos de oro en los últimos 2 años.
NumDealsPurchases: número de compras realizadas con descuento.
NumCatalogPurchases: número de compras realizadas por catálogo (compra de productos que se envían por correo).
NumStorePurchases: número de compras realizadas directamente en tiendas.
NumWebPurchases: número de compras realizadas a través del sitio web de la empresa.
NumWebVisitsMonth: número de visitas al sitio web de la empresa en el último mes.
Recency: número de días transcurridos desde la última compra.

10.3 Preprocesamiento de los datos

Carguemos primero los datos.

library(readr)
datos_originales <- read_csv("./datos/superstore_data.csv", 
       col_types = cols(Education = col_factor(levels = c("2n Cycle", 
         "Basic", "Graduation", "Master", 
         "PhD")), 
          Dt_Customer = col_datetime(format = "%m/%d/%Y"),
         Marital_Status = col_factor(levels = c("Absurd", 
         "Alone", "Divorced", "Married", "Single", 
         "Together", "Widow", "YOLO")),
         Complain = col_factor(levels = c("1", "0"))
         ))

Nota que hay unas variables que por si solas no son útiles como Year_Birth (año de nacimiento) y Dt_Customer (fecha de inscripción del cliente en la gran superficie.), pero si podríamos emplearlas para calcular variables cuantitativas. Por ejemplo, creemos las variable edad del cliente (edad_dias), así como el número de días desde que el cliente está vinculado con el negocio (Dias_cliente). Supongamos que estamos el último día del año 2022. No es clara la fecha en que se suben los datos pero el archivo de Excel tiene fecha de creación el 2 de enero de 2023.

library(dplyr)
library(lubridate)

#Cambiar a formato fecha la variable  Dt_Customer
   

hoy <-    date(as.POSIXlt("12/31/2022", format="%m/%d/%Y"))
#crear variable de días como cliente
datos_originales$Dias_cliente <- as.numeric(difftime(date(hoy), datos_originales$Dt_Customer, units = "days"))

# Crear variable de edad en años (aproximadamente)

datos_originales$edad_dias <- 2022 - datos_originales$Year_Birth

Además, noten que tenemos 24 valores perdidos en la variable Income. Esto nos generará problemas, como son tan pocos datos, borremos las filas que tengan algún dato perdido.

datos_originales <- datos_originales %>%  
  na.omit()

Adicionalmente, separemos las variables cualitativas de las cuantitativas. En este caso también será necesario crear variables dummy para las variables cualitativas.

x_cuanti <- datos_originales %>% 
  dplyr::select(Income, Kidhome, Teenhome, Recency,
                MntWines, MntFruits, MntMeatProducts, 
                MntFishProducts, MntSweetProducts, 
                MntGoldProds, NumDealsPurchases, NumWebPurchases, 
                NumCatalogPurchases, NumStorePurchases, 
                NumWebVisitsMonth, Dias_cliente,  edad_dias)
# Estandarizar las variables cuanti

x_cuanti_estand <- x_cuanti %>% 
              scale()

#  Variables cualitativas
x_cuali <- datos_originales %>% 
  dplyr::select(Education, Marital_Status, Complain)



# Crear variables dummy
library(fastDummies)
x_dummies <- dummy_cols(x_cuali, remove_most_frequent_dummy = TRUE, remove_selected_columns = TRUE)

# Crear variable objetivo
y <- relevel(as.factor(datos_originales$Response), ref = "1")

# Crear bases de datos
# 1 Variables cuali sin estandarizadas + dummies
datos_con_dummies <- cbind(y, x_cuanti, x_dummies)

# 2 Variables cuali estandarizadas + dummies
datos_estand_dummies <- cbind(y, x_cuanti_estand, x_dummies)

# 3 Variables solo cuali estandarizadas 
datos_estand <- bind_cols(y, x_cuanti_estand)

## New names:
## • `` -> `...1`

 names(datos_estand)[1] <- "y" 

# 4 Variables solo cuali sin estandarizadas 
datos_cuali <- as.data.frame(cbind(y, x_cuanti))

# 5 Variables cuali y cuantitativas
datos_estand_cuali <- cbind(y, x_cuanti_estand, x_cuali)

Noten que estamos trabajando con una muestra cuyo balance puede ser discutible.

table(y)/length(y)*100

## y
##        1        0 
## 15.02708 84.97292

Si bien en todo el libro hemos considerado una muestra balanceada aquella que tiene el 10% o menos de la muestra en la clase minoritaria, en este capítulo consideraremos que la muestra está balanceada (Ver Sección 10.1.1 para una discusión del tema).

Dada la aproximación que emplearemos para la validación cruzada y que emplearemos la “infraestructura” del paquete caret (Kuhn & Max, 2008), no será necesario crear la muestra de estimación y la muestra de evaluación.

10.4 Muestras desbalanceadas y validación cruzada con caret

Como se mencionó anteriormente, en este caso emplearemos la técnica de remuestreo Down-sampling que nos permita balancear nuestra muestra. Esta técnica se puede implementar fácilmente con el paquete caret. En la función trainControl() que ya conoces (Ver Sección 9.3) existe el argumento sampling. Este argumento tiene por defecto el valor de “none”, que corresponde a ningún remuestreo. Si sampling = “down”, se realizará un Down-sampling. Las otras opciones son “up” y “smote”.

Por otro lado, hasta aquí hemos realizado una validación cruzada de los modelos empleando el método de retención. Para emplear el método de k-folds, con $k = 5$ también podemos emplear la función trainControl(). Esta vez el argumento method, permite especificar el método de validación cruzada. Si method = “cv” se empleará el método k-folds, además será necesario emplear el argumento number para establecer el número de folds. Nota que si ponemos number = 1 entonces estaremos empleando el método de retención. Si deseamos emplear el método de LOOCV entonces method = “LOOCV”.

10.5 Tuneo de los modelos en R

Es decir, para implementar el Down-sampling y la validacion de 5 iteraciones, emplearemos por lo menos los siguientes argumentos en la función trainControl():

sampling = “down”
method = “cv”
number = 5

Así mismo, para reducir el tiempo de computo, solo emplearemos el Accuracy como el criterio para seleccionar los mejores modelos al interior de los respectivos algoritmos. Es decir, emplearemos el argumento metric = ‘Accuracy’ en la función train(). Adicionalmente, para agilizar el proceso, omitiremos el modelo Logit de nuestos análisis. Tu puedes realizar los cálculos y encontrarás que este modelo tiene un mal comportamiento para estos datos. Procedamos a tunear los diferentes modelos.

10.5.1 Entrenamiento del modelo Naive Bayes

Noten que en este caso no es necesario tunear el modelo. Es decir, no es necesario hacer una búsqueda de parámetros. No obstante, podremos emplear la infraestructura de caret para realizar la validación cruzada con k-folds y el submuestreo.

Empecemos por establecer las condiciones bajo las cuales se realizará el ejercicio de “tunning”. En este caso además estamos adicionando el argumento savePredictions = final para que se guarde la predicción en la muestra de evaluación de cada uno de los 5 folds para el modelo óptimo. Esto nos servirá para construir la tabla resumen que necesitaremos más adelante para comparar los resultados:

# Cargar la librería

library(caret)


# Fijar la forma como se realizará el tunninng 
metodo_tune <- trainControl( 
                   method = "cv", # k-fold
                   number = 5, # k =5 en k-fold
                   sampling = "down", # Down-sampling
                   savePredictions = "final" # Guardar todos los 
                                      # y predichos fuera de
                                      # muestra
                   )

En este caso no se necesita hacer una búsqueda de grilla, por eso no tenemos que emplear la función expand.grid().

Ahora, solo necesitamos entrenar el modelo Naive Bayes empleando la función train(). Para entrenar el modelo Naive Bayes debemos emplear method = “nb”. Esto empleará la correspondiente función del paquete klaR. Sino cuentas con este modelo, lo debes instalar antes.

En este caso la línea de código será:

set.seed(123)

## empezar el tunning para el modelo Naive Bayes
modelo_nb <- train(form = y ~ ., data = datos_cuali,
                         method = "nb",
                         trControl = metodo_tune,
                         metric = 'Accuracy')

Noten que idealmente deberíamos emplear la base de datos con los datos cuantitativos y las dummies. No obstante, dada las pocas observaciones de algunas clases (como por ejemplo “YOLO” en Marital) esto genera problemas de poca o nula varianza en algunos de los folds. Por esto optamos por emplear solo las variables cuantitativas. Este es un problema de esta base y no necesariamente será igual en todas las bases de datos.

Veamos los resultados:

modelo_nb

## Naive Bayes 
## 
## 2216 samples
##   17 predictor
##    2 classes: '1', '0' 
## 
## No pre-processing
## Resampling: Cross-Validated (5 fold) 
## Summary of sample sizes: 1772, 1773, 1773, 1774, 1772 
## Addtional sampling using down-sampling
## 
## Resampling results across tuning parameters:
## 
##   usekernel  Accuracy   Kappa    
##   FALSE      0.6827683  0.1920558
##    TRUE      0.6588630  0.1780516
## 
## Tuning parameter 'fL' was held constant at a value of 0
## Tuning
##  parameter 'adjust' was held constant at a value of 1
## Accuracy was used to select the optimal model using the largest value.
## The final values used for the model were fL = 0, usekernel = FALSE and adjust
##  = 1.

En este caso, las métricas (promedio) para los 5-folds los podemos encontrar empleando la función confusionMatrix().

confusionMatrix(modelo_nb)

## Cross-Validated (5 fold) Confusion Matrix 
## 
## (entries are percentual average cell counts across resamples)
##  
##           Reference
## Prediction    1    0
##          1  9.0 25.7
##          0  6.0 59.3
##                             
##  Accuracy (average) : 0.6828

10.5.2 Entrenamiento del modelo kNN

Sigamos empleando la infraestructura del paquete caret para entrenar el modelo de árboles de decisión. Inicialmente, definamos cómo se realizará el ejercicio de tunning.

# Fijar la forma como se realizará el tunninng 
metodo_tune <- trainControl( 
                   method = "cv", # k-fold
                   number = 5, # k =5 en k-fold
                    search = "grid", 
                   sampling = "down", # Down-sampling
                    savePredictions = "final" # Guardar todos los 
                                      # y predichos fuera de
                                      # muestra
                   )

Recodemos que kNN no permite usar variables cualitativas y las cualitativas deberían estar estandarizas. Así emplearemos el objeto datos_estand.

En este caso, el parámetro que debemos “tunear” es $k$. Emplearemos una grilla de búsqueda inusualmente alta, porque al empezar con una grilla pequeña, el $k$ óptimo estaba muy cerca al valor superior de la grilla (inténtalo). De esta manera, se “jugo” iterativamente con el límite superior de la grilla, hasta encontrar que la escogencia del límite superior de la grilla no tenía un efecto sobre el óptimo seleccionado.

Recordemos que cuando se entrena un modelo de Machine Learning, se utiliza un conjunto de datos que se supone que es una muestra de la distribución estadística real que se desea modelar. Esto significa, que el conjunto de datos no refleja totalmente la distribución real y contendrá anomalías, excepciones o cierta aleatoriedad. Un modelo sobreajustado (overfit) se ceñiría demasiado a las particularidades de este conjunto de datos y sería demasiado “variable”, en lugar de aprender patrones estadísticos que suavizarían estas particularidades y acercarían el modelo a la distribución estadística real.

En el caso de kNN, $k$ controla el tamaño del vecindario utilizado para modelar las propiedades estadísticas locales. Un valor muy pequeño de $k$ hace que el modelo sea más sensible a las anomalías y excepciones locales, dando demasiado peso a estos puntos concretos. Por el contrario, un valor de $k$ demasiado grande haría que el modelo ignorara la estructura local de la distribución que intenta aprender, y produciría un modelo infraajustado (underfit). Cómo se discutió en el Capítulo 6 es importante encontrar el $k$ óptimo y lo mejor sería una búsqueda de grilla.

Para establecer el máximo $k$ en nuestra búsqueda de grilla seguiremos a Dasarathy (1991) (Ver Capítulo 6). En nuestro caso $P =$ 333 y $N =$ 1883, olvidando que emplearemos la validación cruzada de 5-folds, el $k$ máximo para nuestra búsqueda de grilla sería 666. Como tendremos una validación cruzada de 5-folds tendremos aproximadamente 80% las observaciones en la muestra de entrenamiento. Así redondeando emplearemos como límite máximo $k = 500$. Así tendremos:

# Establecer la grilla de búsqueda para el costo
grilla_busqueda <- expand.grid(k = seq(3,500, by = 1))

Y empleemos ahora la función train().

modelo_kNN <- train(form = y ~ ., data = datos_estand,
                         method = "knn",
                         trControl = metodo_tune,
                         tuneGrid = grilla_busqueda,
                         metric = 'Accuracy')

Veamos el valor de $k$ que maximiza el accuracy

modelo_kNN$bestTune

##       k
## 469 471

Y la matriz de confusión promedio de los 5-folds es:

confusionMatrix(modelo_kNN)

## Cross-Validated (5 fold) Confusion Matrix 
## 
## (entries are percentual average cell counts across resamples)
##  
##           Reference
## Prediction    1    0
##          1  6.1 11.5
##          0  8.9 73.5
##                            
##  Accuracy (average) : 0.796

10.5.3 Entrenamiento del modelo árboles de decisión

Sigamos empleando la infraestructura del paquete caret para entrenar el modelo de árboles de decisión.

En este caso no es necesario definir nuevamente cómo se realizará el ejercicio de tunning, pues es igual al caso anterior. En este caso el parámetro tunear es cp.

# Establecer la grilla de búsqueda para el costo

grilla_busqueda <-  expand.grid(cp = c(0, 0.1, 1, 10, 50, 70))

Y ahora entrenemos el modelo empleando method = “rpart” para invocar la función rpart() del paquete rpart que estudiamos anteriormente y parms = list(split = “gini”) para definir el coeficiente de Gini como el criterio para generar los splits. Recuerden que en este caso podemos emplear las variables cualitativas estandarizadas y las variables dummy.

## arboles de decisión usando coeficiente de entropía
modelo_DT <- train(y ~ ., data = datos_estand_cuali,
                             method = "rpart",
                             metric = 'Accuracy',
                             trControl = metodo_tune,
                             tuneGrid = grilla_busqueda,
                             parms = list(split = "gini"))

Veamos los resultados.

modelo_DT$bestTune

##   cp
## 1  0

En este caso, las métricas (promedio) para los 5-folds los podemos encontrar empleando la función confusionMatrix().

confusionMatrix(modelo_DT)

## Cross-Validated (5 fold) Confusion Matrix 
## 
## (entries are percentual average cell counts across resamples)
##  
##           Reference
## Prediction    1    0
##          1 11.0 24.5
##          0  4.0 60.4
##                             
##  Accuracy (average) : 0.7144

10.5.4 Entrenamiento del modelo Random Forest

Emplearemos la misma definición del ejercicio de tunning que antes (ver objeto metodo_tune). Recordemos que en este caso el hiperparámetro que se debe tunear es mtry (El número de variables que se remuestrean aleatoriamente para ser muestreado en cada split)⁷⁰.

grilla_busqueda <- expand.grid(.mtry=seq(1,sqrt(ncol(datos_estand_cuali)-1)))

set.seed(123)
modelo_rf <- train(y ~ ., data = datos_estand_cuali,
                          method = "rf",
                          trControl = metodo_tune,
                          tuneGrid = grilla_busqueda,
                          metric = 'Accuracy')

Veamos los resultados.

modelo_rf$bestTune

##   mtry
## 3    3

En este caso, las métricas (promedio) para los 5-folds los podemos encontrar empleando la función confusionMatrix().

confusionMatrix(modelo_rf)

## Cross-Validated (5 fold) Confusion Matrix 
## 
## (entries are percentual average cell counts across resamples)
##  
##           Reference
## Prediction    1    0
##          1 12.1 20.6
##          0  2.9 64.4
##                             
##  Accuracy (average) : 0.7644

10.5.5 Entrenamiento del modelo SMV con kernel lineal

Emplearemos el mismo metodo_tune y en este caso tenemos:

# Establecer la grilla de búsqueda para el costo
grilla_busqueda <- expand.grid(C = c(0.01,0.1,1,10,50))

set.seed(123)

## empezar el tunning para el modelo svm con kernel lineal
modelo_svm_lineal <- train(form = y ~ ., data = datos_estand_cuali,
                         method = "svmLinear",
                         trControl = metodo_tune,
                         metric = 'Accuracy',
                         tuneGrid = grilla_busqueda)

Veamos los resultados.

modelo_svm_lineal$bestTune

##   C
## 3 1

En este caso, las métricas (promedio) para los 5-folds los podemos encontrar empleando la función confusionMatrix().

confusionMatrix(modelo_svm_lineal)

## Cross-Validated (5 fold) Confusion Matrix 
## 
## (entries are percentual average cell counts across resamples)
##  
##           Reference
## Prediction    1    0
##          1 11.7 20.9
##          0  3.3 64.0
##                             
##  Accuracy (average) : 0.7577

10.5.6 Entrenamiento del modelo SVM con kernel polinómico

De manera similar, el código para el modelo SMV con kernel polinómico será:

# Establecer la grilla de búsqueda para el modelo SVM kernel polimonial
grilla_busqueda <- expand.grid(
  C =  c(0.01,0.1,1,10),
  degree = c(2, 3),
  scale = 0.01)

# Tunear el modelo SVM kernel polimonial

modelo_svm_pol <- train(y ~ ., data = datos_estand_cuali,
                         method = "svmPoly",
                         trControl = metodo_tune,
                         metric = 'Accuracy',
                         tuneGrid = grilla_busqueda
)

Veamos los resultados.

modelo_svm_pol$bestTune

##   degree scale    C
## 2      3  0.01 0.01

En este caso, las métricas (promedio) para los 5-folds los podemos encontrar empleando la función confusionMatrix().

confusionMatrix(modelo_svm_pol)

## Cross-Validated (5 fold) Confusion Matrix 
## 
## (entries are percentual average cell counts across resamples)
##  
##           Reference
## Prediction    1    0
##          1  4.3  9.1
##          0 10.7 75.9
##                             
##  Accuracy (average) : 0.8019

10.5.7 Entrenamiento del modelo SVM con kernel RBF

Ya será evidente para tí que el código para el modelo SMV con kernel RBF será:

# Establecer la grilla de búsqueda para el modelo SVM kernel RBF

grilla_busqueda <- expand.grid(
  C =  c(0.01,0.1,1,10),
  sigma = c(0.01, 0.1,1))

modelo_svm_rbf <- train(y ~ ., data = datos_estand_cuali,
                         method = "svmRadial",
                         trControl = metodo_tune,
                         metric = 'Accuracy',
                         tuneGrid = grilla_busqueda
)

Veamos los resultados.

modelo_svm_rbf$bestTune

##   sigma C
## 9     1 1

En este caso, las métricas (promedio) para los 5-folds los podemos encontrar empleando la función confusionMatrix().

confusionMatrix(modelo_svm_rbf)

## Cross-Validated (5 fold) Confusion Matrix 
## 
## (entries are percentual average cell counts across resamples)
##  
##           Reference
## Prediction    1    0
##          1  3.0  7.2
##          0 12.0 77.8
##                             
##  Accuracy (average) : 0.8078

10.6 Comparación de los modelos

Ahora que tenemos los respectivos objetos con los mejores modelos tuneados, podemos proceder a construir la tabla resumen. Nota que los valores predichos para cada fold del mejor modelo se encuentra en el slot pred de los respectivos objetos. El siguiente código produce los resultados que se presentan en el Cuadro 10.1.

library(caret)
# métricas Naive Bayes
metricas_nb <- data.frame()
acc_nb <- data.frame()

for(i in unique(modelo_nb$pred$Resample)) {
  base_t <- modelo_nb$pred %>% filter(Resample == i)
  
  m <- confusionMatrix(base_t$pred, base_t$obs)
  metricas_nb <- rbind(metricas_nb, m$byClass)
  acc_nb <-rbind(acc_nb, m$overall[1])
}
names(metricas_nb) <- names(m$byClass)
names(acc_nb) <- names(m$overall[1])
metricas_nb <- bind_cols(metricas_nb, acc_nb)
metricas_nb$Modelo <- "Naive Bayes"

# métricas kNN
metricas_kNN <- data.frame()
acc_kNN <- data.frame()
for(i in unique(modelo_kNN$pred$Resample)) {
  base_t <- modelo_kNN$pred %>% filter(Resample == i)
  
  m <- confusionMatrix(base_t$pred,base_t$obs)
  metricas_kNN <- rbind(metricas_kNN,m$byClass)
  acc_kNN <-rbind(acc_kNN, m$overall[1])
}
names(metricas_kNN) <- names(m$byClass)
names(acc_kNN) <- names(m$overall[1])
metricas_kNN <- bind_cols(metricas_kNN, acc_kNN)
metricas_kNN$Modelo <- "kNN"

# métricas DT_gini_500obs
metricas_DT <- data.frame()
acc_DT <- data.frame()
for(i in unique(modelo_DT$pred$Resample)) {
  base_t <- modelo_DT$pred %>% filter(Resample == i)
  
  m <- confusionMatrix(base_t$pred,base_t$obs)
  metricas_DT <- rbind(metricas_DT,m$byClass)
  acc_DT <-rbind(acc_DT, m$overall[1])
}
names(metricas_DT) <- names(m$byClass)
names(acc_DT) <- names(m$overall[1])
metricas_DT <- bind_cols(metricas_DT, acc_DT)
metricas_DT$Modelo <- "DT gini 500obs"

# métricas Randomo Forest
metricas_rf <- data.frame()
acc_rf <- data.frame()
for(i in unique(modelo_rf$pred$Resample)) {
  base_t <- modelo_rf$pred %>% filter(Resample == i)
  
  m <- confusionMatrix(base_t$pred,base_t$obs)
  metricas_rf <- rbind(metricas_rf,m$byClass)
  acc_rf <-rbind(acc_rf, m$overall[1])
}
names(metricas_rf) <- names(m$byClass)
names(acc_rf) <- names(m$overall[1])
metricas_rf <- bind_cols(metricas_rf, acc_rf)
metricas_rf$Modelo <- "Random Forest"

# métricas SVM lineal
metricas_svm_lineal <- data.frame()
acc_svm_lineal <- data.frame()
for(i in unique(modelo_svm_lineal$pred$Resample)) {
  base_t <- modelo_svm_lineal$pred %>% filter(Resample == i)
  
  m <- confusionMatrix(base_t$pred,base_t$obs)
  metricas_svm_lineal <- rbind(metricas_svm_lineal,m$byClass)
  acc_svm_lineal <-rbind(acc_svm_lineal, m$overall[1])
}
names(metricas_svm_lineal) <- names(m$byClass)
names(acc_svm_lineal) <- names(m$overall[1])
metricas_svm_lineal <- bind_cols(metricas_svm_lineal, acc_svm_lineal)
metricas_svm_lineal$Modelo <- "SVM lineal"

# métricas SVM polinomial
metricas_svm_pol <- data.frame()
acc_svm_pol <- data.frame()
for(i in unique(modelo_svm_pol$pred$Resample)) {
  base_t <- modelo_svm_pol$pred %>% filter(Resample == i)
  
  m <- confusionMatrix(base_t$pred,base_t$obs)
  metricas_svm_pol <- rbind(metricas_svm_pol,m$byClass)
  acc_svm_pol <-rbind(acc_svm_pol, m$overall[1])
}
names(metricas_svm_pol) <- names(m$byClass)
names(acc_svm_pol) <- names(m$overall[1])
metricas_svm_pol <- bind_cols(metricas_svm_pol, acc_svm_pol)
metricas_svm_pol$Modelo <- "SVM pol"


# métricas SVM RBF
metricas_svm_rbf <- data.frame()
acc_svm_rbf <- data.frame()
for(i in unique(modelo_svm_rbf$pred$Resample)) {
  base_t <- modelo_svm_rbf$pred %>% filter(Resample == i)
  
  m <- confusionMatrix(base_t$pred,base_t$obs)
  metricas_svm_rbf <- rbind(metricas_svm_rbf,m$byClass)
  acc_svm_rbf <-rbind(acc_svm_rbf, m$overall[1])
}
names(metricas_svm_rbf) <- names(m$byClass)
names(acc_svm_rbf) <- names(m$overall[1])
metricas_svm_rbf <- bind_cols(metricas_svm_rbf, acc_svm_rbf)
metricas_svm_rbf$Modelo <- "SVM RBF"

# unir todas las métricas
tabla_1 <- bind_rows(metricas_nb, metricas_kNN, metricas_DT,
                     metricas_rf, metricas_svm_lineal,
                     metricas_svm_pol, metricas_svm_rbf)
# Extraer las métricas que queremos
tabla <- tabla_1 %>% 
  group_by(Modelo) %>% 
  summarise('Exactitud (ACC)' = mean(Accuracy),
            'Sensibiliad (TPR) (Recall)' = mean(Sensitivity),
            'Especificidad (TNR)' = mean(Specificity),
            'Precisión (PPV)' = mean(Precision),
            F1 = mean(F1)) %>% 
            arrange(desc(`Precisión (PPV)`))

Cuadro 10.1: Métricas de comparación para todos los modelos de clasificación (organizadas por precisión)
Modelo	Exactitud (ACC)	Sensibiliad (TPR) (Recall)	Especificidad (TNR)	Precisión (PPV)	F1
SVM pol	0.802	0.287	0.893	0.457	0.272
Random Forest	0.764	0.805	0.757	0.371	0.507
SVM lineal	0.758	0.781	0.754	0.360	0.492
kNN	0.796	0.409	0.865	0.346	0.374
DT gini 500obs	0.714	0.733	0.711	0.311	0.436
SVM RBF	0.808	0.201	0.915	0.289	0.235
Naive Bayes	0.683	0.598	0.698	0.259	0.361
Fuente: elaboración propia.

La mejor métrica para responder la pregunta de negocio parece ser la precisión⁷¹. Por eso el mejor modelo sería el SVM pol.

Una vez establecido que éste es el mejor modelo, se emplearía para predecir sobre la base de datos de los actuales clientes. De esta manera el modelo debería proveer un listado de los clientes actuales que se predicen como “1”. Es decir, aquellos que comprarían la afiliación oro. Es decir, el listado de clientes clasificados como “1” debería ser el producto que se le entrega al departamento de mercadeo. El departamento de mercadeo llamaría a todos los clientes que hagan parte de este listado.

Referencias

Batista, G. E., Prati, R. C., & Monard, M. C. (2004). A study of the behavior of several methods for balancing machine learning training data. ACM SIGKDD Explorations Newsletter, 6(1), 20–29.

Chawla, N. V., Bowyer, K. W., Hall, L. O., & Kegelmeyer, W. P. (2002). SMOTE: Synthetic minority over-sampling technique. Journal of Artificial Intelligence Research, 16, 321–357.

Dasarathy, B. V. (1991). Nearest neighbor (NN) norms: NN pattern classification techniques. IEEE Computer Society Tutorial.

Garcı́a, S., Fernández, A., Luengo, J., & Herrera, F. (2010). Advanced nonparametric tests for multiple comparisons in the design of experiments in computational intelligence and data mining: Experimental analysis of power. Information Sciences, 180(10), 2044–2064.

He, H., & Garcia, E. A. (2009). Learning from imbalanced data. IEEE Transactions on Knowledge and Data Engineering, 21(9), 1263–1284.

Kuhn, & Max. (2008). Building predictive models in r using the caret package. Journal of Statistical Software, 28(5), 1–26. https://doi.org/10.18637/jss.v028.i05

Moro, S., Cortez, P., & Rita, P. (2014). A data-driven approach to predict the success of bank telemarketing. Decision Support Systems, 62, 22–31.

Raza, A. (2023). Superstore marketing campaign dataset. Kaggle. https://www.kaggle.com/datasets/ahsan81/superstore-marketing-campaign-dataset

Weiss, G. M., & Provost, F. (2003). Learning when training data are costly: The effect of class distribution on tree induction. Journal of Artificial Intelligence Research, 19, 315–354.

Los datos se pueden descargar de la página web del libro: http://www.icesi.edu.co/editorial/intro-clasificacion/. ↩︎
Recuerda que por defecto el número de ramas (ntree) que se crecerán después de cada división temporal.↩︎
Esta métrica debería discutirse con los tomadores de decisiones que emplearán el modelo. Si la organización cuenta con un analytics translator, esa será la persona indicada para discutir si esa métrica si es la adecuada.↩︎