Data Desbalanceada
Jhampier Tapia
2/4/2021
LECTURA DE DATOS
La data solo contiene aprox. 5% de casos positivos (clientes en Desafiliado)
# =============================================================================
# TRATAMIENTO DE DATOS NO BALANCEADOS
# =============================================================================
# DATOS -------------------------------------------------------------------
setwd('F:/UNI BUSSINES INTELLIGENCE/Modulo II - Data Analyst Advanced/4_Balanceo')
# Cargar la base de datos
desafiliados <- read.csv('DatosDesafiliado.csv', header = T, stringsAsFactors =TRUE)
# Estructura de los datos
str(desafiliados)## 'data.frame': 4500 obs. of 6 variables:
## $ Plan_internacional : Factor w/ 2 levels "no","yes": 1 1 1 1 1 1 1 1 1 1 ...
## $ Minutos_dia : num 203 264 102 229 125 ...
## $ Minutos_internacionales : num 9 7.5 9.4 7.4 10.2 15.2 13.2 8.3 10.8 11.3 ...
## $ Reclamos : int 3 2 3 3 2 2 1 1 3 2 ...
## $ Llamadas_internacionales: int 3 4 6 6 7 5 4 2 4 5 ...
## $ Desafiliado : Factor w/ 2 levels "no","yes": 1 2 1 1 1 1 1 1 1 1 ...# Desafiliado: El cliente incumplió con su deuda
# Plan_internacional: El cliente es o no estudiante
# income: ingreso anual del cliente
# balance: Saldo mensual de la TC
#install.packages('skimr')
#library(skimr)
#skimr::skim(desafiliados)
# Visualizamos algunos datos
head(desafiliados)## Plan_internacional Minutos_dia Minutos_internacionales Reclamos
## 1 no 202.9 9.0 3
## 2 no 264.5 7.5 2
## 3 no 101.7 9.4 3
## 4 no 229.2 7.4 3
## 5 no 125.0 10.2 2
## 6 no 188.5 15.2 2
## Llamadas_internacionales Desafiliado
## 1 3 no
## 2 4 yes
## 3 6 no
## 4 6 no
## 5 7 no
## 6 5 no# Proporción por clase
table(desafiliados$Desafiliado)##
## no yes
## 4293 207prop.table(table(desafiliados$Desafiliado))##
## no yes
## 0.954 0.046# La data solo contiene aprox. 5% de casos positivos (clientes en Desafiliado)
# ANÁLISIS EXPLORATORIO
barplot(prop.table(table(desafiliados$Desafiliado)),
col = rainbow(2),
ylim = c(0, 1),
main = "Distribución de Clases")
#desafiliados$Reclamos
library(ggplot2)## Warning: package 'ggplot2' was built under R version 4.0.3
ggplot(data = desafiliados, aes(x = Reclamos, y = Llamadas_internacionales, color = Desafiliado)) +
geom_point(alpha = 0.6, size = 1.5) +
labs(x = "Reclamos", y = "Llamadas_internacionales", color = "desafiliados")
# Algunos análisis
# Las personas que incumplieron con el pago (Desafiliado) tendieron a tener saldos
# de tarjetas de crédito más altos que aquellos que no lo hicieron
ggplot(data = desafiliados, aes(x = Desafiliado, y = Minutos_dia)) +
geom_boxplot(fill = rainbow(2))
ggplot(data = desafiliados, aes(x = Desafiliado, y = Minutos_internacionales)) +
geom_boxplot(fill = rainbow(2))
ggplot(data = desafiliados, aes(x = Desafiliado, y = Reclamos)) +
geom_boxplot(fill = rainbow(2))
ggplot(data = desafiliados, aes(x = Desafiliado, y = Llamadas_internacionales)) +
geom_boxplot(fill = rainbow(2))
table(desafiliados$Plan_internacional,desafiliados$Desafiliado)##
## no yes
## no 4019 151
## yes 274 56library(dplyr)## Warning: package 'dplyr' was built under R version 4.0.3##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, uniondesafiliados %>%
count(Desafiliado, Plan_internacional) %>%
ggplot(mapping = aes(x = Desafiliado, y = Plan_internacional)) +
geom_tile(mapping = aes(fill = n)) +
labs(x = "desafiliados", y = "Plan_internacional") +
scale_fill_continuous(name = "Frecuencia")
## APLICANDO EL MODELO LOGÍSTICO
# SIN BALANCEAR LOS DATOS -------------------------------------------------
# Trabajar con datos no balanceados, en la mayoría de los casos, nos daría
# un modelo de predicción que siempre devuelve la clase mayoritaria.
# El clasificador estaría sesgado.
library(caret)## Warning: package 'caret' was built under R version 4.0.3## Loading required package: latticesplit <- 0.8 # Porcentaje de datos al conjunto de entrenamiento
set.seed(2021)
trainIndex <- createDataPartition(desafiliados$Desafiliado, p = split, list = FALSE)
desafiliados_train <- desafiliados[trainIndex,]
desafiliados_test <- desafiliados[-trainIndex,]
# Otra Manera
# indices <- sample(1:nrow(desafiliados), replace = F, size = 0.2*nrow(desafiliados))
# train <- desafiliados[-indices,]
# test <- desafiliados[indices,]
# Modelo Logístico
desafiliados_nbal <- glm(Desafiliado ~., data = desafiliados_train, family = binomial(link = "logit"))
summary(desafiliados_nbal)##
## Call:
## glm(formula = Desafiliado ~ ., family = binomial(link = "logit"),
## data = desafiliados_train)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.4103 -0.3042 -0.2118 -0.1497 3.2419
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -7.886363 0.568902 -13.862 < 2e-16 ***
## Plan_internacionalyes 1.855978 0.200588 9.253 < 2e-16 ***
## Minutos_dia 0.016445 0.001772 9.278 < 2e-16 ***
## Minutos_internacionales 0.053672 0.031411 1.709 0.0875 .
## Reclamos 0.396106 0.059461 6.662 2.71e-11 ***
## Llamadas_internacionales 0.019829 0.034253 0.579 0.5627
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1345.8 on 3600 degrees of freedom
## Residual deviance: 1133.4 on 3595 degrees of freedom
## AIC: 1145.4
##
## Number of Fisher Scoring iterations: 6EVALUANDO INDICADORES DEL MODELO
# Predicción de probabilidades sobre el test
desafiliados_nbal_pred <- predict(desafiliados_nbal, newdata = desafiliados_test, type = "response")
head(desafiliados_nbal_pred)## 3 4 6 7 8 15
## 0.012102809 0.082201089 0.043965354 0.044999088 0.011233088 0.008713505# Nivel de la desafiliados en test
desafiliados_nbal_pred_clase <- factor(ifelse(desafiliados_nbal_pred > 0.5, 1, 0))
levels(desafiliados_nbal_pred_clase) <- c("No","Si")
# Cambiar los niveles pues están en inglés
levels(desafiliados_test$Desafiliado) <- c("No","Si")
# Evaluación del modelo sin balancear
# Matriz de confusión en base al test
table(Predicho = desafiliados_nbal_pred_clase, Real = desafiliados_test$Desafiliado)## Real
## Predicho No Si
## No 857 41
## Si 1 0# Matriz Confusión sobre el test
# table(desafiliados_test$Desafiliado, desafiliados_nbal_pred > 0.5)
library(caret)
Modelo_SinBalanceo <- confusionMatrix(desafiliados_nbal_pred_clase, desafiliados_test$Desafiliado, positive = "Si", mode="everything")
# Accuracy
confusionMatrix(desafiliados_nbal_pred_clase, desafiliados_test$Desafiliado, positive = "Si")$overall[1]## Accuracy
## 0.9532814# Error de clasificación
library(Metrics)## Warning: package 'Metrics' was built under R version 4.0.4##
## Attaching package: 'Metrics'## The following objects are masked from 'package:caret':
##
## precision, recallce(actual = desafiliados_test$Desafiliado, predicted = desafiliados_nbal_pred_clase)## [1] 0.04671858# AUC
library(Metrics)
auc(actual = ifelse(desafiliados_test$Desafiliado == "Si", 1, 0),
predicted = desafiliados_nbal_pred)## [1] 0.8119848# Se cambia a numérico porque solo acepta este tipo de dato
# Curva ROC
library(ROCR)## Warning: package 'ROCR' was built under R version 4.0.4ROCRpred <- prediction(desafiliados_nbal_pred, desafiliados_test$Desafiliado)
# Primer argumento: Predicciones con el modelo
# Segundo argumento: Valores reales de los datos
ROCRperf <- performance(ROCRpred, "tpr", "fpr")
# EjeX: fpr (False Positive Rate)
# EjeY: tpr (True Positive Rate)
# Gráfico de la curva ROC
plot(ROCRperf)
plot(ROCRperf, colorize = TRUE)
plot(ROCRperf, colorize = TRUE, print.cutoffs.at = seq(0, 1, by = 0.1), text.adj = c(-0.2,1.7))
APLICANDO BALANCEO
# CON BALANCEO ------------------------------------------------------------
# 1. OVERSAMPLING ---------------------------------------------------------
# Replica aleatoriamente la clase minoritaria para incrementar su tamaño
# Oversampling la clase minoritaria puede llevar a problemas de overfitting.
library(ROSE)## Warning: package 'ROSE' was built under R version 4.0.4## Loaded ROSE 0.0-3prop.table(table(desafiliados_train$Desafiliado))##
## no yes
## 0.95390169 0.04609831# Cantidad de observaciones en desafiliados_train que son Desafiliado = no
table(desafiliados_train$Desafiliado)[1]## no
## 3435desafiliados_bal_over <- ovun.sample(Desafiliado ~ ., data = desafiliados_train, method = "over",
N = table(desafiliados_train$Desafiliado)[1]*2)$data
table(desafiliados_bal_over$Desafiliado)##
## no yes
## 3435 3435head(desafiliados_bal_over)## Plan_internacional Minutos_dia Minutos_internacionales Reclamos
## 1 no 202.9 9.0 3
## 2 no 125.0 10.2 2
## 3 no 155.6 10.8 3
## 4 no 121.5 11.3 2
## 5 no 110.8 8.9 2
## 6 no 124.8 11.3 1
## Llamadas_internacionales Desafiliado
## 1 3 no
## 2 7 no
## 3 4 no
## 4 5 no
## 5 4 no
## 6 3 no# 2. UNDERSAMPLING --------------------------------------------------------
# Remueve aleatoriamente la clase mayoritaria para equilibrar los tamaños
# El modelo se entrena con pocas observaciones.
# Cuanto más desbalanceados sean los datos, mayor cantidad de observaciones se
# descartarán al realizar undersampling.
# Cantidad de observaciones en desafiliados_train que son Desafiliado = yes
table(desafiliados_train$Desafiliado)[2]## yes
## 166desafiliados_bal_under <- ovun.sample(Desafiliado ~ ., data = desafiliados_train, method = "under", N = table(desafiliados_train$Desafiliado)[2]*2)$data
table(desafiliados_bal_under$Desafiliado)##
## no yes
## 166 166# 3. AMBOS UNDERSAMPLING Y OVERSAMPLING -----------------------------------
# Es una combinación de los métodos oversampling y undersampling.
# La clase mayoritaria es sub-muestreada (undersampled) sin reemplazamiento y
# la clase minoritaria es sobre-muestreada (oversampled) con reemplazamiento.
# Cantidad de observaciones en el conjunto de entrenamiento
dim(desafiliados_train)[1]## [1] 3601desafiliados_bal_ambos <- ovun.sample(Desafiliado ~ ., data = desafiliados_train,
method = "both",
p= 0.5,
N = dim(desafiliados_train)[1],
seed = 1)$data
# p es la prob. de la clase positiva en la nueva muestra generada
table(desafiliados_bal_ambos$Desafiliado)##
## no yes
## 1853 1748prop.table(table(desafiliados_bal_ambos$Desafiliado))##
## no yes
## 0.5145793 0.4854207# Verificar clase mayoritaria
library(dplyr)
desafiliadosYes <- desafiliados_bal_ambos %>% filter(Desafiliado == 'yes')
#View(desafiliadosYes)
# Contar valores únicos por columna
sapply(desafiliadosYes, function(x) length(unique(x)))## Plan_internacional Minutos_dia Minutos_internacionales
## 2 161 83
## Reclamos Llamadas_internacionales Desafiliado
## 9 16 1desafiliadosYes %>% distinct()## Plan_internacional Minutos_dia Minutos_internacionales Reclamos
## 1 no 61.2 13.7 5
## 2 no 273.8 5.8 2
## 3 no 287.4 5.0 4
## 4 no 210.9 10.6 3
## 5 no 234.2 9.8 0
## 6 yes 189.6 13.9 1
## 7 yes 323.7 8.5 6
## 8 yes 122.0 10.8 2
## 9 no 257.4 13.4 2
## 10 no 288.1 10.2 3
## 11 no 322.5 9.4 2
## 12 yes 279.8 8.4 2
## 13 no 245.8 9.0 1
## 14 no 261.4 8.0 1
## 15 no 269.2 8.9 3
## 16 no 328.1 8.7 1
## 17 yes 169.0 13.3 0
## 18 no 133.0 9.9 4
## 19 no 303.9 5.8 1
## 20 yes 242.2 13.9 2
## 21 yes 179.9 13.8 1
## 22 yes 244.2 15.4 2
## 23 no 248.7 13.2 1
## 24 no 285.7 8.7 1
## 25 no 123.2 12.9 4
## 26 no 144.8 13.3 0
## 27 no 224.7 7.5 1
## 28 no 256.4 7.9 3
## 29 no 245.4 10.5 3
## 30 no 279.1 9.5 2
## 31 no 335.5 12.7 2
## 32 no 337.4 15.8 0
## 33 yes 211.3 9.7 4
## 34 no 242.2 8.2 5
## 35 yes 274.0 11.3 3
## 36 yes 186.1 13.8 4
## 37 no 260.6 12.8 0
## 38 no 270.0 7.8 1
## 39 no 129.1 12.7 4
## 40 yes 62.6 10.4 1
## 41 yes 145.0 16.7 2
## 42 no 201.3 6.4 1
## 43 no 269.8 4.7 1
## 44 no 268.3 6.3 1
## 45 no 108.6 7.9 1
## 46 no 113.9 12.9 4
## 47 no 266.0 14.2 2
## 48 yes 112.6 11.1 0
## 49 yes 194.2 12.9 1
## 50 yes 148.5 14.5 1
## 51 no 244.7 10.5 2
## 52 yes 135.0 10.5 1
## 53 no 240.7 10.1 0
## 54 no 232.8 12.9 0
## 55 no 102.9 11.0 6
## 56 no 291.2 8.9 1
## 57 no 258.3 13.6 1
## 58 yes 165.5 11.5 1
## 59 no 160.1 7.6 5
## 60 no 290.1 7.4 2
## 61 no 273.2 13.1 2
## 62 no 119.0 9.0 2
## 63 no 170.8 9.6 5
## 64 no 254.6 9.0 2
## 65 no 251.3 12.9 1
## 66 yes 221.1 15.4 2
## 67 no 326.5 10.7 2
## 68 yes 103.2 11.9 0
## 69 no 294.3 5.8 2
## 70 no 226.9 11.6 0
## 71 yes 167.1 14.1 2
## 72 no 150.9 8.3 5
## 73 no 96.6 6.2 4
## 74 yes 148.2 9.2 4
## 75 no 227.1 4.7 5
## 76 yes 145.0 11.0 4
## 77 no 162.5 13.4 4
## 78 yes 199.6 11.0 3
## 79 no 313.6 7.5 1
## 80 no 264.9 8.4 1
## 81 no 317.8 10.4 1
## 82 no 234.4 2.0 1
## 83 no 264.5 7.5 2
## 84 no 272.7 10.5 2
## 85 no 267.9 14.9 3
## 86 no 278.0 8.3 0
## 87 no 73.3 8.2 4
## 88 no 256.6 11.1 1
## 89 no 226.3 8.2 2
## 90 no 237.9 13.9 1
## 91 yes 130.7 9.4 2
## 92 no 267.0 11.3 1
## 93 no 180.6 10.6 4
## 94 no 289.3 6.4 1
## 95 no 166.9 12.3 1
## 96 no 279.5 10.7 2
## 97 no 267.1 17.3 1
## 98 yes 312.0 10.5 0
## 99 no 271.1 9.8 2
## 100 no 157.1 8.5 4
## 101 yes 242.3 11.3 0
## 102 no 118.4 13.6 5
## 103 no 209.4 7.4 1
## 104 no 266.1 8.9 3
## 105 no 81.9 8.9 2
## 106 yes 173.1 14.6 0
## 107 no 334.3 10.4 0
## 108 no 153.2 9.8 4
## 109 yes 159.6 7.3 4
## 110 no 220.9 13.5 1
## 111 yes 47.7 13.2 0
## 112 no 255.1 8.8 3
## 113 no 162.1 11.0 5
## 114 no 270.0 12.0 2
## 115 no 271.2 11.5 3
## 116 no 247.2 6.1 2
## 117 yes 180.9 8.6 2
## 118 no 179.7 9.3 1
## 119 yes 255.9 12.1 1
## 120 no 136.9 11.9 4
## 121 no 198.4 5.8 3
## 122 no 326.3 7.5 1
## 123 no 247.5 10.2 2
## 124 no 228.1 9.9 2
## 125 yes 225.3 17.3 1
## 126 no 282.5 9.4 1
## 127 no 217.6 10.4 2
## 128 no 288.0 13.4 0
## 129 yes 147.6 8.1 0
## 130 yes 122.2 10.3 5
## 131 no 261.8 14.7 0
## 132 yes 312.4 10.6 1
## 133 no 189.1 10.4 1
## 134 no 138.4 3.9 4
## 135 no 254.3 11.6 1
## 136 no 247.8 9.5 1
## 137 no 298.1 9.7 2
## 138 no 89.8 9.3 4
## 139 no 210.1 13.3 0
## 140 yes 143.2 6.2 4
## 141 no 150.6 10.4 8
## 142 yes 99.6 13.7 2
## 143 no 189.2 10.6 3
## 144 yes 233.5 9.6 0
## 145 no 258.7 11.4 1
## 146 no 167.9 9.2 4
## 147 yes 198.8 14.4 1
## 148 no 225.9 14.3 3
## 149 no 321.1 11.5 4
## 150 no 113.3 11.7 4
## 151 no 254.1 16.3 0
## 152 no 153.4 12.8 4
## 153 no 269.7 4.5 3
## 154 yes 246.8 13.2 0
## 155 no 275.5 4.8 3
## 156 no 167.8 10.5 4
## 157 no 123.7 8.8 1
## 158 yes 237.3 14.2 0
## 159 no 256.4 11.1 1
## 160 yes 225.7 14.0 1
## 161 yes 122.3 13.7 3
## 162 yes 220.2 4.1 0
## 163 yes 261.1 0.0 3
## 164 no 148.7 10.4 6
## 165 no 115.5 11.5 7
## 166 no 298.1 8.2 4
## Llamadas_internacionales Desafiliado
## 1 3 yes
## 2 3 yes
## 3 3 yes
## 4 5 yes
## 5 6 yes
## 6 7 yes
## 7 3 yes
## 8 2 yes
## 9 5 yes
## 10 4 yes
## 11 4 yes
## 12 10 yes
## 13 13 yes
## 14 6 yes
## 15 2 yes
## 16 3 yes
## 17 3 yes
## 18 3 yes
## 19 3 yes
## 20 5 yes
## 21 2 yes
## 22 3 yes
## 23 2 yes
## 24 4 yes
## 25 5 yes
## 26 9 yes
## 27 5 yes
## 28 1 yes
## 29 3 yes
## 30 11 yes
## 31 8 yes
## 32 7 yes
## 33 4 yes
## 34 3 yes
## 35 3 yes
## 36 5 yes
## 37 9 yes
## 38 6 yes
## 39 6 yes
## 40 2 yes
## 41 3 yes
## 42 6 yes
## 43 6 yes
## 44 7 yes
## 45 5 yes
## 46 8 yes
## 47 2 yes
## 48 2 yes
## 49 1 yes
## 50 7 yes
## 51 1 yes
## 52 1 yes
## 53 3 yes
## 54 7 yes
## 55 4 yes
## 56 3 yes
## 57 4 yes
## 58 2 yes
## 59 12 yes
## 60 4 yes
## 61 7 yes
## 62 6 yes
## 63 5 yes
## 64 18 yes
## 65 2 yes
## 66 4 yes
## 67 6 yes
## 68 2 yes
## 69 7 yes
## 70 2 yes
## 71 7 yes
## 72 4 yes
## 73 4 yes
## 74 1 yes
## 75 4 yes
## 76 2 yes
## 77 6 yes
## 78 4 yes
## 79 5 yes
## 80 4 yes
## 81 7 yes
## 82 2 yes
## 83 4 yes
## 84 3 yes
## 85 1 yes
## 86 4 yes
## 87 3 yes
## 88 3 yes
## 89 3 yes
## 90 4 yes
## 91 2 yes
## 92 7 yes
## 93 6 yes
## 94 7 yes
## 95 4 yes
## 96 4 yes
## 97 4 yes
## 98 2 yes
## 99 5 yes
## 100 5 yes
## 101 3 yes
## 102 3 yes
## 103 2 yes
## 104 8 yes
## 105 1 yes
## 106 15 yes
## 107 6 yes
## 108 3 yes
## 109 4 yes
## 110 9 yes
## 111 3 yes
## 112 3 yes
## 113 9 yes
## 114 5 yes
## 115 3 yes
## 116 5 yes
## 117 2 yes
## 118 8 yes
## 119 2 yes
## 120 4 yes
## 121 3 yes
## 122 1 yes
## 123 2 yes
## 124 5 yes
## 125 9 yes
## 126 4 yes
## 127 4 yes
## 128 4 yes
## 129 7 yes
## 130 9 yes
## 131 4 yes
## 132 2 yes
## 133 5 yes
## 134 9 yes
## 135 5 yes
## 136 6 yes
## 137 4 yes
## 138 7 yes
## 139 1 yes
## 140 4 yes
## 141 8 yes
## 142 6 yes
## 143 5 yes
## 144 2 yes
## 145 2 yes
## 146 6 yes
## 147 3 yes
## 148 3 yes
## 149 2 yes
## 150 2 yes
## 151 3 yes
## 152 4 yes
## 153 15 yes
## 154 5 yes
## 155 2 yes
## 156 6 yes
## 157 4 yes
## 158 4 yes
## 159 1 yes
## 160 7 yes
## 161 3 yes
## 162 2 yes
## 163 0 yes
## 164 7 yes
## 165 7 yes
## 166 4 yes# 4. ROSE -----------------------------------------------------------------
# Random Over-Sampling Examples
# Genera datos sintéticos basado en sampling methods y smoothed-bootstrap approach
desafiliados_bal_rose <- ROSE(Desafiliado ~ ., data = desafiliados_train, seed = 3)$data
table(desafiliados_bal_rose$Desafiliado)##
## no yes
## 1740 1861prop.table(table(desafiliados_bal_rose$Desafiliado))##
## no yes
## 0.4831991 0.5168009# 5. SMOTE ----------------------------------------------------------------
# Synthetic minority oversampling technique
# Toma la media entre los vecinos más cercanos a las obs. de la clase minoritaria
# y genera nuevas observaciones (sintéticas)
# Además, la clase mayoritaria es sub-muestreada (undersampling)
library(DMwR)## Loading required package: grid## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zooset.seed(2019) # Para tener resultados reproducibles
desafiliados_bal_smote <- DMwR::SMOTE(Desafiliado ~ ., data = desafiliados_train, perc.over = 200, k = 5, perc.under = 200)
##OTRA LIBRERIA
#install.packages("performanceEstimation")
library(performanceEstimation)## Warning: package 'performanceEstimation' was built under R version 4.0.4desafiliados_bal_smote <- smote(Desafiliado ~ ., data = desafiliados_train, perc.over = 2, k = 5, perc.under = 2)
table(desafiliados_bal_smote$Desafiliado)##
## no yes
## 664 498prop.table(table(desafiliados_bal_smote$Desafiliado))##
## no yes
## 0.5714286 0.4285714CREAMOS LOS MODELOS SMOTE Y OVER
# Modelo Logístico
Modelo_OverSampling <- glm(Desafiliado ~., data = desafiliados_bal_over, family = binomial(link = "logit"))
summary(Modelo_OverSampling)##
## Call:
## glm(formula = Desafiliado ~ ., family = binomial(link = "logit"),
## data = desafiliados_bal_over)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -3.0050 -0.8334 -0.0403 0.8798 2.1982
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -5.0585629 0.1850195 -27.341 < 2e-16 ***
## Plan_internacionalyes 2.5124322 0.0961859 26.121 < 2e-16 ***
## Minutos_dia 0.0162100 0.0005377 30.145 < 2e-16 ***
## Minutos_internacionales 0.0361015 0.0102891 3.509 0.00045 ***
## Reclamos 0.5636578 0.0220747 25.534 < 2e-16 ***
## Llamadas_internacionales 0.0253302 0.0107560 2.355 0.01852 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 9523.8 on 6869 degrees of freedom
## Residual deviance: 7274.5 on 6864 degrees of freedom
## AIC: 7286.5
##
## Number of Fisher Scoring iterations: 4# Modelo Logístico
Modelo_Smote <- glm(Desafiliado ~., data = desafiliados_bal_smote, family = binomial(link = "logit"))
summary(Modelo_Smote)##
## Call:
## glm(formula = Desafiliado ~ ., family = binomial(link = "logit"),
## data = desafiliados_bal_smote)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.6714 -0.7969 -0.3991 0.8834 2.3626
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -5.393380 0.473935 -11.380 <2e-16 ***
## Plan_internacionalyes 2.644031 0.243881 10.841 <2e-16 ***
## Minutos_dia 0.017516 0.001377 12.720 <2e-16 ***
## Minutos_internacionales 0.019861 0.026344 0.754 0.451
## Reclamos 0.513098 0.054152 9.475 <2e-16 ***
## Llamadas_internacionales 0.028173 0.028452 0.990 0.322
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1587.1 on 1161 degrees of freedom
## Residual deviance: 1198.3 on 1156 degrees of freedom
## AIC: 1210.3
##
## Number of Fisher Scoring iterations: 4# Modelo directo con datos balanceados (randomForest, )
library(randomForest)## Warning: package 'randomForest' was built under R version 4.0.4## randomForest 4.6-14## Type rfNews() to see new features/changes/bug fixes.##
## Attaching package: 'randomForest'## The following object is masked from 'package:dplyr':
##
## combine## The following object is masked from 'package:ggplot2':
##
## marginmodelo <- DMwR::SMOTE(Desafiliado ~ ., data = desafiliados_train, perc.over = 200, k = 5, perc.under = 200, learner = "randomForest")
###MODELO CON LA DATA DESBALANCEADA DE RAMDOM FOREST
modelo <- randomForest::randomForest(Desafiliado~., desafiliados_bal_smote)
table(desafiliados_test$Desafiliado)##
## No Si
## 858 41prop.table(table(desafiliados_test$Desafiliado))##
## No Si
## 0.95439377 0.04560623COMPARAMOS LOS MODELOS
INDICADORES PARA EL MODELO OVERSAMPLING
Modelo_OverSampling##
## Call: glm(formula = Desafiliado ~ ., family = binomial(link = "logit"),
## data = desafiliados_bal_over)
##
## Coefficients:
## (Intercept) Plan_internacionalyes Minutos_dia
## -5.05856 2.51243 0.01621
## Minutos_internacionales Reclamos Llamadas_internacionales
## 0.03610 0.56366 0.02533
##
## Degrees of Freedom: 6869 Total (i.e. Null); 6864 Residual
## Null Deviance: 9524
## Residual Deviance: 7274 AIC: 7286# Predicción de probabilidades sobre el test
desafiliados_nbal_pred <- predict(Modelo_OverSampling, newdata = desafiliados_test, type = "response")
head(desafiliados_nbal_pred)## 3 4 6 7 8 15
## 0.2265842 0.6828432 0.4500983 0.4202683 0.1606865 0.1294304# Nivel de la desafiliados en test
desafiliados_nbal_pred_clase <- factor(ifelse(desafiliados_nbal_pred > 0.5, 1, 0))
levels(desafiliados_nbal_pred_clase) <- c("No","Si")
# Cambiar los niveles pues están en inglés
levels(desafiliados_test$Desafiliado) <- c("No","Si")
# Evaluación del modelo sin balancear
# Matriz de confusión en base al test
table(Predicho = desafiliados_nbal_pred_clase, Real = desafiliados_test$Desafiliado)## Real
## Predicho No Si
## No 648 10
## Si 210 31# Matriz Confusión sobre el test
# table(desafiliados_test$Desafiliado, desafiliados_nbal_pred > 0.5)
library(caret)
MatrizConfusionOVER <-confusionMatrix(desafiliados_nbal_pred_clase, desafiliados_test$Desafiliado, positive = "Si", mode="everything")
# Accuracy
confusionMatrix(desafiliados_nbal_pred_clase, desafiliados_test$Desafiliado, positive = "Si")$overall[1]## Accuracy
## 0.7552836# Error de clasificación
library(Metrics)
ce(actual = desafiliados_test$Desafiliado, predicted = desafiliados_nbal_pred_clase)## [1] 0.2447164# AUC
library(Metrics)
auc(actual = ifelse(desafiliados_test$Desafiliado == "Si", 1, 0),
predicted = desafiliados_nbal_pred)## [1] 0.8225311# Se cambia a numérico porque solo acepta este tipo de dato
# Curva ROC
library(ROCR)
ROCRpred <- prediction(desafiliados_nbal_pred, desafiliados_test$Desafiliado)
# Primer argumento: Predicciones con el modelo
# Segundo argumento: Valores reales de los datos
ROCRperf <- performance(ROCRpred, "tpr", "fpr")
# EjeX: fpr (False Positive Rate)
# EjeY: tpr (True Positive Rate)
# Gráfico de la curva ROC
plot(ROCRperf)
plot(ROCRperf, colorize = TRUE)
plot(ROCRperf, colorize = TRUE, print.cutoffs.at = seq(0, 1, by = 0.1), text.adj = c(-0.2,1.7))
INDICADORES PARA EL MODELO SMOTE
# Predicción de probabilidades sobre el test
desafiliados_nbal_pred <- predict(Modelo_Smote, newdata = desafiliados_test, type = "response")
head(desafiliados_nbal_pred)## 3 4 6 7 8 15
## 0.1522612 0.6169432 0.3491765 0.3496970 0.1227247 0.0962045# Nivel de la desafiliados en test
desafiliados_nbal_pred_clase <- factor(ifelse(desafiliados_nbal_pred > 0.5, 1, 0))
levels(desafiliados_nbal_pred_clase) <- c("No","Si")
# Cambiar los niveles pues están en inglés
levels(desafiliados_test$Desafiliado) <- c("No","Si")
# Evaluación del modelo sin balancear
# Matriz de confusión en base al test
table(Predicho = desafiliados_nbal_pred_clase, Real = desafiliados_test$Desafiliado)## Real
## Predicho No Si
## No 692 14
## Si 166 27# Matriz Confusión sobre el test
# table(desafiliados_test$Desafiliado, desafiliados_nbal_pred > 0.5)
library(caret)
MatrizConfusionSMOTE <- confusionMatrix(desafiliados_nbal_pred_clase, desafiliados_test$Desafiliado, positive = "Si",mode="everything")
# Accuracy
confusionMatrix(desafiliados_nbal_pred_clase, desafiliados_test$Desafiliado, positive = "Si")$overall[1]## Accuracy
## 0.7997775# Error de clasificación
library(Metrics)
ce(actual = desafiliados_test$Desafiliado, predicted = desafiliados_nbal_pred_clase)## [1] 0.2002225# AUC
library(Metrics)
auc(actual = ifelse(desafiliados_test$Desafiliado == "Si", 1, 0),
predicted = desafiliados_nbal_pred)## [1] 0.8170163# Se cambia a numérico porque solo acepta este tipo de dato
# Curva ROC
library(ROCR)
ROCRpred <- prediction(desafiliados_nbal_pred, desafiliados_test$Desafiliado)
# Primer argumento: Predicciones con el modelo
# Segundo argumento: Valores reales de los datos
ROCRperf <- performance(ROCRpred, "tpr", "fpr")
# EjeX: fpr (False Positive Rate)
# EjeY: tpr (True Positive Rate)
# Gráfico de la curva ROC
plot(ROCRperf)
plot(ROCRperf, colorize = TRUE)
plot(ROCRperf, colorize = TRUE, print.cutoffs.at = seq(0, 1, by = 0.1), text.adj = c(-0.2,1.7))
Comparado los modelos se observa que:
el SMOTE presente mejores resultados ya que a nivel de Precisión es el mas óptimo y el F1 Score es mas óptimo
Modelo_SinBalanceo## Confusion Matrix and Statistics
##
## Reference
## Prediction No Si
## No 857 41
## Si 1 0
##
## Accuracy : 0.9533
## 95% CI : (0.9374, 0.9661)
## No Information Rate : 0.9544
## P-Value [Acc > NIR] : 0.6035
##
## Kappa : -0.0022
##
## Mcnemar's Test P-Value : 1.768e-09
##
## Sensitivity : 0.000000
## Specificity : 0.998834
## Pos Pred Value : 0.000000
## Neg Pred Value : 0.954343
## Precision : 0.000000
## Recall : 0.000000
## F1 : NaN
## Prevalence : 0.045606
## Detection Rate : 0.000000
## Detection Prevalence : 0.001112
## Balanced Accuracy : 0.499417
##
## 'Positive' Class : Si
## MatrizConfusionOVER## Confusion Matrix and Statistics
##
## Reference
## Prediction No Si
## No 648 10
## Si 210 31
##
## Accuracy : 0.7553
## 95% CI : (0.7258, 0.7831)
## No Information Rate : 0.9544
## P-Value [Acc > NIR] : 1
##
## Kappa : 0.1539
##
## Mcnemar's Test P-Value : <2e-16
##
## Sensitivity : 0.75610
## Specificity : 0.75524
## Pos Pred Value : 0.12863
## Neg Pred Value : 0.98480
## Precision : 0.12863
## Recall : 0.75610
## F1 : 0.21986
## Prevalence : 0.04561
## Detection Rate : 0.03448
## Detection Prevalence : 0.26808
## Balanced Accuracy : 0.75567
##
## 'Positive' Class : Si
## MatrizConfusionSMOTE## Confusion Matrix and Statistics
##
## Reference
## Prediction No Si
## No 692 14
## Si 166 27
##
## Accuracy : 0.7998
## 95% CI : (0.7721, 0.8255)
## No Information Rate : 0.9544
## P-Value [Acc > NIR] : 1
##
## Kappa : 0.1682
##
## Mcnemar's Test P-Value : <2e-16
##
## Sensitivity : 0.65854
## Specificity : 0.80653
## Pos Pred Value : 0.13990
## Neg Pred Value : 0.98017
## Precision : 0.13990
## Recall : 0.65854
## F1 : 0.23077
## Prevalence : 0.04561
## Detection Rate : 0.03003
## Detection Prevalence : 0.21468
## Balanced Accuracy : 0.73253
##
## 'Positive' Class : Si
##