Autor: Raúl Alcauza Poyatos
Título: Predicción del Abandono de Clientes en una TELCO
Prefacio
Como leer este Proyecto
Este proyecto, debe leerse en el orden indicado y sin dejar ningún punto atrás. Si no lo realiza así, no podrá comprender el alcance del mismo.
Está estructurado, mediante el “smooth_scroll”, situado a la izquierda y mediante las pestallas:
PRIMERA
Para aclarar mas el orden del mismo y con su orden indicado en negrita.
SEGUNDA
Para aclarar mas el orden del mismo y con su orden indicado en negrita.
Motivación
El empuje, para la realización de este proyecto, se ha alimentado de cinco puntos principales:
La pasión por todo lo relacionado con las nuevas tecnologías, su aprendizaje y posterior aplicación.
El realizar casos reales, de ML predictivo, donde poder aplicar todo lo aprendido y tener validez empresarial.
El situarse con este aprendizaje, en un sector que a mi parecer, tiene una de las mejores proyecciones de futuro de todo el país. Este es el caso de la IA y dentro de ella, del ML (Machine Learning Predictivo). Para ello, la realización de este curso, y su formación en Data Scientist-Data Analytics.
Averiguar, con gran nivel de detalle, lo que es posible realizar en todo este campo de la IA (Machine Learning Predictivo) y cuales son los posibles campos a explorar por mí, como puede ser a corto plazo, el DeepLearning.
Obtención del certificado, expedido por DS4B, sobre el curso de realización de proyectos de Machine Learning Predictivo, como es éste. Por un motivo totalmente personal, y por su finalidad: garantizar que con esta metodología podría afrontar el 80-90 % de proyectos de esta índole, en la realidad laboral del sector.
Y todo ello gracias a que empresas como DS4B, son capaces de exportar todo su conocimiento de una manera accesible.
A continuación, se presenta un esquema general del proceso utilizado, para a realización de este proyecto, y se basa en:
La base del funcionamiento de esta metodología, radica en la unión de diferentes procesos, de forma ordenada y con un sentido ascendente, de menos a mas:
- Primer Grupo: Importación, Calidad y Transformación de datos.
- Segundo Grupo: Modelización y Evaluación del modelo utilizado.
- Tercer Grupo: Implementación o puesta en producción.
Y sobre todo, un cuidado personal de DS4B, para cada alumno. Por este motivo, y desde mi experiencia, me gustaría dar las gracias, a DS4B, y en particular a Isaac González, por tener siempre una respuesta, rápida, y clara, a los problemas surgidos, que han sido muchos, durante la realización de este curso.
Introducción
Que puede esperar al leer este proyecto. Pues, creo y espero, que una condensación de técnicas y procedimientos, como son:
Técnicas de tratamiento de datos, en base al paquete tidyverse de RStudio, para la generación de un conjunto de datos, adecuado, y su posterior uso e incorporación, en las técnicas de modelización.
Técnicas de modelización. Uso de algoritmos de ML, para poder generar resultados finales de negocio. Algoritmos de distinto tipos, entre ellos de tipo Avanzado, para Machine Learning. En este proyecto hemos usado:
Regresión Logística
Árboles de Decisión
Random Forest
h2o
Algoritmos Automáticos, como AutoML, de H2o, para RStudio. Con el que se comprobarán los datos, anteriormente obtenidos y, sobre todo, evitar con ello, la inexistencia de sobre ajuste. Gracias a las operaciones internas de estos algoritmos avanzados, mediante técnicas de resample o remuestreo. Como son Cross-Validation, de esta forma evitamos el overfitting.
Presentación de los resultados, a nivel de negocio.
Puesta en Producción de los resultados obtenidos, a nivel de negocio, para comunicarlo al data Engineer.
Y sobre todo, transmitir con él, las ganas de seguir creciendo en este extenso y maravilloso sector.
Con todo ello, comenzamos a realizar la presentación de este proyecto, que consiste en la predicción del abandono, del cliente, en una TELCO. Para ello se usará una base de datos, liberada por IBM, y proporcionada por DS4B.
1. Preparación del entorno
Instalamos y cargamos las librerías a usar.
1.1 Instalamos y cargamos librerías
#lista de paquetes que vamos a usar
paquetes <- c("data.table",# Para leer y escribir datos de forma rapida. Fread
"xlsx", # Para pasar los df modificados a excel
"dplyr",
"tidyr",# para manipulación de datos
"ggplot2",# para gráficos
"tibble",
"forcats",# para trabajar con factores
"knitr",
"randomForest",
"purrr",
"ROCR", # Para curvas ROC
"pROC", # Para curvas ROC
"rpart", # Para crear los árboles de decisión
"rpart.plot", # Para dibujar árboles
"smbinning", # Para discretizar
"vcd",# Para matriz de confusión
"h2o",
"webshot") # Para el informe de Power BI
webshot::install_phantomjs(force = TRUE)
ifelse((paquetes %in% installed.packages() == TRUE), # Evalúo la condición
paste("Cargado","Correctamente","el","paquete",paquetes), #Indico si está instalado
install.packages(paquetes[!paquetes %in% installed.packages()])) # Lo instalo si no lo está## [1] "Cargado Correctamente el paquete data.table"
## [2] "Cargado Correctamente el paquete xlsx"
## [3] "Cargado Correctamente el paquete dplyr"
## [4] "Cargado Correctamente el paquete tidyr"
## [5] "Cargado Correctamente el paquete ggplot2"
## [6] "Cargado Correctamente el paquete tibble"
## [7] "Cargado Correctamente el paquete forcats"
## [8] "Cargado Correctamente el paquete knitr"
## [9] "Cargado Correctamente el paquete randomForest"
## [10] "Cargado Correctamente el paquete purrr"
## [11] "Cargado Correctamente el paquete ROCR"
## [12] "Cargado Correctamente el paquete pROC"
## [13] "Cargado Correctamente el paquete rpart"
## [14] "Cargado Correctamente el paquete rpart.plot"
## [15] "Cargado Correctamente el paquete smbinning"
## [16] "Cargado Correctamente el paquete vcd"
## [17] "Cargado Correctamente el paquete h2o"
## [18] "Cargado Correctamente el paquete webshot"## data.table xlsx dplyr tidyr ggplot2 tibble
## TRUE TRUE TRUE TRUE TRUE TRUE
## forcats knitr randomForest purrr ROCR pROC
## TRUE TRUE TRUE TRUE TRUE TRUE
## rpart rpart.plot smbinning vcd h2o webshot
## TRUE TRUE TRUE TRUE TRUE TRUE2 Análisis exploratorio
Siguiendo la metodología de DS4B, en este apartado analizaremos:
Este es uno de los apartados mas importantes y difíciles de llevar a cabo, para solucionar los problemas de la calidad de datos, tal y como se nos entregan desde un CRM, ERP, o de cualquier otra BBDD. Si no se invierte tiempo en ello, al comienzo del proyecto, estos problemas se arrastran durante toda la realización del mismo.
2.1 Análisis general y tipo de datos
Vemos el data.frame más detalladamente.
Comprobamos que existen muchas variables que son de tipo carácter, y que deberían ser de tipo factor, para ser correctamente interpretadas por R.
Como el dataset es estático, no tiene ventanas temporales, no usamos metodología de mes ciego*, ni tampoco apartado de creación de variables sintéticas, para dataset dinámico, como son: tenencia, contratación, cancelación, medias y tendencias.
Tanto la metodología del mes ciego como las variables, tenencia, contratación, etc, se crean dentro de un dataset con variación temporal, y que se mueve dentro de un “calendario”. Por ello, no se usa en nuestro caso.
Es necesario crear variables sintéticas, específicas, para este proyecto. se crearan en el apartado 3.2 Preparación de las variables independientes.
La variable “SeniorCitizen”, no parece tener sentido al estar representada por gran cantidad de ceros. No se sabe a partir de que edad se considera como SeniorCitizen” (persona mayor), además, no conocemos si existen otras segmentaciones de la edad, como podrían ser “JuniorCitizen”, que no se ven en los datos. Parece que tiene algún problema de calidad de datos, por lo que vamos a proponerla para eliminarla. Se decidirá mas adelante, con la revisión de estadísticos, nulos, ceros, etc.
Parece que existe correlación entre la variable tenure y MonthlyCharges, y que cuya combinación lineal da como resultado la variable TotalCharges*. Se propone para eliminar.
*Existen nulos en la variable TotalCharges. Parece que son solo 11, se estudiará en su apartado correspondiente.
*El mes ciego, consiste en disponer un dataset con orden cronológico en las variables, sobre todo en bases de datos transaccionales. Después crear variables sintéticas para todas estas variables, y no utilizar el mes antés del més de predicción. Como es lógico, el volcado de datos, en cualquier empresa, conlleva un tiempo que es lo que quiere salvar este método.
Primeras actuaciones:
- Sacamos del df, los nombres de la variables que pensamos no nos sirvan para los análisis venideros, o que creemos que serán eliminadas en esta sección.
# Variables, en estudio, propuestas para eliminar. Numéricas
var_eliminar<-c("SeniorCitizen","TotalCharges")Como la mayoría de variables son para convertir a factores, hacemos listado con las variables que no lo son, o que no se necesitan, para trabajar sobre el df mas fácilmente.
# Elegimos las variables a convertir en factor, sin necesidad de escribirlas todas
# Unimos las que no necesitamos
Unir<-union(var_id,var_eliminar)
Unir_1<-union(Unir,var_numeric)
# Sacamos con lógica de conjuntos las que sí necesitamos ahora.
var_factor<-setdiff(names(df), Unir_1)
# Las visualizamos. Tipo carácter
var_factor## [1] "gender" "Partner" "Dependents" "PhoneService"
## [5] "MultipleLines" "InternetService" "OnlineSecurity" "OnlineBackup"
## [9] "DeviceProtection" "TechSupport" "StreamingTV" "StreamingMovies"
## [13] "Contract" "PaperlessBilling" "PaymentMethod" "Churn"2.2 Estadísticos básicos (Numéricos y Categóricos)
Hacemos la revisión de las variables, divididas entre tipo numéricas y factor:
2.2.1 Variables Numéricas
# Numéricos. Lo ponemos bonito
Estadisticos_Numericos<-data.frame(rbind(SeniorCitizen,
tenure,MonthlyCharges,TotalCharges))
# Lo visualizamos
kable(Estadisticos_Numericos)| Min. | X1st.Qu. | Median | Mean | X3rd.Qu. | Max. | NA.s | |
|---|---|---|---|---|---|---|---|
| SeniorCitizen | 0.00 | 0.00 | 0.000 | 0.1621468 | 0.000 | 1.00 | 0.00 |
| tenure | 0.00 | 9.00 | 29.000 | 32.3711487 | 55.000 | 72.00 | 0.00 |
| MonthlyCharges | 18.25 | 35.50 | 70.350 | 64.7616925 | 89.850 | 118.75 | 18.25 |
| TotalCharges | 18.80 | 401.45 | 1397.475 | 2283.3004408 | 3794.738 | 8684.80 | 11.00 |
Existen nulos en la variable numérica “TotalCharges”. Habrá que investigarlos, en el apartado de nulos (2.3 Análisis de nulos), aún estando propuesta para eliminar.
Se observa que tenure, tiene mínimo en cero, tiene sentido desde negocio, al ser el tiempo de permanencia que tienes en la compañía, ya que puede existir alguien que acabe de contratar algún producto, y no tenga un mes de permanencia, aún. Y tiene sentido desde los datos. Si vamos al máximo= 72/12=6 años, vemos que es posible que un cliente tenga, una permanencia actual, de 6 años en la compañía. Luego el resultado está dentro de lo posible.
MonthlyCharges, también parece lógico, tanto desde negocio por entrar dentro de lo que puede costar una mensualidad, en una empresa del tipo TELCO, como desde el punto de vista numérico.
2.2.2 Variables Categóricas
Existen muchas variables de tipo carácter. Se convertirán en tipo factor.
# Convertimos a factor.
df_temp_factor<-lapply(select(df,var_factor), as.factor)
# Convertimos df_temp_factor de formato lista a df
df_temp_factor<-df_temp_factor %>%
as.data.frame()
# Convertimos a factor, solo las variables dentro de var_factor
df_temp_factor<-df_temp_factor %>%
mutate( df_temp_factor,
tenure=df$tenure,
MonthlyCharges=df$MonthlyCharges,
customerID=df$customerID)
# Visualizamos
str(df_temp_factor)## 'data.frame': 7043 obs. of 19 variables:
## $ gender : Factor w/ 2 levels "Female","Male": 1 2 2 2 1 1 2 1 1 2 ...
## $ Partner : Factor w/ 2 levels "No","Yes": 2 1 1 1 1 1 1 1 2 1 ...
## $ Dependents : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 2 1 1 2 ...
## $ PhoneService : Factor w/ 2 levels "No","Yes": 1 2 2 1 2 2 2 1 2 2 ...
## $ MultipleLines : Factor w/ 3 levels "No","No phone service",..: 2 1 1 2 1 3 3 2 3 1 ...
## $ InternetService : Factor w/ 3 levels "DSL","Fiber optic",..: 1 1 1 1 2 2 2 1 2 1 ...
## $ OnlineSecurity : Factor w/ 3 levels "No","No internet service",..: 1 3 3 3 1 1 1 3 1 3 ...
## $ OnlineBackup : Factor w/ 3 levels "No","No internet service",..: 3 1 3 1 1 1 3 1 1 3 ...
## $ DeviceProtection: Factor w/ 3 levels "No","No internet service",..: 1 3 1 3 1 3 1 1 3 1 ...
## $ TechSupport : Factor w/ 3 levels "No","No internet service",..: 1 1 1 3 1 1 1 1 3 1 ...
## $ StreamingTV : Factor w/ 3 levels "No","No internet service",..: 1 1 1 1 1 3 3 1 3 1 ...
## $ StreamingMovies : Factor w/ 3 levels "No","No internet service",..: 1 1 1 1 1 3 1 1 3 1 ...
## $ Contract : Factor w/ 3 levels "Month-to-month",..: 1 2 1 2 1 1 1 1 1 2 ...
## $ PaperlessBilling: Factor w/ 2 levels "No","Yes": 2 1 2 1 2 2 2 1 2 1 ...
## $ PaymentMethod : Factor w/ 4 levels "Bank transfer (automatic)",..: 3 4 4 1 3 3 2 4 3 1 ...
## $ Churn : Factor w/ 2 levels "No","Yes": 1 1 2 1 2 2 1 1 2 1 ...
## $ tenure : int 1 34 2 45 2 8 22 10 28 62 ...
## $ MonthlyCharges : num 29.9 57 53.9 42.3 70.7 ...
## $ customerID : chr "7590-VHVEG" "5575-GNVDE" "3668-QPYBK" "7795-CFOCW" ...Obtenemos el numero de niveles por variable
# Niveles en variables de tipo factor. Nos las anotamos y las modificamos
Nombres<-names(df_temp_factor)
df_temp_factor_Niveles<-sapply(df_temp_factor, nlevels)
# Con tibble funciona mejor, al ser formatos listas
df_temp_factor_Niveles<-tibble(Variables=Nombres, Numero_Niveles=df_temp_factor_Niveles)
#Salida
kable(df_temp_factor_Niveles)| Variables | Numero_Niveles |
|---|---|
| gender | 2 |
| Partner | 2 |
| Dependents | 2 |
| PhoneService | 2 |
| MultipleLines | 3 |
| InternetService | 3 |
| OnlineSecurity | 3 |
| OnlineBackup | 3 |
| DeviceProtection | 3 |
| TechSupport | 3 |
| StreamingTV | 3 |
| StreamingMovies | 3 |
| Contract | 3 |
| PaperlessBilling | 2 |
| PaymentMethod | 4 |
| Churn | 2 |
| tenure | 0 |
| MonthlyCharges | 0 |
| customerID | 0 |
Analizamos como son esos niveles y los sacamos por pantalla, indicando en qué variables están.
# Sacamos los niveles
Lista_Categorica<-map(df_temp_factor,levels)
# Lo convertimos en tibble, admite las listas mejor que el data.frame
Tibble_Categorico<-tibble(Variables=Nombres, Niveles=Lista_Categorica)
# Función para desanidar automáticamente (parecida a unnest_tokens)
Tibble_Categorico_Sin_Orden<-unnest(Tibble_Categorico)
# Creamos un indice para utilizar spread and gather y trabajar con tidy data
Tibble_Categorico_Sin_Orden %>%
mutate(Niveles=as.factor(Niveles),Indicador=as.numeric(
case_when(
Variables=="gender" ~ 1,
Variables=="Partner"~ 2,
Variables=="Dependents"~ 3,
Variables=="PhoneService" ~ 4,
Variables=="MultipleLines"~ 5,
Variables=="InternetService"~ 6,
Variables=="OnlineSecurity"~ 7,
Variables=="OnlineBackup" ~ 8,
Variables=="DeviceProtection"~ 9,
Variables=="TechSupport"~ 10,
Variables=="StreamingTV"~ 11,
Variables=="StreamingMovies"~ 12,
Variables=="Contract"~ 13,
Variables=="PaperlessBilling"~ 14,
Variables=="PaymentMethod"~ 15,
Variables=="Churn"~ 16)))%>%
spread(Indicador, Variables)Pueden ser de dos tipo:
**Dicotómicas (dos niveles)**No tiene sentido cambiar el nivel en estas, al tener, solo, dos niveles. Se aprecia que identifica los niveles, en este caso, con el valor “Yes” o “No”.
**Politómicas (ordinales) (mas de dos niveles)**En esta apartado, para indicar niveles, contamos con el número actual de cada nivel de factor. Aunque en un primer momento se realiza el reordenamiento de los niveles de los factores, por frecuencia por clase, dentro de cada factor, se revisa y se ordena teniendo presente la naturaleza de la variable. Solo cuando sea posible, no la frecuencia de cada clase. Por ejemplo, en la variable InternetService, la opción “Fiber optic” es mas que “DSL” y por extensión, que no tener nada. Esto es debido a que el algoritmo, por la naturaleza de la variable, interpreta mejor la opción elegida que la que libamos a realizar en primer lugar.
Por tanto queda:
# Vamos a cambiar las que tiene mas de dos niveles.
# lapply(df, fct_count)
# Con 4 niveles:
# Son: PaymentMethod
df_temp_factor$PaymentMethod<-factor(df_temp_factor$PaymentMethod,
ordered = T, levels = c("Credit card (automatic)","Bank transfer (automatic)","Mailed check","Electronic check"))
#Con 3 niveles ( se puede aumentar la eficiencia con fct_levels:
# Contract
df_temp_factor$Contract<-factor(df_temp_factor$Contract,
ordered = T, levels = c("One year","Two year","Month-to-month"))
# Tres e idénticos niveles
#===============================================================================
# StremingMovies
df_temp_factor$StreamingMovies<-factor(df_temp_factor$StreamingMovies,
ordered = T, levels = c("Yes","No internet service","No"))
#StreamingTV
df_temp_factor$StreamingTV<-factor(df_temp_factor$StreamingTV,
ordered = T, levels = c("Yes","No internet service","No"))
#TechSupport
df_temp_factor$TechSupport<-factor(df_temp_factor$TechSupport,
ordered = T, levels = c("Yes","No internet service","No"))
#DeviceProtection
df_temp_factor$DeviceProtection<-factor(df_temp_factor$DeviceProtection,
ordered = T, levels = c("Yes","No internet service","No"))
#OnlineBackup
df_temp_factor$OnlineBackup<-factor(df_temp_factor$OnlineBackup,
ordered = T, levels = c("Yes","No internet service","No"))
#OnlineBackup
df_temp_factor$OnlineSecurity<-factor(df_temp_factor$OnlineSecurity,
ordered = T, levels = c("Yes","No internet service","No"))
#===============================================================================
#OnlineBackup
df_temp_factor$InternetService<-factor(df_temp_factor$InternetService,
ordered = T, levels = c("No","DSL","Fiber optic"))
#OnlineBackup
df_temp_factor$MultipleLines<-factor(df_temp_factor$MultipleLines,
ordered = T, levels = c("No phone service","Yes","No"))2.3 Análisis de nulos
Investigar nulos en la variable “TotalCharges”. Eliminada del df temporal. Se revisa en el orginal.
| Variable | Numero_Nulos_Por_Variable |
|---|---|
| customerID | 0 |
| gender | 0 |
| SeniorCitizen | 0 |
| Partner | 0 |
| Dependents | 0 |
| tenure | 0 |
| PhoneService | 0 |
| MultipleLines | 0 |
| InternetService | 0 |
| OnlineSecurity | 0 |
| OnlineBackup | 0 |
| DeviceProtection | 0 |
| TechSupport | 0 |
| StreamingTV | 0 |
| StreamingMovies | 0 |
| Contract | 0 |
| PaperlessBilling | 0 |
| PaymentMethod | 0 |
| MonthlyCharges | 0 |
| TotalCharges | 11 |
| Churn | 0 |
Conclusión:
Al ser pocos datos, podríamos elimninar los 11 registros nulos de TotalCharges, del df. Pero como la variable está propuesta a eliminar, se terminará de decidir en el apartado de Análisis Longitudinal y de Coherencia. Apartados 2.6 y 2.7 de este proyecto.
2.4 Análisis de ceros
En ocasiones el número de ceros, puede estar asociado a un valor lógico, desde negocio o desde la propia naturaleza de la variable. Pero en otras ocasiones no es así. Se estudia su número:
2.4.1 Porcentaje de ceros por variable
2.4.2 Porcentaje de unos por variable
2.4.3 Resultado Final
Conclusión
Para la variable SeniorCitizen, se obtiene un alto porcentaje de ceros. No se sabe si es una parte de una segmentación de clientes, que está incompleta, ya que hay un 83,79% de ceros y un 16,21 % de unos.
2.5 Análisis de atípicos
## $SeniorCitizen
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.0000 0.0000 0.0000 0.1624 0.0000 1.0000
##
## $tenure
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.00 9.00 29.00 32.42 55.00 72.00
##
## $MonthlyCharges
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 18.25 35.59 70.35 64.80 89.86 118.75
##
## $TotalCharges
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 18.8 401.4 1397.5 2283.3 3794.7 8684.8Conclusiones: No se observan atípicos. Se hace un examen mas pormenorizado.
Se estudian los extremos de las variables numéricas para ver si existen atípicos, aunque el primer vistazo, realizado en el apartado 2.2. de variables numéricas, parecía indicar que todo estaba bien.
Numeric (Todos los numéricos se hacen con tipo numérico, lo admite aunque sea integer)
Extremo Superior
## $SeniorCitizen
## (head(sort(variable, decreasing = T), 10))
## 1 1
## 2 1
## 3 1
## 4 1
## 5 1
## 6 1
## 7 1
## 8 1
## 9 1
## 10 1
##
## $tenure
## (head(sort(variable, decreasing = T), 10))
## 1 72
## 2 72
## 3 72
## 4 72
## 5 72
## 6 72
## 7 72
## 8 72
## 9 72
## 10 72
##
## $MonthlyCharges
## (head(sort(variable, decreasing = T), 10))
## 1 118.75
## 2 118.65
## 3 118.60
## 4 118.60
## 5 118.35
## 6 118.20
## 7 117.80
## 8 117.60
## 9 117.50
## 10 117.45
##
## $TotalCharges
## (head(sort(variable, decreasing = T), 10))
## 1 8684.80
## 2 8672.45
## 3 8670.10
## 4 8594.40
## 5 8564.75
## 6 8547.15
## 7 8543.25
## 8 8529.50
## 9 8496.70
## 10 8477.70Extremo Inferior
## $SeniorCitizen
## (head(sort(variable, decreasing = F), 10))
## 1 0
## 2 0
## 3 0
## 4 0
## 5 0
## 6 0
## 7 0
## 8 0
## 9 0
## 10 0
##
## $tenure
## (head(sort(variable, decreasing = F), 10))
## 1 1
## 2 1
## 3 1
## 4 1
## 5 1
## 6 1
## 7 1
## 8 1
## 9 1
## 10 1
##
## $MonthlyCharges
## (head(sort(variable, decreasing = F), 10))
## 1 18.25
## 2 18.40
## 3 18.55
## 4 18.70
## 5 18.70
## 6 18.75
## 7 18.80
## 8 18.80
## 9 18.80
## 10 18.80
##
## $TotalCharges
## (head(sort(variable, decreasing = F), 10))
## 1 18.80
## 2 18.85
## 3 18.85
## 4 18.90
## 5 19.00
## 6 19.05
## 7 19.10
## 8 19.10
## 9 19.10
## 10 19.15Conclusiones: No se observa ningún problema. Las subidas o bajadas en los valores son graduales.
2.6 Análisis longitudinal
Podemos dividir esta sección, en dos partes:
El estudio de las relaciones entre dos variables a lo largo del tiempo.
El estudio de la evolución de una variable a lo largo del tiempo.
En este caso, estudiamos el punto de vista de coherencia entre dos variables distintas. Como se comentó al inicio de esta sección, la relación entre tenure /MonthlyCharges con TotalCharges, parece ser lineal.
Gráfico Relación
# Creamos el df
df %>%
transmute(tenure,tenure_real=TotalCharges/MonthlyCharges, diferencia=(tenure-tenure_real)) %>%
head(10)%>%
kable() # Se comprueba que son casi idénticas.| tenure | tenure_real | diferencia |
|---|---|---|
| 1 | 1.000000 | 0.0000000 |
| 34 | 33.178227 | 0.8217735 |
| 2 | 2.008357 | -0.0083565 |
| 45 | 43.516548 | 1.4834515 |
| 2 | 2.144979 | -0.1449788 |
| 8 | 8.233818 | -0.2338184 |
| 22 | 21.878788 | 0.1212121 |
| 10 | 10.147899 | -0.1478992 |
| 28 | 29.065363 | -1.0653626 |
| 62 | 62.118433 | -0.1184328 |
# Gráfico para ver la relación.
ggplot(data = df, aes( x=tenure, y=TotalCharges, color=tenure))+
geom_point()+
labs(title ="Relación Lineal")+
stat_smooth( se=TRUE)+
theme_light()
Se hace el test de correlación, es este caso, el tipo “pearson”, al verse gráficamente que es casi una correlación lineal, donde este método se ajusta muy bien.
Caso 1. Cor.Test. tenure-TotalCharges
##
## Pearson's product-moment correlation
##
## data: df$tenure and df$TotalCharges
## t = 122.81, df = 7030, p-value < 0.00000000000000022
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.8183033 0.8331706
## sample estimates:
## cor
## 0.8258805Caso 2. Cor.Test. MonthlyCharges-TotalCharges
##
## Pearson's product-moment correlation
##
## data: df$MonthlyCharges and df$TotalCharges
## t = 71.92, df = 7030, p-value < 0.00000000000000022
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.6373910 0.6643287
## sample estimates:
## cor
## 0.6510648Caso 3. Cor.Test. tenure-MonthlyCharges
##
## Pearson's product-moment correlation
##
## data: df$tenure and df$MonthlyCharges
## t = 21.359, df = 7030, p-value < 0.00000000000000022
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.2247854 0.2686849
## sample estimates:
## cor
## 0.2468618En los dos primeros casos, la correlación es alta y positiva, por lo que las variables están muy asociadas entre ellas. Se comprueba que hay que eliminar TotalCharges, al estar ambas variables muy relacionadas, pudiendo afectar al modelo final, si coexisten las tres a la vez.
En el tercer caso, se aprecia una muy baja correlación, de 0,24. Se mantendrán estas dos variables.
Se eliminará la variable TotalCharges
2.7 - Análisis de coherencia
En este caso, la coherencia es mantenida en el tiempo, por una sola variable, la variable tenure. No tendría sentido estudiarla, al no tener indicadores cronológicos, en base a un calendario, sí en valor absoluto de permanencia como tenure.
Y podría ocurrir que tenure indicara el total de permanencia del cliente en la compañía, existiendo un tiempo en el que el cliente en cuestión, hubiera abandonado la compañía y luego hubiese vuelto. Es decir, para una permanencia o tenure, de 70 meses, puede que haya una parada en la permanencia, por parte del cliente, entre los meses 60 y 62, pero no lo recoge esta variable.
2.8 Otros
Se recalibraron las variables de tipo factor.
2.9 - Resultados
Se han llevado a cabo, las siguientes acciones:
- Eliminar la variable TotalCharges por ser combinación lineal de otras dos.
- Eliminar SeniorCitizen, por no estar correctamente informada. Existen pocos unos para esta categoría, un 16,24 %, siendo el resto ceros. se desconoce si existen problemas de segmentación.
- Los estadísticos, de las variables numéricas, parecen correctos.
- Se convierten a factor, todas las variables caracteres, excepto customerID, y se reordenan los niveles de estas variables factor.
- No se aprecian atípicos.
- No se estudia la coherencia tanto en una variable como en relación a dos diferentes, por ser un dataset estático en el tiempo y por haber eliminado la combinación lineal existente, a primera vista.
3 Trasformación de datos
3.1 - Creación de la variable target.
Al ser un dataset público, de IBM, la target vienen ya casi preparada, es decir, sería la variable churn. Convertimos los “No” en ceros, al significar que el cliente no ha abandonado la compañía, y viceversa.
## 'data.frame': 7043 obs. of 19 variables:
## $ gender : Factor w/ 2 levels "Female","Male": 1 2 2 2 1 1 2 1 1 2 ...
## $ Partner : Factor w/ 2 levels "No","Yes": 2 1 1 1 1 1 1 1 2 1 ...
## $ Dependents : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 2 1 1 2 ...
## $ PhoneService : Factor w/ 2 levels "No","Yes": 1 2 2 1 2 2 2 1 2 2 ...
## $ MultipleLines : Ord.factor w/ 3 levels "No phone service"<..: 1 3 3 1 3 2 2 1 2 3 ...
## $ InternetService : Ord.factor w/ 3 levels "No"<"DSL"<"Fiber optic": 2 2 2 2 3 3 3 2 3 2 ...
## $ OnlineSecurity : Ord.factor w/ 3 levels "Yes"<"No internet service"<..: 3 1 1 1 3 3 3 1 3 1 ...
## $ OnlineBackup : Ord.factor w/ 3 levels "Yes"<"No internet service"<..: 1 3 1 3 3 3 1 3 3 1 ...
## $ DeviceProtection: Ord.factor w/ 3 levels "Yes"<"No internet service"<..: 3 1 3 1 3 1 3 3 1 3 ...
## $ TechSupport : Ord.factor w/ 3 levels "Yes"<"No internet service"<..: 3 3 3 1 3 3 3 3 1 3 ...
## $ StreamingTV : Ord.factor w/ 3 levels "Yes"<"No internet service"<..: 3 3 3 3 3 1 1 3 1 3 ...
## $ StreamingMovies : Ord.factor w/ 3 levels "Yes"<"No internet service"<..: 3 3 3 3 3 1 3 3 1 3 ...
## $ Contract : Ord.factor w/ 3 levels "One year"<"Two year"<..: 3 1 3 1 3 3 3 3 3 1 ...
## $ PaperlessBilling: Factor w/ 2 levels "No","Yes": 2 1 2 1 2 2 2 1 2 1 ...
## $ PaymentMethod : Ord.factor w/ 4 levels "Credit card (automatic)"<..: 4 3 3 2 4 4 1 3 4 2 ...
## $ tenure : int 1 34 2 45 2 8 22 10 28 62 ...
## $ MonthlyCharges : num 29.9 57 53.9 42.3 70.7 ...
## $ customerID : chr "7590-VHVEG" "5575-GNVDE" "3668-QPYBK" "7795-CFOCW" ...
## $ TARGET_ABANDONO : Factor w/ 2 levels "0","1": 1 1 2 1 2 2 1 1 2 1 ...3.2 Preparación de las variables independientes
Utilizaremos para la preselección 3 procedimientos, aunque si bien es cierto que podríamos esperar al modelado, queremos aumentar su capacidad de predicción:
- Random Forest
- WOE e IV
- Criterio Chi-Cuadrado
3.2.1 Preselección variables independientes
Se realiza el siguiente proceso, para obtener el mayor poder de predicción, indicando las mejores variables independientes para ello. Al utilizar diferentes métodos se hará un ranking entre los dos primeros y se hará una comprobación entre las dos variables que mejor predigan, con el tercer método, Chi-Cuadrado.
3.2.1.1 Random Forest
Para escoger en este caso, se ha seleccionado, con la salida importance(), el valor de MeanDecreaseGini.
3.2.1.2 Information Value (IV y WOE)
NOTA. Hay que tener presente que, IV, nos da un valor de predictor, medio o bueno, a partir de 0,2.
3.2.1.3 - Preselección final
Nos dan garantías, los dos métodos
## Se obtiene un valor de correlación entre variables, sin eliminar las variables de bajo poder predictivo, de: 0.7374055 .Se dejan aquellas que estan en el ranking global por encima de la posición 153.2.1.4 Preselección-Comprobación con Chi-cuadrado. Discusión WOE-IV
Para Chi-Cuadrado, elegimos las dos primeras variables, con mayor predicción: tenure y Contract, sacadas de la tabla de preselección final con smbinning, con la que discutiremos el criterio del WOE e IV, conjuntamente con chi-Cuadrado.
Utilizaremos Chi-cuadrado para comprobar la preselección de variables también, por pares. En este caso escogeremos tenure:
# Obtenemos la tabla completa para tenure
resul_tenure<-smbinning(temp, y="TARGET_ABANDONO", x="tenure")
# Cambiamos nombre de las columnas
names(resul_tenure$ivtable)<-c("Corte","Conteo Total"," Conteo Abandono", "Conteo No Abandono", "Distribucion Total", "Distrubución Abandono"," Distriución No Abandono", "% Distribución","% Abandono", "% No abandono", "Odds o Ratio","LnOdds","WOE","IV")
# Sacamos la tabla del WOE e IV y la interpretamos
kable(resul_tenure$ivtable[-9,-(5:7)])| Corte | Conteo Total | Conteo Abandono | Conteo No Abandono | % Distribución | % Abandono | % No abandono | Odds o Ratio | LnOdds | WOE | IV | |
|---|---|---|---|---|---|---|---|---|---|---|---|
| 1 | <= 1 | 624 | 380 | 244 | 0.0886 | 0.6090 | 0.3910 | 1.5574 | 0.4430 | 1.4612 | 0.2282 |
| 2 | <= 5 | 747 | 364 | 383 | 0.1061 | 0.4873 | 0.5127 | 0.9504 | -0.0509 | 0.9674 | 0.1168 |
| 3 | <= 16 | 1179 | 420 | 759 | 0.1674 | 0.3562 | 0.6438 | 0.5534 | -0.5917 | 0.4265 | 0.0333 |
| 4 | <= 22 | 481 | 131 | 350 | 0.0683 | 0.2723 | 0.7277 | 0.3743 | -0.9827 | 0.0355 | 0.0001 |
| 5 | <= 49 | 1839 | 376 | 1463 | 0.2611 | 0.2045 | 0.7955 | 0.2570 | -1.3587 | -0.3404 | 0.0278 |
| 6 | <= 59 | 690 | 99 | 591 | 0.0980 | 0.1435 | 0.8565 | 0.1675 | -1.7867 | -0.7685 | 0.0471 |
| 7 | <= 70 | 951 | 87 | 864 | 0.1350 | 0.0915 | 0.9085 | 0.1007 | -2.2957 | -1.2774 | 0.1538 |
| 8 | > 70 | 532 | 12 | 520 | 0.0755 | 0.0226 | 0.9774 | 0.0231 | -3.7689 | -2.7507 | 0.2588 |
| 10 | Total | 7043 | 1869 | 5174 | 1.0000 | 0.2654 | 0.7346 | 0.3612 | -1.0182 | 0.0000 | 0.8659 |
Analicemos un poco esta tabla. Se aprecia que los valores del WOE, son positivos, para tramos de permanencia menor o igual a 22 meses, siendo mayor para valores de permanencia menores a 1 mes y negativos para casos de permanencia mayores a 22. Lo que quiere decir que el abandono es poco probable.
Desde un punto de vista de negocio, es lógico pensar que la probabilidad de que un cliente, con una permanencia menor a 1 mes, es mayor, a la probabilidad de abandonar la empresa, por un cliente con permanencia menor o igual a 70 meses.
Para este último caso, vemos que el valor del WOE, es negativo, indica que la cantidad de clientes que podrían abandonar, es menor que los que no lo harían, y su valor absoluto, indica que el número de clientes a abandonar, es mucho menor que los que no lo harían.
Vemos que ello hace que, para IV >= 0,02, tenemos variables o tramos de variables, muy predictivas, a la hora de averiguar qué clientes abandonarían, y cuales no.
Aquí Contract:
# Obtenemos la tabla completa para Contract. Para ello usamos smbining
resul_Contract<-smbinning.factor(temp, y="TARGET_ABANDONO", x="Contract")
# Cambiamos nombre de las columnas
names(resul_Contract$ivtable)<-c("Corte","Conteo Total"," Conteo Abandono", "Conteo No Abandono", "Distribucion Total", "Distrubución Abandono"," Distriución No Abandono", "% Distribución","% Abandono", "% No abandono", "Odds o Ratio","LnOdds","WOE","IV")
# Sacamos la tabla del WOE e IV y la interpretamos
kable(resul_Contract$ivtable[-4,-(5:7)])| Corte | Conteo Total | Conteo Abandono | Conteo No Abandono | % Distribución | % Abandono | % No abandono | Odds o Ratio | LnOdds | WOE | IV | |
|---|---|---|---|---|---|---|---|---|---|---|---|
| 1 | = ‘Month-to-month’ | 3875 | 1655 | 2220 | 0.5502 | 0.4271 | 0.5729 | 0.7455 | -0.2937 | 0.7245 | 0.3307 |
| 2 | = ‘One year’ | 1473 | 166 | 1307 | 0.2091 | 0.1127 | 0.8873 | 0.1270 | -2.0635 | -1.0453 | 0.1712 |
| 3 | = ‘Two year’ | 1695 | 48 | 1647 | 0.2407 | 0.0283 | 0.9717 | 0.0291 | -3.5355 | -2.5173 | 0.7367 |
| 5 | Total | 7043 | 1869 | 5174 | 1.0000 | 0.2654 | 0.7346 | 0.3612 | -1.0182 | 0.0000 | 1.2386 |
Para este apartado, podríamos aplicar el mismo análisis.
# Tabla de referencia tenure
resul_ChiCuadrado_tenure<-resul_tenure$ivtable[,-(5:14)]
resul_ChiCuadrado_tenure<-resul_ChiCuadrado_tenure[-9,-2]
# Lo convertimos a matriz
resul_ChiCuadrado_tenure<-as.matrix(unlist((resul_ChiCuadrado_tenure[,-1])))
# Creamos una matriz
test_tenure<-chisq.test(resul_ChiCuadrado_tenure)
#Vemos el test
test_tenure##
## Chi-squared test for given probabilities
##
## data: resul_ChiCuadrado_tenure
## X-squared = 31028, df = 17, p-value < 0.00000000000000022# Tabla de referencia tenure
resul_ChiCuadrado_Contract<-resul_Contract$ivtable[,-(5:14)]
resul_ChiCuadrado_Contract<-resul_ChiCuadrado_Contract[-4,-2]
# Lo convertimos a matriz
resul_ChiCuadrado_Contract<-as.matrix(unlist((resul_ChiCuadrado_Contract[,-1])))
# Creamos una matriz
test_Contract<-chisq.test(resul_ChiCuadrado_Contract)
# Vemos el test
test_Contract##
## Chi-squared test for given probabilities
##
## data: resul_ChiCuadrado_Contract
## X-squared = 9984.2, df = 7, p-value < 0.00000000000000022## Como el valor de la X-squared, para tenure, es mayor que para Contract 31027.9 > 9984.186 se prefiere la primera agrupación, lo que corrobora el valor por el Ranking total obtenido en la sección de preselección final. Se podría ir por pares comprobando, pero no lo haremos en nuestro caso al tener un tercer método como es Random Forest.Nos quedamos con las variables mas predictivas.
ind_corta <- c('tenure','Contract','OnlineSecurity','MonthlyCharges',
'InternetService','TechSupport','PaymentMethod','OnlineBackup','DeviceProtection',
'StreamingTV','StreamingMovies','PaperlessBilling','Partner','MultipleLines')Podíamos calcular, con las nuevas variables, la correlación. Se dejará así, ya que con los modelos analíticos, filtraremos de nuevo las variables.
3.2.2 - Variables Finalistas
Creamos el df que nos interesa
## 'data.frame': 7043 obs. of 16 variables:
## $ Partner : Factor w/ 2 levels "No","Yes": 2 1 1 1 1 1 1 1 2 1 ...
## $ MultipleLines : Ord.factor w/ 3 levels "No phone service"<..: 1 3 3 1 3 2 2 1 2 3 ...
## $ InternetService : Ord.factor w/ 3 levels "No"<"DSL"<"Fiber optic": 2 2 2 2 3 3 3 2 3 2 ...
## $ OnlineSecurity : Ord.factor w/ 3 levels "Yes"<"No internet service"<..: 3 1 1 1 3 3 3 1 3 1 ...
## $ OnlineBackup : Ord.factor w/ 3 levels "Yes"<"No internet service"<..: 1 3 1 3 3 3 1 3 3 1 ...
## $ DeviceProtection: Ord.factor w/ 3 levels "Yes"<"No internet service"<..: 3 1 3 1 3 1 3 3 1 3 ...
## $ TechSupport : Ord.factor w/ 3 levels "Yes"<"No internet service"<..: 3 3 3 1 3 3 3 3 1 3 ...
## $ StreamingTV : Ord.factor w/ 3 levels "Yes"<"No internet service"<..: 3 3 3 3 3 1 1 3 1 3 ...
## $ StreamingMovies : Ord.factor w/ 3 levels "Yes"<"No internet service"<..: 3 3 3 3 3 1 3 3 1 3 ...
## $ Contract : Ord.factor w/ 3 levels "One year"<"Two year"<..: 3 1 3 1 3 3 3 3 3 1 ...
## $ PaperlessBilling: Factor w/ 2 levels "No","Yes": 2 1 2 1 2 2 2 1 2 1 ...
## $ PaymentMethod : Ord.factor w/ 4 levels "Credit card (automatic)"<..: 4 3 3 2 4 4 1 3 4 2 ...
## $ tenure : int 1 34 2 45 2 8 22 10 28 62 ...
## $ MonthlyCharges : num 29.9 57 53.9 42.3 70.7 ...
## $ customerID : chr "7590-VHVEG" "5575-GNVDE" "3668-QPYBK" "7795-CFOCW" ...
## $ TARGET_ABANDONO : Factor w/ 2 levels "0","1": 1 1 2 1 2 2 1 1 2 1 ...3.3 Fichero final y limpieza del entorno
Nos quedamos con el df final y eliminamos todo lo creado o utilizado, en la fase anterior, para comenzar con la memoria limpia.
3.3.1 Limpieza
Eliminamos variables que ya no sirven.
4 Creación de variables sintéticas
Cargamos la sesión.
NOTA 1. Las transformaciones de variables vamos a crearlas como funciones, cuando sea posible. Ello nos va a facilitar el trabajo cuando creemos el código de producción.
NOTA2. Se crea excel indicando que se ha realizado con las variables, sin usar tenencia, contratación, cancelación, media y tendencia.
4.1 Creación variables sintéticas: Factor y Numérica
Desde el punto 4.1.1 al 4.1.5 no podemos hacer nada, al ser el dataset, estático, es decir, no hay ventanas temporales, pero si vamos a adaptarlo a nuestro conjunto de datos.
Pasos, incluidos en la metodología, pero no usados aquí debido al tipo de dataset.
* 4.1.1 - Creación de tenencias
* 4.1.2 - Creación de contratación
* 4.1.3 - Creación de indicadores de cancelación
* 4.1.4 - Creación de medias
* 4.1.5 - Creación de tendencias4.1.1. Variables Sintéticas
Al llegar a la fase de modelización, se nos indican errores en el modelo, tanto en los coeficientes, como en el propio valor de p-value. Como se aprecia en la imagen, no existe valor “NA”, luego se aprecia fallo en la preparación de las variables.
Es necesario crear variables sintéticas para eliminar este problema, ya sea cruzando varias variables o convirtiendolas en independientes.
## Rows: 7,043
## Columns: 16
## $ Partner <fct> Yes, No, No, No, No, No, No, No, Yes, No, Yes, No, Ye~
## $ MultipleLines <ord> No phone service, No, No, No phone service, No, Yes, ~
## $ InternetService <ord> DSL, DSL, DSL, DSL, Fiber optic, Fiber optic, Fiber o~
## $ OnlineSecurity <ord> No, Yes, Yes, Yes, No, No, No, Yes, No, Yes, Yes, No ~
## $ OnlineBackup <ord> Yes, No, Yes, No, No, No, Yes, No, No, Yes, No, No in~
## $ DeviceProtection <ord> No, Yes, No, Yes, No, Yes, No, No, Yes, No, No, No in~
## $ TechSupport <ord> No, No, No, Yes, No, No, No, No, Yes, No, No, No inte~
## $ StreamingTV <ord> No, No, No, No, No, Yes, Yes, No, Yes, No, No, No int~
## $ StreamingMovies <ord> No, No, No, No, No, Yes, No, No, Yes, No, No, No inte~
## $ Contract <ord> Month-to-month, One year, Month-to-month, One year, M~
## $ PaperlessBilling <fct> Yes, No, Yes, No, Yes, Yes, Yes, No, Yes, No, Yes, No~
## $ PaymentMethod <ord> Electronic check, Mailed check, Mailed check, Bank tr~
## $ tenure <int> 1, 34, 2, 45, 2, 8, 22, 10, 28, 62, 13, 16, 58, 49, 2~
## $ MonthlyCharges <dbl> 29.85, 56.95, 53.85, 42.30, 70.70, 99.65, 89.10, 29.7~
## $ customerID <chr> "7590-VHVEG", "5575-GNVDE", "3668-QPYBK", "7795-CFOCW~
## $ TARGET_ABANDONO <fct> 0, 0, 1, 0, 1, 1, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0,~Variables Sintéticas tipo factor
En este apartado se han creado las variables, para facilitar y mejorar el trabajo a los modelos. De forma que:
\(f(x)\) Elimina una variable, tipo factor, con tres niveles, y crea una con dos solos.
\(f(x)\) Elimina dos variables, tipo factor, con el mismo número de niveles (TRES), y crea una sola.
Unión OnlineSecurity + OnlineBackup. Mismo número de niveles de factores y mismo valor:
Unión DeviceProtection + TechSupport. Mismo número de niveles de factores y mismo valor:
Unión StreamingTV + StreamingMovies Mismo número de niveles de factores y mismo valor:
Partner. Una sola variable con solo dos niveles
PaperlessBilling. Una sola variable con solo dos niveles
MultipleLines. Una sola variable con solo dos niveles
Variables sintéticas tipo numérico
- Combinación lineal de tenure y MonthlyCharges
NOTA: Podíamos haber realizado mas transformaciones, pero desvirtuan el modelo, reduciendo el valor de pseudo R2 a menos de 0,25, y por tanto, reduciendo el valor de AUC a menos de 0,80. No hay que olvidar, que si sobre ajustamos sobre la muestra de entrenamiento, que era el problema, crearíamos un modelo muy poco flexible, prediciendo mal los valores de la muestra de test.
Los modelos, deben de incorporar patrones que sean predecibles o no por nosotros, de ahí su flexibilidad y evitar, lo máximo posible, el overfitting.
4.2 Discretización
Con la función discretizar, de smbinning se puede maximizar, de forma automática, la capacidad predictiva de una variable. Además, como vamos a usar, en la modelización, un algoritmo lineal como regresión logística, vamos a intentar que la discretización sea monotónica.
Discretizamos manualmente, al obtener con discretización automática, una penetración final, errónea, con Scorings que no descienden gradualmente. Vemos el fallo:
Ahora vamos a intentar observar la variable discretizada,jugamos con los gráficos hasta ver, de una manera adecuada, como funciona la variable sintética y cual es la penetración de la variable target (de estudio) en ella.
4.2.1 Discretización Manual
Calculamos los Deciles para tener una orientación de los intervalos. No hay que olvidar que estas dos variables, tienen un alto poder predictivo, su combinación hace pensar que también lo será.
| Tramo | |
|---|---|
| 0% | 0.00000 |
| 11.11111% | 93.41111 |
| 22.22222% | 316.77778 |
| 33.33333% | 673.75000 |
| 44.44444% | 1145.21111 |
| 55.55556% | 1721.59444 |
| 66.66667% | 2743.80000 |
| 77.77778% | 4149.64444 |
| 88.88889% | 5806.48333 |
| 100% | 8550.00000 |
Graficamos La variable
Vemos la penetración de la target
4.2.2. Inspección de todas las variables
4.2.3. Graficamos Penetración Target
Realizado con todas las variables. Se aprecian todas monotónicas, lo que facilitará el trabajo del modelo: Regresión logística.
## [[1]]
##
## [[2]]
##
## [[3]]
##
## [[4]]
##
## [[5]]
##
## [[6]]
##
## [[7]]
##
## [[8]]
##
## [[9]]
##
## [[10]]
##
## [[11]]
La mayoría han salido monotónicas.
Vamos a ver como ha quedado nuestro fichero antes de pasar a la fase de modelización
## Rows: 7,043
## Columns: 12
## $ customerID <chr> "7590-VHVEG", "5575-GNVDE", "3668-QPYBK", "779~
## $ InternetService <ord> DSL, DSL, DSL, DSL, Fiber optic, Fiber optic, ~
## $ Contract <ord> Month-to-month, One year, Month-to-month, One ~
## $ PaymentMethod <ord> Electronic check, Mailed check, Mailed check, ~
## $ Online_Sintetica <fct> 1, 1, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 0~
## $ Device_Tech_Sintetica <fct> 1, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 0, 0~
## $ Streaming_Sintetica <fct> 1, 1, 1, 1, 1, 0, 1, 1, 0, 1, 1, 1, 0, 0, 0, 0~
## $ Partner_Sintetica <fct> 0, 1, 1, 1, 1, 1, 1, 1, 0, 1, 0, 1, 0, 1, 1, 0~
## $ PaperlessBilling_Sin <fct> 0, 1, 0, 1, 0, 0, 0, 1, 0, 1, 0, 1, 1, 0, 0, 1~
## $ MultipleLines_Sintetica <fct> 1, 1, 1, 1, 1, 0, 0, 1, 0, 1, 1, 1, 0, 0, 1, 0~
## $ Num_Disc <fct> 01_MENOR_95, 04_1100_3100, 02_95_370, 04_1100_~
## $ TARGET_ABANDONO <fct> 0, 0, 1, 0, 1, 1, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0~4.3 Limpieza
Limpiamos el entorno de cualquier cosa que no sea el dataframe
Guardamos otro cache temporal
Cargamos el cache temporal
5 Modelización. Algoritmos.
En este apartado, usaremos técnicas de modelización de tipo supervisado. Uso de algoritmos de ML, para poder generar resultados finales de negocio. Algoritmos de distinto tipos, entre ellos de tipo Avanzado, para Machine Learning. Son:
Regresión Logística
Árboles de Decisión
Random Forest
h2o
Bonus: Auto ML de H2o para RStudio.(En construcción) Se realizaran aquí:
- Regresión Logística
- Random Forest
- Gradient Boosting Machine (GBM)
5.1 Preparando el entorno:
En este apartado dispondremos de:
Función para crear una matriz de confusión
Función para calcular las métricas de los modelos: acierto, precisión, cobertura y F1
Función para probar distintos umbrales y ver el efecto sobre precisión y cobertura
Funciones para calcular curva ROC y AUC.
5.2 Creación Modelo Propensión
Vamos a probar, los tres algoritmos, para comprobar los resultados entre ellos y verificar el modelo eligiendo el mejor. Posteriormente compararemos el resultado con H2o.
5.2.1 Regresión Logística
Primero con todas las variables. revisamos la significancia y mantenemos todas las variables que tengan entre tres estrellas y una en alguna categoría.
Hasta que todas las variables tengan, al menos, en uno de sus intervalos, una categoría con uno o tres estrellas. También, vamos a mirar el signo de los coeficientes, que deberá seguir la lógica de negocio.
Volvemos a modelizar
formula_rl <- reformulate(a_mantener,target)
rl<- glm(formula_rl,train,family=binomial(link='logit'))
summary(rl)##
## Call:
## glm(formula = formula_rl, family = binomial(link = "logit"),
## data = train)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.2930 -0.6807 -0.2849 0.5288 3.1804
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 0.23951 0.24048 0.996 0.31927
## InternetService.L 1.67790 0.12474 13.451 < 0.0000000000000002 ***
## InternetService.Q -0.11864 0.08674 -1.368 0.17135
## Contract.L 0.57892 0.09005 6.429 0.00000000012845381 ***
## Contract.Q 1.30711 0.16493 7.925 0.00000000000000228 ***
## PaymentMethod.L 0.19835 0.08740 2.269 0.02324 *
## PaymentMethod.Q 0.19843 0.09189 2.159 0.03081 *
## PaymentMethod.C 0.26373 0.09856 2.676 0.00746 **
## Online_Sintetica1 0.34157 0.14640 2.333 0.01964 *
## Streaming_Sintetica1 -0.65737 0.10278 -6.396 0.00000000015971762 ***
## PaperlessBilling_Sin1 -0.37011 0.09226 -4.012 0.00006025817811538 ***
## MultipleLines_Sintetica1 -0.39930 0.09853 -4.053 0.00005066978266272 ***
## Num_Disc02_95_370 -1.00941 0.15090 -6.689 0.00000000002242995 ***
## Num_Disc03_370_1100 -1.62093 0.15768 -10.280 < 0.0000000000000002 ***
## Num_Disc04_1100_3100 -2.17065 0.15748 -13.784 < 0.0000000000000002 ***
## Num_Disc05_3100_9000 -2.92684 0.19669 -14.881 < 0.0000000000000002 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 5307.1 on 4556 degrees of freedom
## Residual deviance: 3761.2 on 4541 degrees of freedom
## AIC: 3793.2
##
## Number of Fisher Scoring iterations: 6Vemos que ahora ya todas las variables tienen al menos una categoría con tres estrellas de significación
Comprobemos el signo de los coeficientes, que deberá seguir la lógica de negocio: todas las variables tienen lógica, asi que vamos a comprobar este modelo sobre el conjunto de test
- Pseudo R2
## [1] 0.2912907Podemos explicar en torno a un 30% de los casos ocurridos desde negocio. Podría ser mayor, pero es complicado tener presente toda la causística, en la realidad.
- BOX-PLOT
Se ve que diferencia bien, entre el scoring de los clientes que realmente no han abandonado la compañía, valor cero, y los que realmente, sí la han abandonado, valor 1. Para valor cero, la media esta entorno, al valor 0.1, y para el valor uno, está alrededor del valor 0.5. Digamos que diferencia bien, apreciando que el 75% de las dos distribuciones, no se tocan o intersectan en un valor de scoring alguno.
- Umbral automático en función de F1 Ahora tenemos que transformar la probabilidad en una decisión de si el cliente va a abandonar o no la compañía.
Con la función umbrales probamos diferentes cortes
Tabla Umbrales
Podríamos seleccionar el umbral que maximiza la F1.
## [1] 0.3Evaluamos la matriz de confusión y las métricas con el umbral optimizado por F1. La media entre precisión y cobertura
## Realidad
## Predicción 0 1
## 0 1417 426
## 1 157 486
Tendríamos estas métricas:
Nos quedamos, para la F1 máxima, con precisión:
- Umbral automático en función de Maximizar Sensibilidad y Especificidad
Evaluamos la ROC
## AUC: 0.8471764## Punto de corte óptimo (umbral): 0.531285El punto de corte óptimo es aquel que maximiza el cociente de verdaderos positivos (sensibilidad), y al mismo tiempo minimiza el ratio de falsos positivos (1−especificidad). Será el punto de la curva que quede lo más arriba y a la izquierda posible, Por lo que se maximizan ambos parámetros, teniendo en cuenta que aumentar uno significa disminuir el otro.
Dentro de este apartado, dispondremos de una función, que nos dá el punto de corte óptimo. Es decir, el punto de la curva ROC que maximiza el cociente de verdaderos positivos (sensibilidad) y que al mismo tiempo minimiza el ratio de falsos positivos (1−especificidad). Es llegar a un compromiso de maximización de ambos parámetros, teniendo en cuenta que aumentar uno significa disminuir el otro.
Evaluamos la matriz de confusión y las métricas con el umbral optimizado
# Covertimos el umbral en ceros y unos para que se ajuste a la TARGET
predicciones_rl_op <- ifelse(test = rl_predict > unname(Punto_Corte_Optimo_rl), yes = 1, no = 0)
matriz_confusion_rl_op <- table(test$TARGET_ABANDONO, predicciones_rl_op,
dnn = c("Predicción", "Realidad"))
# la visualizamos
matriz_confusion_rl_op## Realidad
## Predicción 0 1
## 0 1716 127
## 1 364 279# La dibujamos
mosaic(matriz_confusion_rl_op, shade = T, colorize = T,
gp = gpar(fill = matrix(c("green3", "red2", "red2", "green3"), 2, 2)))
Aquí es donde debemos elegir en función de la parte de negocio. Está claro, que para realizar una campaña de marketing y evitar el abandono, es necesario estar seguro que el cliente va a abandonar. Si no podríamos incurrir en el error de “molestar” o quemar al cliente por exceso de publicidad o comunicaciones con él.
Vamos a seleccionar el criterio de precisión, con el corte óptimo averiguado en la curva ROC, y sacamos las métricas para tener un valor de partida.
Es importante analizar como cambia el rectángulo de arriba a la izquierda, de color verde (Precisión -Sensibilidad); ya que aumenta en relación al de la derecha de color rojo que disminuye. Por lo tanto aumenta la precisión con respecto al primer gráfico.
Con el rectángulo de abajo a la izquierda, de color rojo, ocurre lo contrario que en en el anterior gráfico de Matriz de Confusión, es decir, el rectángulo de abajo a la izquierda aumenta, (cobertura) por lo que la cobertura o número de clientes, que puedo predecir, que abandonarían la empresa con un alto porcentaje de probabilidad es menor.
Con este criterio estamos mas seguros de acertar con los clientes que abandonarían la empresa, pero el número que realmente podríamos seleccionar es menor.
Tendríamos estas métricas con el corte que optimiza sensibilidad y especificidad:
## umbral acierto precision cobertura F1 AUC
## 0.531285 80.249397 68.719212 43.390358 53.193518 85.000000Solo nos queda evaluar estos datos en la Evaluación y análisis del negocio, ya que viendo la Tabla Umbrales, se puede variar el umbral, si tenemos presente que prevalece la precisión sobre la cobertura, en nuestro caso.
Todo lo que “acertemos” en este punto se verá traducido en un mayor retorno de la inversión.
De momento lo dejaremos así y veremos si lo cambiamos en el punto 6.
5.2.2 Arboles de Decisión
Creamos el primer modelo
formula_ar <- formula
ar<-rpart(formula_ar, train, method = 'class', parms = list(
split = "information"),
control = rpart.control(cp = 0.00001)) # se puede comparar con GINI xerror (error de validación cruzada)
Revisamos donde el error de validación cruzada empieza a crecer. El xerror con validación cruzada y de ahí escogemos la cp menor (parámetro complejidad del árbol)
##
## Classification tree:
## rpart(formula = formula_ar, data = train, method = "class", parms = list(split = "information"),
## control = rpart.control(cp = 0.00001))
##
## Variables actually used in tree construction:
## [1] Contract Device_Tech_Sintetica InternetService
## [4] MultipleLines_Sintetica Num_Disc Online_Sintetica
## [7] PaperlessBilling_Sin Partner_Sintetica PaymentMethod
## [10] Streaming_Sintetica
##
## Root node error: 1226/4557 = 0.26904
##
## n= 4557
##
## CP nsplit rel error xerror xstd
## 1 0.05057096 0 1.00000 1.00000 0.024418
## 2 0.01386623 3 0.80832 0.80832 0.022714
## 3 0.01223491 5 0.78059 0.82137 0.022845
## 4 0.00978793 7 0.75612 0.80424 0.022673
## 5 0.00489396 8 0.74633 0.76835 0.022297
## 6 0.00407830 9 0.74144 0.76101 0.022218
## 7 0.00224307 11 0.73328 0.75530 0.022156
## 8 0.00163132 15 0.72431 0.76835 0.022297
## 9 0.00130506 16 0.72268 0.77243 0.022341
## 10 0.00122349 21 0.71615 0.76835 0.022297
## 11 0.00097879 27 0.70881 0.77162 0.022332
## 12 0.00081566 32 0.70392 0.77080 0.022323
## 13 0.00048940 37 0.69984 0.77162 0.022332
## 14 0.00040783 42 0.69739 0.77977 0.022419
## 15 0.00020392 52 0.69331 0.78793 0.022504
## 16 0.00001000 56 0.69250 0.79038 0.022530## [1] 0.002243067
Ademas vamos a incluir un nuevo parámetro, maxdepth para que el árbol no tenga mas de 7 niveles,con el nuevo parámetro de complejidad.
- Revisamos, de nuevo, la complejidad
##
## Classification tree:
## rpart(formula = formula, data = train, method = "class", parms = list(split = "information"),
## control = rpart.control(cp = Minimo_Complejidad(ar), maxdepth = 7))
##
## Variables actually used in tree construction:
## [1] Contract InternetService MultipleLines_Sintetica
## [4] Num_Disc PaperlessBilling_Sin PaymentMethod
##
## Root node error: 1226/4557 = 0.26904
##
## n= 4557
##
## CP nsplit rel error xerror xstd
## 1 0.0505710 0 1.00000 1.00000 0.024418
## 2 0.0138662 3 0.80832 0.80832 0.022714
## 3 0.0122349 5 0.78059 0.81811 0.022813
## 4 0.0097879 7 0.75612 0.79690 0.022597
## 5 0.0048940 8 0.74633 0.76754 0.022288
## 6 0.0022431 9 0.74144 0.75938 0.022200## [1] 0.002243067
## Ahora parece bastante estable con este valor de cp: 0.002243067 .Vamos, ahora, a crear el gráfico
## del árbol para analizarlo- Dibujamos el árbol
Se aprecia, que una de las principales variables, que dividen por clase, es contract, tal y como se vió con Random Forest y con WOE e IV en el apartado 3.2.1 Preselección de variables y mas concretamente, en el 3.2.1.4.
Con ello se aprecia que:
- Existe un 27% de clientes que potencialmente pueden abandonar la TELCO.
- Con un contrato de “Month-to_month”, es mas probable abandonar la TELCO. (73 %)
- Según la variable Internet Sevice, si tienes “Fiber Optic”, es mas fácil aún abandonar la compañía.
y así descendemos por árbol valorando cada rama.
Reglas del Árbol
Una de las facilidades de los árboles de decisión, es su interpretabilidad, que lo hace muy fácil de entender. Sacando las reglas de decisión, creadas con él, se puede llevar a cabo el paso a producción, con ellas, si se eligiera este método.
Vamos a calcular los scorings y evaluar el modelo
- BOX-PLOT
Se aprecia poca mejora respecto a regresión logística. Es cierto que las medias de las distribuciones, están mas alejadas entre sí, podría clasificar mejor, lo veremos en la tabla final de métricas que sacaremos.
Con la función umbrales probamos diferentes cortes
- Umbral automático en función de F1
Seleccionamos automáticamente el mejor umbral
## [1] 0.3Evaluamos la matriz de confusión y las métricas con el umbral optimizado por F1. La media entre precisión y cobertura
## Realidad
## Predicción 0 1
## 0 1470 373
## 1 194 449
- Umbral automático en función de Maximizar Sensibilidad y Especificidad
Evaluamos la ROC
## AUC: 0.8127685## Punto de corte óptimo (umbral): 0.5882353Evaluamos la matriz de confusión y las métricas con el umbral optimizado
## Realidad
## Predicción 0 1
## 0 1703 140
## 1 359 284
Tendríamos estas métricas con el corte que optimiza sensibilidad y especificidad:
## umbral acierto precision cobertura F1 AUC
## 0.5882353 79.9275945 66.9811321 44.1679627 53.2333646 81.0000000Solo nos queda evaluar estos datos en la evaluación y análisis del negocio, ya que viendo la Tabla Umbrales, se puede variar el umbral, si tenemos presente que prevalece la precisión sobre la cobertura, en nuestro caso.
Al igual que en el modelo de Regresión Logística, Todo lo que “acertemos” en este punto se verá traducido en un mayor retorno de la inversión.
5.2.3 Random Forest
- Creamos el modelo
##
## Call:
## randomForest(formula = formula_rf, data = train, importance = T)
## Type of random forest: classification
## Number of trees: 500
## No. of variables tried at each split: 3
##
## OOB estimate of error rate: 20.69%
## Confusion matrix:
## 0 1 class.error
## 0 2964 367 0.1101771
## 1 576 650 0.4698206- Se aprecia un valor de OOB (Out-of-Bag-Error)=20,21%. Vemos como varía el error a medida que aumentamos el número de árboles.
+ Línea Negra: Error OOB
+ Línea verde es el error al predicir 1
+ Línea verde es el error al predicir 0- Visualizamos las variables mas importantes
- Como hay dos criterios vamos a crear una única variable agregada y visualizarla para tener una mejor idea de la importancia de cada variable
- Existe un salto grande, en la importancia de las variables, a partir de Online_Sintética. Escogemos a partir de Ranking O Imp_tot > 0.7
Creamos de nuevo el modelo con las nuevas variables
##
## Call:
## randomForest(formula = formula_rf, 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: 20.72%
## Confusion matrix:
## 0 1 class.error
## 0 2998 333 0.09996998
## 1 611 615 0.49836868Aplicamos el modelo al conjunto de test, generando un vector con las probabilidades. Notar que por el método predict de Random Forest, hay que poner el type=prob para tener el scoring, lo cual nos dará una matriz que nos tenemos que quedar con la segunda columna
- BOX-PLOT
Se aprecia que diferencia bien para valores de 0 (no abandono), pero no para valores de 1 (sí abandono), el 75% de la distribución está muy distribuida con scorings de 0.1 a 0.8, por lo que creemos que no diferenciará bien. Tal y como le ocurría, con menor medida, al modelo de árboles de decisión. Parecido el diagrama al de árboles de decisión.
- Umbral automático en función de F1
Con la función umbrales probamos diferentes cortes
Seleccionamos automáticamente el mejor umbral
## [1] 0.25Evaluamos la matriz de confusión y las métricas con el umbral optimizado por F1. La media entre precisión y cobertura
## Realidad
## Predicción 0 1
## 0 1526 317
## 1 204 439
- Umbral automático en función de Maximizar Sensibilidad y Especificidad
Evaluamos la ROC
## AUC: 0.8274211## Punto de corte óptimo (umbral): 0.64Evaluamos la matriz de confusión y las métricas con el umbral optimizado
# Covertimos el umbral en ceros y unos para que se ajuste a la TARGET
predicciones_rf_op <- ifelse(test = rf_predict > unname(Punto_Corte_Optimo_rf), yes = 1, no = 0)
matriz_confusion_rf_op <- table(test$TARGET_ABANDONO, predicciones_rf_op,
dnn = c("Predicción", "Realidad"))
# la visualizamos
matriz_confusion_rf_op## Realidad
## Predicción 0 1
## 0 1745 98
## 1 380 263# La dibujamos
mosaic(matriz_confusion_rf_op, shade = T, colorize = T,
gp = gpar(fill = matrix(c("#4575b4", "red2", "red2", "#4575b4"), 2, 2)))
Tendríamos estas métricas con el corte que optimiza sensibilidad y especificidad:
## umbral acierto precision cobertura F1 AUC
## 0.64000 80.77233 72.85319 40.90202 52.39044 83.00000Solo nos queda evaluar estos datos en al Evaluación y análisis del negocio, ya que viendo la Tabla Umbrales, se puede variar el umbral, si tenemos presente que prevalece la precisión sobre la cobertura, en nuestro caso.
Al igual que en el modelo de Regresión Logística, Todo lo que “acertemos” en este punto se verá traducido en un mayor retorno de la inversión.
5.2.4 h2o y AutoML con h2o
- Cargamos el cache temporal, eliminando los factores ordenados, que dan error con “as.h2o()”
# Existe error al convertir el df con factores ordenados, le quitamos el orden.
df$InternetService<-factor(df$InternetService, ordered = FALSE)
df$Contract<-factor(df$Contract, ordered = FALSE)
df$PaymentMethod <-factor(df$PaymentMethod, ordered = FALSE) - Inicializamos el cluster de H2O
## Connection successful!
##
## R is connected to the H2O cluster:
## H2O cluster uptime: 14 minutes 10 seconds
## H2O cluster timezone: Europe/Paris
## H2O data parsing timezone: UTC
## H2O cluster version: 3.32.1.2
## H2O cluster version age: 2 years, 10 months and 7 days !!!
## H2O cluster name: H2O_started_from_R_evely_nos016
## H2O cluster total nodes: 1
## H2O cluster total memory: 1.81 GB
## H2O cluster total cores: 8
## H2O cluster allowed cores: 8
## H2O cluster healthy: TRUE
## H2O Connection ip: localhost
## H2O Connection port: 54321
## H2O Connection proxy: NA
## H2O Internal Security: FALSE
## H2O API Extensions: Amazon S3, Algos, AutoML, Core V3, TargetEncoder, Core V4
## R Version: R version 4.0.3 (2020-10-10)Cargamos los datos en el cluster h2o
Creamos las particiones
# Particiones en grupo de entrenamiento y grupo de test
split <- h2o.splitFrame(df_h2o) #crea las particiones y devuelve una lista
train_h2o <- split[[1]] # Al leer el split se ve el primer elemento. Entrenamiento
valid_h2o <- split[[2]] # Segundo elemento. Validación
split <- NULL #eliminamos porque ya no la usaremos- Definimos los roles de las variables
- Ahora, y bajo h2o, estudiaremos el modelo, con Regresión Logística, Random Forest y GBM (Gradient Boosting Machine)
Regresión Logística con H2O
Vamos a crear un primer modelo con h2o
Sacamos la significación de los coeficientes. Elegimos, como en anteriores modelos, p-value<<<0.
# (Type_off) Al ser una estructura de clase S4, si fuera S3, lo mismo, se indexan con la @
Variables_RL_H2O<- rl_H2o@model$coefficients_table %>%
as.data.frame() %>%
mutate(coefficients = round(coefficients,2),
p_value = round(p_value,2)) %>%
select(names,coefficients,p_value) #dejamos solo
Variables_RL_H2O## [1] "Intercept" "Num_Disc.02_95_370"
## [3] "Num_Disc.03_370_1100" "Num_Disc.04_1100_3100"
## [5] "Num_Disc.05_3100_9000" "PaymentMethod.Electronic check"
## [7] "InternetService.Fiber optic" "InternetService.No"
## [9] "Contract.One year" "Contract.Two year"
## [11] "Streaming_Sintetica.1" "PaperlessBilling_Sin.1"
## [13] "MultipleLines_Sintetica.1"Elegimos variables significativas y volvemos a evaluar.
Definimos los roles de las variables
- Algunas métricas
# Vemos la salida del modelo. En este caso nos interesa en el grupo de validación
rl_H2o_var_definitiva@model$validation_metrics@metrics$max_criteria_and_metric_scores# Muy importante, los valores de la AUC para Cross Validation.
# Nos garantizan que el resultado se podrá poner en producción
# sin grandes fallos, solo los estipulados.
rl_H2o_var_definitiva@model$cross_validation_metrics_summaryEste punto nos garantiza el paso a producción sin problemas. Cross-validation nos da 5 valores de AUC, muy próximos, por lo que ha reducido la varianza del modelo y evitará problemas de sobre ajuste en el futuro.
Calculamos el scoring para Regresión Logística
Se verá tabla conjunto en el análisis de negocio. Apartado 6
Random Forest con H2O
- Evaluamos ahora con Random Forest con Random Search
Definiremos manualmente los 2 parámetros principales mtries y ntree
- Optimizando los algoritmos con Random Search
# Definimos hyperparámetros
rf_params <- list(
ntrees = c(5,30,40),
mtries = c(4,5,10),
max_depth = c(5,15,30)
)- Nuevo modelo RandomForest con h2o. Usando h2o.grid
##
|
| | 0%
|
|= | 1%
|
|= | 2%
|
|== | 3%
|
|== | 4%
|
|=== | 4%
|
|==== | 5%
|
|==== | 6%
|
|===== | 7%
|
|====== | 8%
|
|====== | 9%
|
|======= | 10%
|
|======== | 11%
|
|========= | 12%
|
|========= | 13%
|
|========== | 14%
|
|=========== | 15%
|
|=========== | 16%
|
|============ | 17%
|
|============= | 18%
|
|============= | 19%
|
|============== | 20%
|
|============== | 21%
|
|=============== | 22%
|
|================ | 22%
|
|================ | 23%
|
|================= | 24%
|
|================== | 25%
|
|================== | 26%
|
|=================== | 27%
|
|=================== | 28%
|
|==================== | 28%
|
|===================== | 29%
|
|===================== | 30%
|
|====================== | 31%
|
|====================== | 32%
|
|======================= | 33%
|
|======================== | 34%
|
|======================== | 35%
|
|========================= | 35%
|
|========================= | 36%
|
|========================== | 37%
|
|=========================== | 38%
|
|=========================== | 39%
|
|============================ | 40%
|
|============================ | 41%
|
|============================= | 42%
|
|============================== | 42%
|
|======================================================================| 100%Evaluamos los resultados
## H2O Grid Details
## ================
##
## Grid ID: rf_grid_rand
## Used hyper parameters:
## - max_depth
## - mtries
## - ntrees
## Number of models: 54
## Number of failed models: 0
##
## Hyper-Parameter Search Summary: ordered by decreasing auc
## max_depth mtries ntrees model_ids auc
## 1 5 5 40 rf_grid_rand_model_32 0.8398327707510584
## 2 5 5 40 rf_grid_rand_model_7 0.8379588365060162
## 3 5 5 30 rf_grid_rand_model_49 0.8378719788071773
## 4 5 4 40 rf_grid_rand_model_15 0.8376503480353719
## 5 5 4 30 rf_grid_rand_model_39 0.8373172719429324
##
## ---
## max_depth mtries ntrees model_ids auc
## 49 30 10 40 rf_grid_rand_model_11 0.7897146359005864
## 50 30 10 5 rf_grid_rand_model_21 0.785411646260516
## 51 15 10 30 rf_grid_rand_model_24 0.7808928090299764
## 52 15 10 5 rf_grid_rand_model_37 0.7793071825227404
## 53 30 10 5 rf_grid_rand_model_44 0.7792729939754036
## 54 15 10 5 rf_grid_rand_model_13 0.7785672587884309Seleccionamos el mejor modelo
# Métricas
#Sacamos solo las métricas de validación
rf_winner@model$validation_metrics@metrics$max_criteria_and_metric_scores- Calculamos el scoring Random Forest
Se verá tabla conjunto en el análisis de negocio. Apartado 6
Gradient Boosting Machine GBM con h2o
- Probamos con otro modelo diferente, ya que por definición, el modelo tree no tiene búsqueda de hiperpárametros.
En este caso, el seleccionado tiene una razón, clara, reducir el error a medida que avanzamos secuencialmente en la búsqueda de un mejor modelo.
## Model Details:
## ==============
##
## H2OBinomialModel: gbm
## Model ID: modelo_gbm
## Model Summary:
## number_of_trees number_of_internal_trees model_size_in_bytes min_depth
## 1 100 100 15883 3
## max_depth mean_depth min_leaves max_leaves mean_leaves
## 1 3 3.00000 8 8 8.00000
##
##
## H2OBinomialMetrics: gbm
## ** Reported on training data. **
##
## MSE: 0.1487538
## RMSE: 0.3856861
## LogLoss: 0.4587469
## Mean Per-Class Error: 0.2484942
## AUC: 0.8385734
## AUCPR: 0.6322515
## Gini: 0.6771467
## R^2: 0.232706
##
## Confusion Matrix (vertical: actual; across: predicted) for F1-optimal threshold:
## 0 1 Error Rate
## 0 3149 739 0.190072 =739/3888
## 1 426 962 0.306916 =426/1388
## Totals 3575 1701 0.220811 =1165/5276
##
## Maximum Metrics: Maximum metrics at their respective thresholds
## metric threshold value idx
## 1 max f1 0.332213 0.622855 24
## 2 max f2 0.243077 0.748605 40
## 3 max f0point5 0.389039 0.619182 18
## 4 max accuracy 0.410828 0.800038 14
## 5 max precision 0.554909 0.869159 0
## 6 max recall 0.108050 1.000000 60
## 7 max specificity 0.554909 0.996399 0
## 8 max absolute_mcc 0.355477 0.474039 22
## 9 max min_per_class_accuracy 0.298863 0.747428 27
## 10 max mean_per_class_accuracy 0.248709 0.759435 37
## 11 max tns 0.554909 3874.000000 0
## 12 max fns 0.554909 1295.000000 0
## 13 max fps 0.108050 3888.000000 60
## 14 max tps 0.108050 1388.000000 60
## 15 max tnr 0.554909 0.996399 0
## 16 max fnr 0.554909 0.932997 0
## 17 max fpr 0.108050 1.000000 60
## 18 max tpr 0.108050 1.000000 60
##
## Gains/Lift Table: Extract with `h2o.gainsLift(<model>, <data>)` or `h2o.gainsLift(<model>, valid=<T/F>, xval=<T/F>)`
## H2OBinomialMetrics: gbm
## ** Reported on validation data. **
##
## MSE: 0.1526185
## RMSE: 0.3906641
## LogLoss: 0.4672402
## Mean Per-Class Error: 0.2277704
## AUC: 0.8393074
## AUCPR: 0.6456707
## Gini: 0.6786147
## R^2: 0.2296393
##
## Confusion Matrix (vertical: actual; across: predicted) for F1-optimal threshold:
## 0 1 Error Rate
## 0 890 396 0.307932 =396/1286
## 1 71 410 0.147609 =71/481
## Totals 961 806 0.264290 =467/1767
##
## Maximum Metrics: Maximum metrics at their respective thresholds
## metric threshold value idx
## 1 max f1 0.259857 0.637141 32
## 2 max f2 0.153345 0.754472 45
## 3 max f0point5 0.421064 0.631821 12
## 4 max accuracy 0.421064 0.798529 12
## 5 max precision 0.554909 0.965517 0
## 6 max recall 0.108050 1.000000 57
## 7 max specificity 0.554909 0.999222 0
## 8 max absolute_mcc 0.259857 0.486552 32
## 9 max min_per_class_accuracy 0.298863 0.753499 25
## 10 max mean_per_class_accuracy 0.259857 0.772230 32
## 11 max tns 0.554909 1285.000000 0
## 12 max fns 0.554909 453.000000 0
## 13 max fps 0.108050 1286.000000 57
## 14 max tps 0.108050 481.000000 57
## 15 max tnr 0.554909 0.999222 0
## 16 max fnr 0.554909 0.941788 0
## 17 max fpr 0.108050 1.000000 57
## 18 max tpr 0.108050 1.000000 57
##
## Gains/Lift Table: Extract with `h2o.gainsLift(<model>, <data>)` or `h2o.gainsLift(<model>, valid=<T/F>, xval=<T/F>)`- Se sigue apreciando el valor en la predicción, y el problema desde negocio, con las variables: contract e Internetservice.
Mismos resultados que en modelos anteriores.
- Evaluamos
# Métricas
#Sacamos solo las métricas de validación
GBM_h2o@model$validation_metrics@metrics$max_criteria_and_metric_scores- Calculamos el scoring GBM
Se verá tabla conjunto en el análisis de negocio. Apartado 6
El Uso de AutoML en h2o está En Construcción
5.3 Comparamos Métodos
- Manuales
## Regresion Logística Arbol Decisión Random Forest
## umbral 0.531285 0.5882353 0.64000
## acierto 80.249397 79.9275945 80.77233
## precision 68.719212 66.9811321 72.85319
## cobertura 43.390358 44.1679627 40.90202
## F1 53.193518 53.2333646 52.39044
## AUC 85.000000 81.0000000 83.00000- h2o
## Regresión Logística GBM Random Forest
## AUC 83 84 84Nos quedaremos con la regresión logística manual. De cualquier modo compararemos los scoring a modo de evaluación.
5.4 Escribimos Scoring Final. Guardamos Modelo
Creamos y guardamos el scoring
# Aquí pasamos todo la predicción de los manuales
# Manuales
df$SCORING_ABANDONO_RL <- predict(rl,df,type = 'response')
# h20
df$SCORING_RL_H2O<-SCORING_RL_H2O
df$SCORING_GBM_H2O<-SCORING_GBM_H2O
df$SCORING_RF_H2O<-SCORING_RF_H2O- Limpiamos el entorno y nos quedamos solo con el dataframe
Cargamos la sesión
- Cargamos el cache temporal
6 Evaluación y análisis de negocio
Vamos a visualizar el abandono real por tramos de scoring. Este gráfico es muy potente para ver que el modelo es consistente, ya que debe presentar una linea descendente en la tasa de contratación conforme se desciende en el scoring.
Y ahora, ¿qué?. Con la tabla final obtenida de los modelos, escogeremos el modelo de Regresión Logística, y compararemos con los obtenidos con h2o, que nos han devuelto una AUC parecida.
Recordemos que la AUC mide lo bueno que es el modelo, ya que predice que bien se ajusta a los datos. A partir de 0.8 (80), se considera un buen modelo.
6.1 Opción 1:
Con la precisión obtenida, vamos a calcular que número de clientes, necesitarían una campaña de retención, escogiendo el modelo que nos dá los mejores scorings, como es el de Regresión Logística “manual” (SCORING_ABANDONO_RL).
Se aprecia claramente, que el modelo que nos dá mayor scoring, a igualdad de AUC, es el de Regresión Logística, llamado manual.
## [1] 1210Como se puede ver, se aprecia que el número de clientes, con probabilidad de abandonar la compañía, mayor que la precisión obtenida, es de 1210 (Área verde).
Línea vertical de color rojo: es el valor de 1210 o, número de clientes con scoring mayor que el de la precisión maximizada, y obtenida en el modelo.
Línea horizontal azúl, scoring = precisión maximizada.
6.2 Opción 2:
- Vamos a ver cual sería el importe medio que pagan los 1210 clientes, seleccionados, y cuanto costaría la campaña. En el punto 2.2.2 se vió que el gasto medio por cliente es de 64,75 aproximadamente.
Visualizamos las curvas
## [1] "Tamaño maximo de campaña rentable: 1641"Desde los 1210 hasta los 1641 clientes, existe una diferencia de 431, que tienen un scoring bajo. No sería necesario realizarlo en ellos.
Luego siempre el retorno de la inversión, o del mantenimiento del cliente va a ser mayor.
6.3 Opción 3:
*Calculamos el punto optimo de retorno de la inversión
Vamos a calcular 2 nuevas variables que sean un agregado de los ingresos agregados y de los gastos agregados en cada potencial tamaño de campaña, y el ROI como diferencia de las anteriores, y vamos a localizar el tamaño de la campaña que va a maximizar ese ROI y también cuanto vamos a ganar previsiblemente
Visualizamos las curvas
Vamos a visualizar un zoom sobre el ROI solo en los tamaños de campaña que son positivos para localizar el punto optimo
## El tamaño óptimo de campaña para el ROI es de: 1641 clientes
## Con unos ingresos esperados, en forma de mantenimiento de clientes,
## que abandonarian en caso contrario, de: 45494 €
## Y unos costes agregados de: 24615 €
## Que van a generar un Retorno Neto de la Inversión de: 20879 € en forma de destrucción de fugaA esto deberíamos quitar los 431 clientes, por debajo de la precisión necesaria para garantizar un aprovechamiento de la campaña de retención. Por ello habría que restar un gasto de 431*15=6.465 menos de gasto con el mismo ingreso.
Como punto final habría que tener presente que los principales problemas, a afrontar por la compañía para evitar el abandono, son:
1. Con contratos de "Month-to-month", el abandono es muy probable. Se vió en la valoración de las variables mas predictoras del abandono. 2. Con servicios de internet, de tipo "Fiber Optic", ocurre lo mismo, es decir el abandono es muy probable. Se vió en la valoración de las variables mas predictoras del abandono.
La compañía debe de mejorar en estos dos apartados, para evitar en el futuro el aumento de la fuga.
7 Conclusiones en Power BI
Se aprecia como el abandono es mayor para contratos de mes a mes y con fibra óptica contratada.
Esta información, no se ha obtenido tan claramente con la importancia de las variables, obtenidas por variables, salvo al obtener la visualización con Power BI.
8 Bibliografía
DS4B Isaac González Página
R for Data Science de Hadley Wickham y Garrett Grolemund Libro
In-depth introduction to machine learning in 15 hours of expert videos Página
R Markdown: la guía definitiva. Yihui Xie, JJ Allaire, Garrett Grolemund LIBRO
COLOR BREWER 2.0 Consejos de Color para Cartografía Página
RPubs Publicaciones RPUBS
RStudio Community Página
Feature Engineering and Selection: A Practical Approach for Predictive Models Max Kuhn and Kjell Johnson Libro
h2o Página
h2o.aiPágina