EXPLORACIĂN:
# =============================================================================
# TRATAMIENTO DE DATOS NO BALANCEADOS
# =============================================================================
#FUNCIONES DE GRAFICO
#grafica <- function(x1,y1){
# ggplot(x1,aes(x=factor(y1),fill=factor(y1),na.rm=TRUE))+geom_bar(position="dodge")+
# geom_text(aes(label=..count..),stat='count',position=position_dodge(1))
#}
# DATOS -------------------------------------------------------------------
# Cargar la base de datos
desafilado <- read.csv("C:/Users/HUAWEI/Google Drive/UNI data/CICLO 9/PEBIBA/evelyn gutierres/4_Balanceo/DatosDesafiliado.csv", header = T, stringsAsFactors =TRUE)
# Estructura de los datos
str(desafilado)
## '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 ...
# Plan Internacio
table(desafilado$Plan_internacional)
##
## no yes
## 4170 330
# Muinutos Dia
hist(desafilado$Minutos_dia)
# Minutos internacionales
hist(desafilado$Minutos_internacionales)
# Reclamos
hist(desafilado$Reclamos)
# Llamadas Internacionacionales
hist(desafilado$Llamadas_internacionales)
# Desafilado
grafico(desafilado,desafilado$Desafiliado)
# Visualizamos algunos datos
head(desafilado)
## 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
# 2
# ProporciĂłn por clase
table(desafilado$Desafiliado)
##
## no yes
## 4293 207
prop.table(table(desafilado$Desafiliado))
##
## no yes
## 0.954 0.046
# La data solo contiene aprox. 4.6% de casos positivos (clientes en default)
# ANĂLISIS EXPLORATORIO
barplot(prop.table(table(desafilado$Desafiliado)),
col = rainbow(2),
ylim = c(0, 1),
main = "DistribuciĂłn de Clases")
MODELAMIENTO
PREGUNTA 3
# 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.
split <- 0.8 # Porcentaje de datos al conjunto de entrenamiento
trainIndex <- createDataPartition(desafilado$Desafiliado, p = split, list = FALSE)
desafilado_train <- desafilado[trainIndex,]
desafilado_test <- desafilado[-trainIndex,]
PREGUNTA 4 - ENTRANAMIENTO DEL MODELO
desafilado_nbal <- glm(Desafiliado ~., data = desafilado_train, family = binomial(link = "logit"))
summary(desafilado_nbal)
##
## Call:
## glm(formula = Desafiliado ~ ., family = binomial(link = "logit"),
## data = desafilado_train)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.4247 -0.3049 -0.2120 -0.1496 3.2244
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -7.602223 0.568137 -13.381 < 2e-16 ***
## Plan_internacionalyes 1.850721 0.199442 9.279 < 2e-16 ***
## Minutos_dia 0.016100 0.001794 8.974 < 2e-16 ***
## Minutos_internacionales 0.049114 0.031330 1.568 0.117
## Reclamos 0.394161 0.058567 6.730 1.69e-11 ***
## Llamadas_internacionales -0.016676 0.035886 -0.465 0.642
## ---
## 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: 1136.8 on 3595 degrees of freedom
## AIC: 1148.8
##
## Number of Fisher Scoring iterations: 6
# PredicciĂłn de probabilidades sobre el test
desafilado_nbal_pred <- predict(desafilado_nbal, newdata = desafilado_test, type = "response")
head(desafilado_nbal_pred)
## 1 12 13 20 25 28
## 0.059470310 0.009069126 0.091832195 0.022798393 0.032647446 0.043326849
# Nivel de la desafilado en test
desafilado_nbal_pred_clase <- factor(ifelse(desafilado_nbal_pred > 0.5, 1, 0))
levels(desafilado_nbal_pred_clase) <- c("No","Si")
# Cambiar los niveles pues estån en inglés
levels(desafilado_test$Desafiliado) <- c("No","Si")
# EvaluaciĂłn del modelo sin balancear
# Matriz de confusiĂłn en base al test
table(Predicho = desafilado_nbal_pred_clase, Real = desafilado_test$Desafiliado)
## Real
## Predicho No Si
## No 858 41
## Si 0 0
# Matriz ConfusiĂłn sobre el test
# table(desafilado_test$Desafiliado, desafilado_nbal_pred > 0.5)
confusionMatrix(desafilado_nbal_pred_clase, desafilado_test$Desafiliado, positive = "Si",
mode = "everything")
## Confusion Matrix and Statistics
##
## Reference
## Prediction No Si
## No 858 41
## Si 0 0
##
## Accuracy : 0.9544
## 95% CI : (0.9386, 0.9671)
## No Information Rate : 0.9544
## P-Value [Acc > NIR] : 0.5414
##
## Kappa : 0
##
## Mcnemar's Test P-Value : 4.185e-10
##
## Sensitivity : 0.00000
## Specificity : 1.00000
## Pos Pred Value : NaN
## Neg Pred Value : 0.95439
## Precision : NA
## Recall : 0.00000
## F1 : NA
## Prevalence : 0.04561
## Detection Rate : 0.00000
## Detection Prevalence : 0.00000
## Balanced Accuracy : 0.50000
##
## 'Positive' Class : Si
##
# Accuracy
confusionMatrix(desafilado_nbal_pred_clase, desafilado_test$Desafiliado, positive = "Si")$overall[1]
## Accuracy
## 0.9543938
# Error de clasificaciĂłn
ce(actual = desafilado_test$Desafiliado, predicted = desafilado_nbal_pred_clase)
## [1] 0.04560623
# AUC
auc(actual = ifelse(desafilado_test$Desafiliado == "Si", 1, 0),
predicted = desafilado_nbal_pred)
## [1] 0.831116
# Se cambia a numérico porque solo acepta este tipo de dato
# Curva ROC
ROCRpred <- prediction(desafilado_nbal_pred, desafilado_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))
BALANCEO
# 1. OVERSAMPLING ---------------------------------------------------------
prop.table(table(desafilado_train$Desafiliado))
##
## no yes
## 0.95390169 0.04609831
# Cantidad de observaciones en desafilado_train que son Desafiliado = no
table(desafilado_train$Desafiliado)[1]
## no
## 3435
desafilado_bal_over <- ovun.sample(Desafiliado ~ ., data = desafilado_train, method = "over",
N = table(desafilado_train$Desafiliado)[1]*2)$data
table(desafilado_bal_over$Desafiliado)
##
## no yes
## 3435 3435
head(desafilado_bal_over)
## Plan_internacional Minutos_dia Minutos_internacionales Reclamos
## 1 no 101.7 9.4 3
## 2 no 229.2 7.4 3
## 3 no 125.0 10.2 2
## 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 6 no
## 2 6 no
## 3 7 no
## 4 5 no
## 5 4 no
## 6 2 no
# 2. UNDERSAMPLING --------------------------------------------------------
# Cantidad de observaciones en desafilado_train que son Desafiliado = yes
table(desafilado_train$Desafiliado)[2]
## yes
## 166
desafilado_bal_under <- ovun.sample(Desafiliado ~ ., data = desafilado_train, method = "under", N = table(desafilado_train$Desafiliado)[2]*2)$data
table(desafilado_bal_under$Desafiliado)
##
## no yes
## 166 166
# 3. AMBOS UNDERSAMPLING Y OVERSAMPLING -----------------------------------
# Cantidad de observaciones en el conjunto de entrenamiento
dim(desafilado_train)[1]
## [1] 3601
desafilado_bal_ambos <- ovun.sample(Desafiliado ~ ., data = desafilado_train,
method = "both",
p= 0.5,
N = dim(desafilado_train)[1],
seed = 1)$data
# p es la prob. de la clase positiva en la nueva muestra generada
table(desafilado_bal_ambos$Desafiliado)
##
## no yes
## 1853 1748
prop.table(table(desafilado_bal_ambos$Desafiliado))
##
## no yes
## 0.5145793 0.4854207
# Verificar clase mayoritaria
desafiladoYes <- desafilado_bal_ambos %>% filter(Desafiliado == 'Yes')
head(desafiladoYes)
## [1] Plan_internacional Minutos_dia Minutos_internacionales
## [4] Reclamos Llamadas_internacionales Desafiliado
## <0 rows> (or 0-length row.names)
# Contar valores Ășnicos por columna
sapply(desafiladoYes, function(x) length(unique(x)))
## Plan_internacional Minutos_dia Minutos_internacionales
## 0 0 0
## Reclamos Llamadas_internacionales Desafiliado
## 0 0 0
desafiladoYes %>% distinct()
## [1] Plan_internacional Minutos_dia Minutos_internacionales
## [4] Reclamos Llamadas_internacionales Desafiliado
## <0 rows> (or 0-length row.names)
# 4. ROSE -----------------------------------------------------------------
desafilado_bal_rose <- ROSE(Desafiliado ~ ., data = desafilado_train, seed = 3)$data
table(desafilado_bal_rose$Desafiliado)
##
## no yes
## 1740 1861
prop.table(table(desafilado_bal_rose$Desafiliado))
##
## no yes
## 0.4831991 0.5168009
# 5. SMOTE ----------------------------------------------------------------
set.seed(2019) # Para tener resultados reproducibles
desafilado_bal_smote <- DMwR::SMOTE(Desafiliado ~ ., data = desafilado_train, perc.over = 200, k = 5, perc.under = 200)
table(desafilado_bal_smote$Desafiliado)
##
## no yes
## 664 498
prop.table(table(desafilado_bal_smote$Desafiliado))
##
## no yes
## 0.5714286 0.4285714
# Modelo directo con datos balanceados (randomForest, )
modelo <- SMOTE(Desafiliado ~ ., data = desafilado_train, perc.over = 200, k = 5, perc.under = 200, learner = "randomForest")
# Creamos un SMOTE test dataset en nuestro conjunto test.
smote_test <- SMOTE(Desafiliado ~ ., data = desafilado_test, perc.over = 200, k = 5, perc.under = 200)
prop.table(table(smote_test$Desafiliado))
##
## No Si
## 0.5714286 0.4285714
# Insertar 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 145 19
## Si 41 82
##
## Accuracy : 0.7909
## 95% CI : (0.7393, 0.8365)
## No Information Rate : 0.6481
## P-Value [Acc > NIR] : 9.427e-08
##
## Kappa : 0.5634
##
## Mcnemar's Test P-Value : 0.006706
##
## Sensitivity : 0.8119
## Specificity : 0.7796
## Pos Pred Value : 0.6667
## Neg Pred Value : 0.8841
## Precision : 0.6667
## Recall : 0.8119
## F1 : 0.7321
## Prevalence : 0.3519
## Detection Rate : 0.2857
## Detection Prevalence : 0.4286
## Balanced Accuracy : 0.7957
##
## 'Positive' Class : Si
##
# randomForest sin balancear los datos con SMOTE
bosque <- randomForest(Desafiliado ~ ., data = desafilado_train)
bosque_pred <- predict(bosque, desafilado_test, type = "response")
levels(bosque_pred) <- c("No", "Si")
confusionMatrix(bosque_pred, desafilado_test$Desafiliado, positive = "Si", mode="everything")
## Confusion Matrix and Statistics
##
## Reference
## Prediction No Si
## No 847 26
## Si 11 15
##
## Accuracy : 0.9588
## 95% CI : (0.9437, 0.9709)
## No Information Rate : 0.9544
## P-Value [Acc > NIR] : 0.29367
##
## Kappa : 0.4275
##
## Mcnemar's Test P-Value : 0.02136
##
## Sensitivity : 0.36585
## Specificity : 0.98718
## Pos Pred Value : 0.57692
## Neg Pred Value : 0.97022
## Precision : 0.57692
## Recall : 0.36585
## F1 : 0.44776
## Prevalence : 0.04561
## Detection Rate : 0.01669
## Detection Prevalence : 0.02892
## Balanced Accuracy : 0.67652
##
## 'Positive' Class : Si
##
# Notar la diferencia en la exactitud de los valores predichos (Accuracy)
Pregunta 7
- La mejor tecnica por sus resultados es el SMOTE con una precision 88% y ademas la sensividad y specificad