Balanceo de Datos
Desafiliado
Ariadna Perez Nuñez
2/4/2021
1.-Cargar la base de datos y mostrar la estructura de las variables.
setwd("C:/Users/Dell/Desktop/dataanalisis/4_Balanceo")
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 ...library(funModeling)
df_status(Desafiliados)## variable q_zeros p_zeros q_na p_na q_inf p_inf type unique
## 1 Plan_internacional 0 0.00 0 0 0 0 factor 2
## 2 Minutos_dia 1 0.02 0 0 0 0 numeric 1831
## 3 Minutos_internacionales 24 0.53 0 0 0 0 numeric 166
## 4 Reclamos 935 20.78 0 0 0 0 integer 9
## 5 Llamadas_internacionales 24 0.53 0 0 0 0 integer 20
## 6 Desafiliado 0 0.00 0 0 0 0 factor 2library(dplyr)
tibble(Desafiliados)## # A tibble: 4,500 x 6
## Plan_internacion~ Minutos_dia Minutos_internacio~ Reclamos Llamadas_internac~
## <fct> <dbl> <dbl> <int> <int>
## 1 no 203. 9 3 3
## 2 no 264. 7.5 2 4
## 3 no 102. 9.4 3 6
## 4 no 229. 7.4 3 6
## 5 no 125 10.2 2 7
## 6 no 188. 15.2 2 5
## 7 no 222. 13.2 1 4
## 8 no 154. 8.3 1 2
## 9 no 156. 10.8 3 4
## 10 no 122. 11.3 2 5
## # ... with 4,490 more rows, and 1 more variable: Desafiliado <fct>2.-Determinar si existe algún desbalance en los datos.
a.-¿Cuál es la proporción?
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 noY su proporción por clase
table(Desafiliados$Desafiliado)##
## no yes
## 4293 207prop.table(table(Desafiliados$Desafiliado))##
## no yes
## 0.954 0.046Conclusión: La data solo contiene aprox. 4.6% de casos positivos (clientes Desafiliados)
3.-Utilizar un modelo de regresión logística para predecir la pérdida del cliente en base a su consumo telefónico. Realizar el modelo predictivo con la información tal cual se encuentra, sin balancear los datos. Para esto, además, deberá separar la base de datos en una muestra para el entrenamiento y otra para la evaluación (es su criterio elegir la proporción adecuada).
Procesamiento de los datos. Cambiar la variable default a tipo factor donde Yes=2 y No=1
library(caret)
split <- 0.8 # Porcentaje de datos al conjunto de entrenamiento
trainIndex <- createDataPartition(Desafiliados$Desafiliado, p = split, list = FALSE)
Desa_train <- Desafiliados[trainIndex,]
Desa_test <- Desafiliados[-trainIndex,]Analizamos utilizando un modelo Logístico
Desa_nbal <- glm(Desafiliado ~., data = Desa_train, family = binomial(link = "logit"))
summary(Desa_nbal)##
## Call:
## glm(formula = Desafiliado ~ ., family = binomial(link = "logit"),
## data = Desa_train)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.3492 -0.3097 -0.2180 -0.1557 3.1882
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -7.570105 0.562417 -13.460 < 2e-16 ***
## Plan_internacionalyes 1.753905 0.200861 8.732 < 2e-16 ***
## Minutos_dia 0.014741 0.001784 8.264 < 2e-16 ***
## Minutos_internacionales 0.071802 0.031334 2.292 0.0219 *
## Reclamos 0.418774 0.057614 7.269 3.63e-13 ***
## Llamadas_internacionales -0.018566 0.035463 -0.524 0.6006
## ---
## 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: 1156.4 on 3595 degrees of freedom
## AIC: 1168.4
##
## Number of Fisher Scoring iterations: 6Predicción de probabilidades sobre el test
Desa_nbal_pred <- predict(Desa_nbal, newdata = Desa_test, type = "response")
head(Desa_nbal_pred)## 5 17 21 23 24 32
## 0.013553065 0.010819072 0.003954904 0.085449459 0.013810394 0.043661315Nivel de Desafiliación en test
Desa_nbal_pred_clase <- factor(ifelse(Desa_nbal_pred > 0.5, 1, 0))
levels(Desa_nbal_pred_clase) <- c("No","Si")Cambiamos los niveles a español:
levels(Desa_test$Desafiliado) <- c("No","Si")Evaluación del modelo sin balancear Matriz de confusión En base al dataset test
table(Predicho = Desa_nbal_pred_clase, Real = Desa_test$Desafiliado)## Real
## Predicho No Si
## No 858 40
## Si 0 1Matriz Confusión sobre el test
table(Desa_test$Desafiliado, Desa_nbal_pred > 0.5)##
## FALSE TRUE
## No 858 0
## Si 40 1debemos definir cual va a ser los positivos en este caso será el “si”
confusionMatrix(Desa_nbal_pred_clase, Desa_test$Desafiliado, positive = "Si",mode="everything")## Confusion Matrix and Statistics
##
## Reference
## Prediction No Si
## No 858 40
## Si 0 1
##
## Accuracy : 0.9555
## 95% CI : (0.9399, 0.968)
## No Information Rate : 0.9544
## P-Value [Acc > NIR] : 0.4778
##
## Kappa : 0.0455
##
## Mcnemar's Test P-Value : 6.984e-10
##
## Sensitivity : 0.024390
## Specificity : 1.000000
## Pos Pred Value : 1.000000
## Neg Pred Value : 0.955457
## Precision : 1.000000
## Recall : 0.024390
## F1 : 0.047619
## Prevalence : 0.045606
## Detection Rate : 0.001112
## Detection Prevalence : 0.001112
## Balanced Accuracy : 0.512195
##
## 'Positive' Class : Si
## Accuracy
confusionMatrix(Desa_nbal_pred_clase, Desa_test$Desafiliado, positive = "Si")$overall[1]## Accuracy
## 0.9555061Error de clasificación
library(Metrics)
#lo que esta mal clasificado
ce(actual = Desa_test$Desafiliado, predicted = Desa_nbal_pred_clase)## [1] 0.04449388AUC
library(Metrics)
auc(actual = ifelse(Desa_test$Desafiliado == "Si", 1, 0),
predicted = Desa_nbal_pred)## [1] 0.8879129Curva ROC
library(ROCR)
ROCRpred <- prediction(Desa_nbal_pred, Desa_test$Desafiliado)ROCRperf <- performance(ROCRpred, "tpr", "fpr")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))
4.-Realizar un modelo de regresión logística luego de balancear los datos mediante la técnica de oversampling.
library(ROSE)
prop.table(table(Desa_train$Desafiliado))##
## no yes
## 0.95390169 0.04609831Desa_bal_over <- ovun.sample(Desafiliado ~ .,
data = Desa_train,
method = "over",
N = table(Desa_train$Desafiliado)[1]*2)$data
table(Desa_bal_over$Desafiliado)##
## no yes
## 3435 3435head(Desa_bal_over)## Plan_internacional Minutos_dia Minutos_internacionales Reclamos
## 1 no 202.9 9.0 3
## 2 no 101.7 9.4 3
## 3 no 229.2 7.4 3
## 4 no 188.5 15.2 2
## 5 no 221.8 13.2 1
## 6 no 153.7 8.3 1
## Llamadas_internacionales Desafiliado
## 1 3 no
## 2 6 no
## 3 6 no
## 4 5 no
## 5 4 no
## 6 2 noDesa_bal_over <- glm(Desafiliado ~., data = Desa_train, family = binomial(link = "logit"))
summary(Desa_bal_over)##
## Call:
## glm(formula = Desafiliado ~ ., family = binomial(link = "logit"),
## data = Desa_train)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.3492 -0.3097 -0.2180 -0.1557 3.1882
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -7.570105 0.562417 -13.460 < 2e-16 ***
## Plan_internacionalyes 1.753905 0.200861 8.732 < 2e-16 ***
## Minutos_dia 0.014741 0.001784 8.264 < 2e-16 ***
## Minutos_internacionales 0.071802 0.031334 2.292 0.0219 *
## Reclamos 0.418774 0.057614 7.269 3.63e-13 ***
## Llamadas_internacionales -0.018566 0.035463 -0.524 0.6006
## ---
## 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: 1156.4 on 3595 degrees of freedom
## AIC: 1168.4
##
## Number of Fisher Scoring iterations: 6Predicción de probabilidades sobre el test
Desa_bal_pred <- predict(Desa_bal_over, newdata = Desa_test, type = "response")
head(Desa_bal_pred)## 5 17 21 23 24 32
## 0.013553065 0.010819072 0.003954904 0.085449459 0.013810394 0.043661315Nivel de Desafiliados en test
Desa_bal_pred_clase <- factor(ifelse(Desa_bal_pred > 0.5, 1, 0))
levels(Desa_bal_pred_clase) <- c("No","Si")Cambiamos los niveles a español:
levels(Desa_test$Desafiliado) <- c("No","Si")En base al dataset test
table(Predicho = Desa_bal_pred_clase, Real = Desa_test$Desafiliado)## Real
## Predicho No Si
## No 858 40
## Si 0 1Matriz Confusión sobre el test
table(Desa_test$Desafiliado, Desa_bal_pred > 0.5)##
## FALSE TRUE
## No 858 0
## Si 40 1library(caret)
confusionMatrix(Desa_bal_pred_clase, Desa_test$Desafiliado, positive = "Si")## Confusion Matrix and Statistics
##
## Reference
## Prediction No Si
## No 858 40
## Si 0 1
##
## Accuracy : 0.9555
## 95% CI : (0.9399, 0.968)
## No Information Rate : 0.9544
## P-Value [Acc > NIR] : 0.4778
##
## Kappa : 0.0455
##
## Mcnemar's Test P-Value : 6.984e-10
##
## Sensitivity : 0.024390
## Specificity : 1.000000
## Pos Pred Value : 1.000000
## Neg Pred Value : 0.955457
## Prevalence : 0.045606
## Detection Rate : 0.001112
## Detection Prevalence : 0.001112
## Balanced Accuracy : 0.512195
##
## 'Positive' Class : Si
## confusionMatrix(Desa_bal_pred_clase, Desa_test$Desafiliado, positive = "Si")$overall[1]## Accuracy
## 0.9555061Error de clasificación
library(Metrics)
ce(actual = Desa_test$Desafiliado, predicted = Desa_bal_pred_clase)## [1] 0.044493885.-Realizar un modelo de regresión logística luego de balancear los datos mediante la metodología SMOTE.
Balanceo.
library(performanceEstimation)
set.seed(2019) # Para tener resultados reproducibles
Desa_bal_smote <- performanceEstimation::smote(Desafiliado ~ .,
data = Desa_train,
perc.over = 2,
k = 5,
perc.under = 2)
table(Desa_bal_smote$Desafiliado)##
## no yes
## 664 498prop.table(table(Desa_bal_smote$Desafiliado))##
## no yes
## 0.5714286 0.4285714Utilizamos la función SMOTE con el parámetro randomForest para ajustar directamente el modelo.
Creamos un SMOTE test dataset en nuestro conjunto test.
library(randomForest)
modelo <- randomForest::randomForest(Desafiliado~., Desa_bal_smote)
smote_test <- smote(Desafiliado ~ ., data = Desa_test, perc.over = 2,
k = 5, perc.under = 2)
prop.table(table(smote_test$Desafiliado))##
## No Si
## 0.5714286 0.4285714Insertar aleatoriedad indices aleatorios
split <- sample(1:nrow(smote_test), nrow(smote_test))dataset aleatoria
smote_test <- smote_test[split,]Predecimos la clase de la variable luego de realizar un randomForest
p <- predict(modelo, smote_test)
levels(p) <- c("No", "Si")
caret::confusionMatrix(smote_test$Desafiliado, p, positive = "Si",
mode="everything")## Confusion Matrix and Statistics
##
## Reference
## Prediction No Si
## No 150 14
## Si 10 113
##
## Accuracy : 0.9164
## 95% CI : (0.8781, 0.9457)
## No Information Rate : 0.5575
## P-Value [Acc > NIR] : <2e-16
##
## Kappa : 0.83
##
## Mcnemar's Test P-Value : 0.5403
##
## Sensitivity : 0.8898
## Specificity : 0.9375
## Pos Pred Value : 0.9187
## Neg Pred Value : 0.9146
## Precision : 0.9187
## Recall : 0.8898
## F1 : 0.9040
## Prevalence : 0.4425
## Detection Rate : 0.3937
## Detection Prevalence : 0.4286
## Balanced Accuracy : 0.9136
##
## 'Positive' Class : Si
## confusionMatrix(smote_test$Desafiliado, p, positive = "Si",
mode="everything")$overall[1]## Accuracy
## 0.91637636.-Comparar los resultados obtenidos en los ítems 3, 4 y 5. Considerar analizar los indicadores resultantes de la matriz de confusión de cada modelo ejecutado. ¿Existe variación en la exactitud (Accuracy)?
Podemos pobservar que la exactitud en el modelo no balancaedo es de: Accuracy=0.8254022, mientras que en el modelo balanceado por oversampling es: Accuracy=0.9544 y en el modelo en el que aplicamos smote es de: Accuracy= 0.8397213
7.-Según lo analizado en el ítem anterior
a.-¿Cuál sería la mejor técnica a emplear en esta situación y por qué?
la mejor tecnica seria la del oversampling por tener una mejor presición (Accuracy=0.9544)