Balanceo de Datos Ejercicio
Oscar Edmit Quispe Poccohuanca
2/4/2021
1. Cargar la base de datos y mostrar la estructura de las variables.
desafiliados <- read.csv('DatosDesafiliado.csv', header = T, stringsAsFactors =TRUE)
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 nosummary(desafiliados)## Plan_internacional Minutos_dia Minutos_internacionales Reclamos
## no :4170 Min. : 0.0 Min. : 0.0 Min. :0.000
## yes: 330 1st Qu.:143.4 1st Qu.: 8.5 1st Qu.:1.000
## Median :179.1 Median :10.3 Median :1.000
## Mean :177.5 Mean :10.2 Mean :1.491
## 3rd Qu.:212.8 3rd Qu.:12.0 3rd Qu.:2.000
## Max. :337.4 Max. :19.7 Max. :8.000
## Llamadas_internacionales Desafiliado
## Min. : 0.000 no :4293
## 1st Qu.: 3.000 yes: 207
## Median : 4.000
## Mean : 4.479
## 3rd Qu.: 6.000
## Max. :19.000str(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 ...skimr::skim(desafiliados)| Name | desafiliados |
| Number of rows | 4500 |
| Number of columns | 6 |
| _______________________ | |
| Column type frequency: | |
| factor | 2 |
| numeric | 4 |
| ________________________ | |
| Group variables | None |
Variable type: factor
| skim_variable | n_missing | complete_rate | ordered | n_unique | top_counts |
|---|---|---|---|---|---|
| Plan_internacional | 0 | 1 | FALSE | 2 | no: 4170, yes: 330 |
| Desafiliado | 0 | 1 | FALSE | 2 | no: 4293, yes: 207 |
Variable type: numeric
| skim_variable | n_missing | complete_rate | mean | sd | p0 | p25 | p50 | p75 | p100 | hist |
|---|---|---|---|---|---|---|---|---|---|---|
| Minutos_dia | 0 | 1 | 177.55 | 51.24 | 0 | 143.4 | 179.1 | 212.83 | 337.4 | ▁▃▇▅▁ |
| Minutos_internacionales | 0 | 1 | 10.20 | 2.75 | 0 | 8.5 | 10.3 | 12.00 | 19.7 | ▁▂▇▃▁ |
| Reclamos | 0 | 1 | 1.49 | 1.20 | 0 | 1.0 | 1.0 | 2.00 | 8.0 | ▇▅▁▁▁ |
| Llamadas_internacionales | 0 | 1 | 4.48 | 2.45 | 0 | 3.0 | 4.0 | 6.00 | 19.0 | ▆▇▂▁▁ |
2. Determinar si existe algún desbalance en los datos. a. ¿Cuál es la proporción?
table(desafiliados$Desafiliado)##
## no yes
## 4293 207prop.table(table(desafiliados$Desafiliado))##
## no yes
## 0.954 0.046Vemos que si existe un desbalanceo de Datos respecto a la Variable Desafiliado.
barplot(prop.table(table(desafiliados$Desafiliado)),
col = rainbow(2),
ylim = c(0, 1),
main = "Distribución de Clases")
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).
library(caret)##
## Attaching package: 'caret'## The following object is masked from 'package:survival':
##
## cluster## The following object is masked from 'package:purrr':
##
## liftsplit <- 0.8 # Porcentaje de datos al conjunto de entrenamiento
trainIndex <- createDataPartition(desafiliados$Desafiliado, p = split, list = FALSE)
desafiliado_train <- desafiliados[trainIndex,]
desafiliado_test <- desafiliados[-trainIndex,]
desafiliado_nbal <- glm(Desafiliado ~., data = desafiliado_train, family = binomial(link = "logit"))
summary(desafiliado_nbal)##
## Call:
## glm(formula = Desafiliado ~ ., family = binomial(link = "logit"),
## data = desafiliado_train)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.4007 -0.3096 -0.2143 -0.1505 3.2179
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -7.676234 0.563425 -13.624 < 2e-16 ***
## Plan_internacionalyes 1.758503 0.203272 8.651 < 2e-16 ***
## Minutos_dia 0.016239 0.001781 9.115 < 2e-16 ***
## Minutos_internacionales 0.058480 0.031383 1.863 0.0624 .
## Reclamos 0.400764 0.058559 6.844 7.71e-12 ***
## Llamadas_internacionales -0.024673 0.035725 -0.691 0.4898
## ---
## 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: 1146.1 on 3595 degrees of freedom
## AIC: 1158.1
##
## Number of Fisher Scoring iterations: 6desafiliado_nbal_pred <- predict(desafiliado_nbal, newdata = desafiliado_test, type = "response")
head(desafiliado_nbal_pred)## 7 15 16 19 21 22
## 0.047407121 0.009983131 0.012657476 0.015822049 0.003158286 0.026723812desafiliado_nbal_pred_clase <- factor(ifelse(desafiliado_nbal_pred > 0.5, 1, 0))
levels(desafiliado_nbal_pred_clase) <- c("No","Si")
levels(desafiliado_test$Desafiliado) <- c("No","Si")
table(Predicho = desafiliado_nbal_pred_clase, Real = desafiliado_test$Desafiliado)## Real
## Predicho No Si
## No 858 39
## Si 0 2table(desafiliado_test$Desafiliado, desafiliado_nbal_pred > 0.5)##
## FALSE TRUE
## No 858 0
## Si 39 2library(caret)
confusionMatrix(desafiliado_nbal_pred_clase, desafiliado_test$Desafiliado, positive = "Si", mode = "everything")## Confusion Matrix and Statistics
##
## Reference
## Prediction No Si
## No 858 39
## Si 0 2
##
## Accuracy : 0.9566
## 95% CI : (0.9412, 0.969)
## No Information Rate : 0.9544
## P-Value [Acc > NIR] : 0.4142
##
## Kappa : 0.0892
##
## Mcnemar's Test P-Value : 1.166e-09
##
## Sensitivity : 0.048780
## Specificity : 1.000000
## Pos Pred Value : 1.000000
## Neg Pred Value : 0.956522
## Precision : 1.000000
## Recall : 0.048780
## F1 : 0.093023
## Prevalence : 0.045606
## Detection Rate : 0.002225
## Detection Prevalence : 0.002225
## Balanced Accuracy : 0.524390
##
## 'Positive' Class : Si
## 4. Realizar un modelo de regresión logística luego de balancear los datos mediante la técnica de oversampling.
library(ROSE)## Loaded ROSE 0.0-3prop.table(table(desafiliado_train$Desafiliado))##
## no yes
## 0.95390169 0.04609831table(desafiliado_train$Desafiliado)[1]## no
## 3435desafiliado_bal_over <- ovun.sample(
Desafiliado ~ .,
data = desafiliado_train,
method = "over",
N = table(desafiliado_train$Desafiliado)[1]*2)$data
table(desafiliado_bal_over$Desafiliado)##
## no yes
## 3435 3435head(desafiliado_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 125.0 10.2 2
## 5 no 188.5 15.2 2
## 6 no 153.7 8.3 1
## Llamadas_internacionales Desafiliado
## 1 3 no
## 2 6 no
## 3 6 no
## 4 7 no
## 5 5 no
## 6 2 nomodelo_bal_over <- glm(Desafiliado ~., data = desafiliado_bal_over, family = binomial(link = "logit"))
summary(modelo_bal_over)##
## Call:
## glm(formula = Desafiliado ~ ., family = binomial(link = "logit"),
## data = desafiliado_bal_over)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.9772 -0.8463 -0.0379 0.8890 2.3036
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -5.0857992 0.1860125 -27.341 < 2e-16 ***
## Plan_internacionalyes 2.3314366 0.0937566 24.867 < 2e-16 ***
## Minutos_dia 0.0165472 0.0005371 30.808 < 2e-16 ***
## Minutos_internacionales 0.0518308 0.0103998 4.984 6.23e-07 ***
## Reclamos 0.5706400 0.0214846 26.560 < 2e-16 ***
## Llamadas_internacionales -0.0138158 0.0113677 -1.215 0.224
## ---
## 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: 7368.0 on 6864 degrees of freedom
## AIC: 7380
##
## Number of Fisher Scoring iterations: 4desafiliado_bal_over_pred <- predict(modelo_bal_over, newdata = desafiliado_test, type = "response")
head(desafiliado_bal_over_pred)## 7 15 16 19 21 22
## 0.44618923 0.13854562 0.19581918 0.21301578 0.04737652 0.34870640desafiliado_bal_over_pred_clase <- factor(ifelse(desafiliado_bal_over_pred > 0.5, 1, 0))
levels(desafiliado_bal_over_pred_clase) <- c("No","Si")
levels(desafiliado_test$Desafiliado) <- c("No","Si")
table(Predicho = desafiliado_bal_over_pred_clase, Real = desafiliado_test$Desafiliado)## Real
## Predicho No Si
## No 653 9
## Si 205 32table(desafiliado_test$Desafiliado, desafiliado_bal_over_pred > 0.5)##
## FALSE TRUE
## No 653 205
## Si 9 32library(caret)
confusionMatrix(desafiliado_bal_over_pred_clase, desafiliado_test$Desafiliado, positive = "Si", mode = "everything")## Confusion Matrix and Statistics
##
## Reference
## Prediction No Si
## No 653 9
## Si 205 32
##
## Accuracy : 0.762
## 95% CI : (0.7327, 0.7895)
## No Information Rate : 0.9544
## P-Value [Acc > NIR] : 1
##
## Kappa : 0.1653
##
## Mcnemar's Test P-Value : <2e-16
##
## Sensitivity : 0.78049
## Specificity : 0.76107
## Pos Pred Value : 0.13502
## Neg Pred Value : 0.98640
## Precision : 0.13502
## Recall : 0.78049
## F1 : 0.23022
## Prevalence : 0.04561
## Detection Rate : 0.03560
## Detection Prevalence : 0.26363
## Balanced Accuracy : 0.77078
##
## 'Positive' Class : Si
## 5. Realizar un modelo de regresión logística luego de balancear los datos mediante la metodología SMOTE.
set.seed(2021) # <- Para tener resultados reproducibles
desafiliado_bal_smote <- smote(
Desafiliado ~ .,
data = desafiliado_train,
perc.over = 2,
k = 5, # k nearest neighbors
perc.under = 2)
table(desafiliado_bal_smote$Desafiliado)##
## no yes
## 664 498prop.table(table(desafiliado_bal_smote$Desafiliado))##
## no yes
## 0.5714286 0.4285714modelo <- randomForest::randomForest(Desafiliado ~ ., desafiliado_bal_smote)
prop.table(table(desafiliado_test$Desafiliado))##
## No Si
## 0.95439377 0.04560623p <- predict(modelo, desafiliado_test)
levels(p) <- c("No", "Si")
caret::confusionMatrix(desafiliado_test$Desafiliado, p, positive = "Si", mode = "everything")## Confusion Matrix and Statistics
##
## Reference
## Prediction No Si
## No 773 85
## Si 10 31
##
## Accuracy : 0.8943
## 95% CI : (0.8724, 0.9137)
## No Information Rate : 0.871
## P-Value [Acc > NIR] : 0.01866
##
## Kappa : 0.3512
##
## Mcnemar's Test P-Value : 3.144e-14
##
## Sensitivity : 0.26724
## Specificity : 0.98723
## Pos Pred Value : 0.75610
## Neg Pred Value : 0.90093
## Precision : 0.75610
## Recall : 0.26724
## F1 : 0.39490
## Prevalence : 0.12903
## Detection Rate : 0.03448
## Detection Prevalence : 0.04561
## Balanced Accuracy : 0.62723
##
## 'Positive' Class : Si
## 6. 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)?
p = confusionMatrix(desafiliado_nbal_pred_clase, desafiliado_test$Desafiliado, positive = "Si", mode = "everything")$overall
p## Accuracy Kappa AccuracyLower AccuracyUpper AccuracyNull
## 9.566185e-01 8.915907e-02 9.411706e-01 9.689726e-01 9.543938e-01
## AccuracyPValue McnemarPValue
## 4.142008e-01 1.165860e-09confusionMatrix(desafiliado_nbal_pred_clase, desafiliado_test$Desafiliado, positive = "Si", mode = "everything")$overall[2]## Kappa
## 0.08915907confusionMatrix(desafiliado_nbal_pred_clase, desafiliado_test$Desafiliado, positive = "Si", mode = "everything")$overall[8]## <NA>
## NA- La Exactitud sin balanceo es: 0.9555
- La Exactitud con Oversampling es: 0.7809
- La Exactitud con Smote es: 0.8843
Vemos que hay una diferencia entre estos valores, nos da a entender que sin balanceo tiene la mejor exactitud, le sigue el balanceo con Smote y por ultimo Oversampling, sin embargo aun falta ver la Sensibilidad, la Especificidad y la Precisión.
La Sensibilidad sin balanceo es: 0.000000
La Sensibilidad con Oversampling es: 0.8147
La Sensibilidad con Smote es: 0.29670
La Especificidad sin balanceo es: 0.998834
La Especificidad con Oversampling es: 0.7343
La Especificidad con Smote es: 0.98267
La Precisión sin balanceo es: 0.000000
La Precisión con Oversampling es: 0.7540
La Precisión con Smote es: 0.65854
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é?
8. Finalmente, elaborar un reporte empleando Rmarkdown para comunicar sus resultados y análisis.