Clase 26 - Procesamiento de datos, selección y balance de clases

logo

1. Conjunto de datos

Para esta clase se utilizarán datos correspondiente a los pacientes egresados de todos los hospitales pertenecientes al Servicio de Salud Metropolitano Sur (SSMS) durante el año 2017. Estos datos fueron descargados desde el sitio web del Departamento de Estadísticas e Informaciones en Salud (DEIS). La base de datos en formato csv puede ser descargada de este vínculo.

Los datos contienen atributos como el código del establecimiento, su complejidad, el sexo del paciente egresado, la edad, el servicio de egreso, el diagnóstico, condición de egreso, días de estada y si éste fue intervenido o no.

library("knitr")

#Lectura de datos
datos=read.csv("BD_SSMS_2017.csv",sep=";",header=T,check.names = F)

#Organización de datos

  #Entradas
datos$ESTAB=as.factor(datos$ESTAB)                  # Código específico
datos$SEXO=as.factor(datos$SEXO)                    # Catogórica - 1: H, 2: M, 3: OTRO 9: DESCONOCIDO
datos$EDAD=as.numeric(datos$EDAD)                   # Numérica
datos$SERC_EGR=as.factor(datos$SERC_EGR)            # Catogórica - Código específico
datos$INTERV_Q=as.factor(datos$INTERV_Q)            # Catogórica - 1: NO INT 2: INT
datos$DIAG1=as.factor(datos$DIAG1)                  # Catogórica - Código específico
datos$DIAS_ESTAD=as.numeric(datos$DIAS_ESTAD)       # Numérica
datos$C_ESTAB=as.factor(datos$C_ESTAB)              # Complejidad - Alta, MEdia, Baja, Niños, Pediátrica

  #Clase - salida
datos$COND_EGR=as.factor(datos$COND_EGR)            # Catogórica - 1: Viv@ 2: Fallecid@

knitr::kable(head(datos))

ESTAB	SEXO	EDAD	SERC_EGR	DIAG1	DIAS_ESTAD	COND_EGR	INTERV_Q	C_ESTAB
113150	1	36	402	A010	7	1	2	Establecimiento Mediana Complejidad
113130	2	13	408	A010	7	1	2	Establecimiento Alta Complejidad
113180	1	16	402	A010	13	1	2	Establecimiento Alta Complejidad
113180	2	7	408	A020	7	1	2	Establecimiento Alta Complejidad
113160	1	52	406	A021	7	1	2	Establecimiento Mediana Complejidad
113180	2	2	408	A029	12	1	2	Establecimiento Alta Complejidad

2. Balace de datos

En este ejemplo estudiaremos usando una regresión logística, qué variables se relacionan con el fallecer en un hospital del SSMS. El balance de esta clase es la siguiente.

COND=table(datos$COND_EGR)
COND=round(rbind(COND,COND/sum(COND)),2)
colnames(COND)=c("Vivo/Viva","Fallecido/Fallecida")
rownames(COND)=c("Fa","Fr")
knitr::kable(COND,align = "r")

	Vivo/Viva	Fallecido/Fallecida
Fa	62474.00	2341.00
Fr	0.96	0.04

3. Revisión preliminar de variables

library("ggplot2")
library("plotly")
library("knitr")
library("gridExtra")


# Condiciónd de egreso según edad
grafico1=ggplot(datos, aes(x = EDAD, fill = COND_EGR)) + geom_histogram(aes(fill = COND_EGR), alpha = 0.4)
grafico1 = grafico1 + theme(legend.position="bottom") + scale_fill_discrete("Cond. de egreso",labels=c("Vivo/Viva", "Fallecido/Fallecida"))

grafico2 = ggplot(datos, aes(x = EDAD, fill = COND_EGR)) + geom_density(aes(fill = COND_EGR), alpha = 0.4)
grafico2 = grafico2 + theme(legend.position="bottom") + scale_fill_discrete("Cond. de egreso",labels=c("Vivo/Viva", "Fallecido/Fallecida"))

grid.arrange(grafico1, grafico2, ncol=2)

# Condiciónd de egreso según días de estada
grafico1=ggplot(datos, aes(x = log(DIAS_ESTAD), fill = COND_EGR)) + geom_histogram(aes(fill = COND_EGR), alpha = 0.4)
grafico1 = grafico1 + theme(legend.position="bottom") + scale_fill_discrete("Cond. de egreso",labels=c("Vivo/Viva", "Fallecido/Fallecida"))

grafico2 = ggplot(datos, aes(x = log(DIAS_ESTAD), fill = COND_EGR)) + geom_density(aes(fill = COND_EGR), alpha = 0.4)
grafico2 = grafico2 + theme(legend.position="bottom") + scale_fill_discrete("Cond. de egreso",labels=c("Vivo/Viva", "Fallecido/Fallecida"))

grid.arrange(grafico1, grafico2, ncol=2)

# Condición de egreso según IQ
grafico1=ggplot(datos, aes(x = INTERV_Q, fill = COND_EGR)) + geom_bar(aes(fill = COND_EGR), alpha = 0.4)
grafico1 = grafico1 + theme(legend.position="bottom") + scale_fill_discrete("Cond. de egreso",labels=c("Vivo/Viva", "Fallecido/Fallecida"))

# Condición de egreso según Complejidad del Hospital
grafico2 = ggplot(datos, aes(x = C_ESTAB, fill = COND_EGR)) + geom_bar(aes(fill = COND_EGR), alpha = 0.4)
grafico2 = grafico2 + theme(legend.position="bottom") + scale_fill_discrete("Cond. de egreso",labels=c("Vivo/Viva", "Fallecido/Fallecida"))
grafico2 = grafico2 + theme(axis.text.x = element_text(angle = -10, vjust = 0.5, hjust=0.4))


grid.arrange(grafico1, grafico2, ncol=2)

4. Regresión logística

Si bien no hemos visto aún regresión logística implementaremos un modelo de estas características para estudiar las variables relevantes en los pacientes fallecidos. Primero dividiremos el conjunto en un componente de entrenamiento (70%) y otra de prueba (30%), para luego configurar sobre el primero una valicación cruzada de n-fold.

library("caret")

set.seed(1985)
datos_idx = createDataPartition(datos$INTERV_Q, p = 0.7, list = FALSE)
datos_trn = datos[datos_idx,]
datos_tst = datos[-datos_idx,]

fitControl <- trainControl(## 10-fold CV
  method = "cv",
  number = 10,
  savePredictions = TRUE
)


modelo=train(COND_EGR~SEXO+EDAD+DIAS_ESTAD+ESTAB+INTERV_Q+C_ESTAB,data=datos_trn,method="glm",family=binomial(),trControl=fitControl)
print(modelo)

## Generalized Linear Model 
## 
## 45371 samples
##     6 predictor
##     2 classes: '1', '2' 
## 
## No pre-processing
## Resampling: Cross-Validated (10 fold) 
## Summary of sample sizes: 40833, 40835, 40833, 40834, 40835, 40834, ... 
## Resampling results:
## 
##   Accuracy   Kappa      
##   0.9634789  0.001030003

Los coeficientes de la regresión son los siguientes:

summary(modelo)

## 
## Call:
## NULL
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.3296  -0.2675  -0.1361  -0.0752   3.8575  
## 
## Coefficients: (1 not defined because of singularities)
##                                                Estimate Std. Error z value
## (Intercept)                                   -7.068714   0.128108 -55.178
## SEXO2                                         -0.324808   0.052664  -6.168
## SEXO3                                         -7.101184 882.743435  -0.008
## EDAD                                           0.051143   0.001481  34.532
## DIAS_ESTAD                                     0.008502   0.001281   6.635
## ESTAB113130                                   -0.506956   0.332305  -1.526
## ESTAB113150                                   -0.333961   0.097707  -3.418
## ESTAB113160                                   -0.458344   0.137746  -3.327
## ESTAB113170                                  -38.810118 151.327456  -0.256
## ESTAB113180                                   -0.036073   0.067022  -0.538
## ESTAB113190                                   -0.246125   0.101074  -2.435
## INTERV_Q2                                      1.463927   0.081143  18.041
## `C_ESTABEstablecimiento Mediana Complejidad`         NA         NA      NA
##                                              Pr(>|z|)    
## (Intercept)                                   < 2e-16 ***
## SEXO2                                        6.93e-10 ***
## SEXO3                                        0.993582    
## EDAD                                          < 2e-16 ***
## DIAS_ESTAD                                   3.24e-11 ***
## ESTAB113130                                  0.127116    
## ESTAB113150                                  0.000631 ***
## ESTAB113160                                  0.000876 ***
## ESTAB113170                                  0.797592    
## ESTAB113180                                  0.590422    
## ESTAB113190                                  0.014888 *  
## INTERV_Q2                                     < 2e-16 ***
## `C_ESTABEstablecimiento Mediana Complejidad`       NA    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 14209  on 45370  degrees of freedom
## Residual deviance: 11263  on 45359  degrees of freedom
## AIC: 11287
## 
## Number of Fisher Scoring iterations: 13

Mientras que la importancia de las variables se puede resumir como:

varImp(modelo)

## glm variable importance
## 
##              Overall
## EDAD        100.0000
## INTERV_Q2    52.2343
## DIAS_ESTAD   19.1965
## SEXO2        17.8413
## ESTAB113150   9.8770
## ESTAB113160   9.6148
## ESTAB113190   7.0300
## ESTAB113130   4.3956
## ESTAB113180   1.5357
## ESTAB113170   0.7196
## SEXO3         0.0000

mod_pred = predict(modelo,datos_tst)

## Warning in predict.lm(object, newdata, se.fit, scale = 1, type = if (type == :
## prediction from a rank-deficient fit may be misleading

confusionMatrix(mod_pred,datos_tst$COND_EGR)

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction     1     2
##          1 18758   685
##          2     0     1
##                                           
##                Accuracy : 0.9648          
##                  95% CI : (0.9621, 0.9673)
##     No Information Rate : 0.9647          
##     P-Value [Acc > NIR] : 0.4946          
##                                           
##                   Kappa : 0.0028          
##                                           
##  Mcnemar's Test P-Value : <2e-16          
##                                           
##             Sensitivity : 1.000000        
##             Specificity : 0.001458        
##          Pos Pred Value : 0.964769        
##          Neg Pred Value : 1.000000        
##              Prevalence : 0.964719        
##          Detection Rate : 0.964719        
##    Detection Prevalence : 0.999949        
##       Balanced Accuracy : 0.500729        
##                                           
##        'Positive' Class : 1               
##

Pregunta
¿Qué ocurrió con la predicción? ¿Qué se puede hacer en este caso?

5. Balance de datos

5.1 Over-sampling

library("ROSE")
datos_balanceados = ovun.sample(COND_EGR~., data=datos_trn,
                                p=0.5,seed=1, method="over")$data

#Balance
COND=table(datos_balanceados$COND_EGR)
COND=round(rbind(COND,COND/sum(COND)),2)
colnames(COND)=c("Vivo/Viva","Fallecido/Fallecida")
rownames(COND)=c("Fa","Fr")
knitr::kable(COND,align = "r")

	Vivo/Viva	Fallecido/Fallecida
Fa	43716.0	43773.0
Fr	0.5	0.5

La regresión con los datos balanceados será la siguiente:

modelo=train(COND_EGR~SEXO+EDAD+DIAS_ESTAD+ESTAB+INTERV_Q+C_ESTAB,data=datos_balanceados,method="glm",family=binomial(),trControl=fitControl)
print(modelo)

## Generalized Linear Model 
## 
## 45371 samples
##     6 predictor
##     2 classes: '1', '2' 
## 
## No pre-processing
## Resampling: Cross-Validated (10 fold) 
## Summary of sample sizes: 40835, 40834, 40833, 40834, 40834, 40835, ... 
## Resampling results:
## 
##   Accuracy  Kappa  
##   0.790791  0.58162

summary(modelo)

## 
## Call:
## NULL
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -3.6391  -0.6765   0.0000   0.7407   2.9256  
## 
## Coefficients: (2 not defined because of singularities)
##                                                Estimate Std. Error z value
## (Intercept)                                  -3.622e+00  4.684e-02 -77.329
## SEXO2                                        -4.496e-01  2.420e-02 -18.576
## SEXO3                                                NA         NA      NA
## EDAD                                          4.873e-02  5.718e-04  85.214
## DIAS_ESTAD                                    1.420e-02  7.884e-04  18.016
## ESTAB113130                                  -8.347e-01  9.840e-02  -8.482
## ESTAB113150                                  -6.437e-01  4.357e-02 -14.774
## ESTAB113160                                  -5.181e-01  6.376e-02  -8.126
## ESTAB113170                                  -2.317e+02  1.000e+07   0.000
## ESTAB113180                                  -2.751e-01  3.067e-02  -8.970
## ESTAB113190                                  -5.468e-01  4.346e-02 -12.583
## INTERV_Q2                                     1.576e+00  3.027e-02  52.066
## `C_ESTABEstablecimiento Mediana Complejidad`         NA         NA      NA
##                                              Pr(>|z|)    
## (Intercept)                                   < 2e-16 ***
## SEXO2                                         < 2e-16 ***
## SEXO3                                              NA    
## EDAD                                          < 2e-16 ***
## DIAS_ESTAD                                    < 2e-16 ***
## ESTAB113130                                   < 2e-16 ***
## ESTAB113150                                   < 2e-16 ***
## ESTAB113160                                  4.45e-16 ***
## ESTAB113170                                         1    
## ESTAB113180                                   < 2e-16 ***
## ESTAB113190                                   < 2e-16 ***
## INTERV_Q2                                     < 2e-16 ***
## `C_ESTABEstablecimiento Mediana Complejidad`       NA    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 62898  on 45370  degrees of freedom
## Residual deviance: 42854  on 45360  degrees of freedom
## AIC: 42876
## 
## Number of Fisher Scoring iterations: 8

varImp(modelo)

## glm variable importance
## 
##             Overall
## EDAD        100.000
## INTERV_Q2    61.100
## SEXO2        21.800
## DIAS_ESTAD   21.142
## ESTAB113150  17.337
## ESTAB113190  14.766
## ESTAB113180  10.527
## ESTAB113130   9.954
## ESTAB113160   9.536
## ESTAB113170   0.000

mod_pred = predict(modelo,datos_tst)

confusionMatrix(mod_pred,datos_tst$COND_EGR)

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction     1     2
##          1 13966   106
##          2  4792   580
##                                           
##                Accuracy : 0.7481          
##                  95% CI : (0.7419, 0.7542)
##     No Information Rate : 0.9647          
##     P-Value [Acc > NIR] : 1               
##                                           
##                   Kappa : 0.1375          
##                                           
##  Mcnemar's Test P-Value : <2e-16          
##                                           
##             Sensitivity : 0.7445          
##             Specificity : 0.8455          
##          Pos Pred Value : 0.9925          
##          Neg Pred Value : 0.1080          
##              Prevalence : 0.9647          
##          Detection Rate : 0.7183          
##    Detection Prevalence : 0.7237          
##       Balanced Accuracy : 0.7950          
##                                           
##        'Positive' Class : 1               
##

5.2 Under sampling

library("ROSE")
datos_balanceados = ovun.sample(COND_EGR~., data=datos_trn,
                                p=0.5,seed=1, method="under")$data

#Balance
COND=table(datos_balanceados$COND_EGR)
COND=round(rbind(COND,COND/sum(COND)),2)
colnames(COND)=c("Vivo/Viva","Fallecido/Fallecida")
rownames(COND)=c("Fa","Fr")
knitr::kable(COND,align = "r")

	Vivo/Viva	Fallecido/Fallecida
Fa	1600.00	1655.00
Fr	0.49	0.51

La regresión con los datos balanceados será la siguiente:

modelo=train(COND_EGR~SEXO+EDAD+DIAS_ESTAD+ESTAB+INTERV_Q+C_ESTAB,data=datos_balanceados,method="glm",family=binomial(),trControl=fitControl)
print(modelo)

## Generalized Linear Model 
## 
## 45371 samples
##     6 predictor
##     2 classes: '1', '2' 
## 
## No pre-processing
## Resampling: Cross-Validated (10 fold) 
## Summary of sample sizes: 40835, 40834, 40833, 40834, 40834, 40835, ... 
## Resampling results:
## 
##   Accuracy  Kappa  
##   0.790791  0.58162

summary(modelo)

## 
## Call:
## NULL
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -3.6391  -0.6765   0.0000   0.7407   2.9256  
## 
## Coefficients: (2 not defined because of singularities)
##                                                Estimate Std. Error z value
## (Intercept)                                  -3.622e+00  4.684e-02 -77.329
## SEXO2                                        -4.496e-01  2.420e-02 -18.576
## SEXO3                                                NA         NA      NA
## EDAD                                          4.873e-02  5.718e-04  85.214
## DIAS_ESTAD                                    1.420e-02  7.884e-04  18.016
## ESTAB113130                                  -8.347e-01  9.840e-02  -8.482
## ESTAB113150                                  -6.437e-01  4.357e-02 -14.774
## ESTAB113160                                  -5.181e-01  6.376e-02  -8.126
## ESTAB113170                                  -2.317e+02  1.000e+07   0.000
## ESTAB113180                                  -2.751e-01  3.067e-02  -8.970
## ESTAB113190                                  -5.468e-01  4.346e-02 -12.583
## INTERV_Q2                                     1.576e+00  3.027e-02  52.066
## `C_ESTABEstablecimiento Mediana Complejidad`         NA         NA      NA
##                                              Pr(>|z|)    
## (Intercept)                                   < 2e-16 ***
## SEXO2                                         < 2e-16 ***
## SEXO3                                              NA    
## EDAD                                          < 2e-16 ***
## DIAS_ESTAD                                    < 2e-16 ***
## ESTAB113130                                   < 2e-16 ***
## ESTAB113150                                   < 2e-16 ***
## ESTAB113160                                  4.45e-16 ***
## ESTAB113170                                         1    
## ESTAB113180                                   < 2e-16 ***
## ESTAB113190                                   < 2e-16 ***
## INTERV_Q2                                     < 2e-16 ***
## `C_ESTABEstablecimiento Mediana Complejidad`       NA    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 62898  on 45370  degrees of freedom
## Residual deviance: 42854  on 45360  degrees of freedom
## AIC: 42876
## 
## Number of Fisher Scoring iterations: 8

varImp(modelo)

## glm variable importance
## 
##             Overall
## EDAD        100.000
## INTERV_Q2    61.100
## SEXO2        21.800
## DIAS_ESTAD   21.142
## ESTAB113150  17.337
## ESTAB113190  14.766
## ESTAB113180  10.527
## ESTAB113130   9.954
## ESTAB113160   9.536
## ESTAB113170   0.000

mod_pred = predict(modelo,datos_tst)

confusionMatrix(mod_pred,datos_tst$COND_EGR)

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction     1     2
##          1 13966   106
##          2  4792   580
##                                           
##                Accuracy : 0.7481          
##                  95% CI : (0.7419, 0.7542)
##     No Information Rate : 0.9647          
##     P-Value [Acc > NIR] : 1               
##                                           
##                   Kappa : 0.1375          
##                                           
##  Mcnemar's Test P-Value : <2e-16          
##                                           
##             Sensitivity : 0.7445          
##             Specificity : 0.8455          
##          Pos Pred Value : 0.9925          
##          Neg Pred Value : 0.1080          
##              Prevalence : 0.9647          
##          Detection Rate : 0.7183          
##    Detection Prevalence : 0.7237          
##       Balanced Accuracy : 0.7950          
##                                           
##        'Positive' Class : 1               
##

5.3 Over and under sampling

datos_balanceados = ovun.sample(COND_EGR~., data=datos_trn,
                                p=0.5,seed=1, method="both")$data

#Balance
COND=table(datos_balanceados$COND_EGR)
COND=round(rbind(COND,COND/sum(COND)),2)
colnames(COND)=c("Vivo/Viva","Fallecido/Fallecida")
rownames(COND)=c("Fa","Fr")
knitr::kable(COND,align = "r")

	Vivo/Viva	Fallecido/Fallecida
Fa	22708.0	22663.0
Fr	0.5	0.5

La regresión con los datos balanceados será la siguiente:

modelo=train(COND_EGR~SEXO+EDAD+DIAS_ESTAD+ESTAB+INTERV_Q+C_ESTAB,data=datos_balanceados,method="glm",family=binomial(),trControl=fitControl)
print(modelo)

## Generalized Linear Model 
## 
## 45371 samples
##     6 predictor
##     2 classes: '1', '2' 
## 
## No pre-processing
## Resampling: Cross-Validated (10 fold) 
## Summary of sample sizes: 40835, 40834, 40833, 40834, 40834, 40835, ... 
## Resampling results:
## 
##   Accuracy  Kappa  
##   0.790791  0.58162

summary(modelo)

## 
## Call:
## NULL
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -3.6391  -0.6765   0.0000   0.7407   2.9256  
## 
## Coefficients: (2 not defined because of singularities)
##                                                Estimate Std. Error z value
## (Intercept)                                  -3.622e+00  4.684e-02 -77.329
## SEXO2                                        -4.496e-01  2.420e-02 -18.576
## SEXO3                                                NA         NA      NA
## EDAD                                          4.873e-02  5.718e-04  85.214
## DIAS_ESTAD                                    1.420e-02  7.884e-04  18.016
## ESTAB113130                                  -8.347e-01  9.840e-02  -8.482
## ESTAB113150                                  -6.437e-01  4.357e-02 -14.774
## ESTAB113160                                  -5.181e-01  6.376e-02  -8.126
## ESTAB113170                                  -2.317e+02  1.000e+07   0.000
## ESTAB113180                                  -2.751e-01  3.067e-02  -8.970
## ESTAB113190                                  -5.468e-01  4.346e-02 -12.583
## INTERV_Q2                                     1.576e+00  3.027e-02  52.066
## `C_ESTABEstablecimiento Mediana Complejidad`         NA         NA      NA
##                                              Pr(>|z|)    
## (Intercept)                                   < 2e-16 ***
## SEXO2                                         < 2e-16 ***
## SEXO3                                              NA    
## EDAD                                          < 2e-16 ***
## DIAS_ESTAD                                    < 2e-16 ***
## ESTAB113130                                   < 2e-16 ***
## ESTAB113150                                   < 2e-16 ***
## ESTAB113160                                  4.45e-16 ***
## ESTAB113170                                         1    
## ESTAB113180                                   < 2e-16 ***
## ESTAB113190                                   < 2e-16 ***
## INTERV_Q2                                     < 2e-16 ***
## `C_ESTABEstablecimiento Mediana Complejidad`       NA    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 62898  on 45370  degrees of freedom
## Residual deviance: 42854  on 45360  degrees of freedom
## AIC: 42876
## 
## Number of Fisher Scoring iterations: 8

varImp(modelo)

## glm variable importance
## 
##             Overall
## EDAD        100.000
## INTERV_Q2    61.100
## SEXO2        21.800
## DIAS_ESTAD   21.142
## ESTAB113150  17.337
## ESTAB113190  14.766
## ESTAB113180  10.527
## ESTAB113130   9.954
## ESTAB113160   9.536
## ESTAB113170   0.000

mod_pred = predict(modelo,datos_tst)

confusionMatrix(mod_pred,datos_tst$COND_EGR)

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction     1     2
##          1 13966   106
##          2  4792   580
##                                           
##                Accuracy : 0.7481          
##                  95% CI : (0.7419, 0.7542)
##     No Information Rate : 0.9647          
##     P-Value [Acc > NIR] : 1               
##                                           
##                   Kappa : 0.1375          
##                                           
##  Mcnemar's Test P-Value : <2e-16          
##                                           
##             Sensitivity : 0.7445          
##             Specificity : 0.8455          
##          Pos Pred Value : 0.9925          
##          Neg Pred Value : 0.1080          
##              Prevalence : 0.9647          
##          Detection Rate : 0.7183          
##    Detection Prevalence : 0.7237          
##       Balanced Accuracy : 0.7950          
##                                           
##        'Positive' Class : 1               
##

5.4 SMOTE

library("unbalanced")

datos_trn$COND_EGR=as.numeric(datos_trn$COND_EGR)
datos_trn$COND_EGR[which(datos_trn$COND_EGR==1)]=0        #Mayoritaria 0
datos_trn$COND_EGR[which(datos_trn$COND_EGR==2)]=1        #Minoritaria 1
datos_trn$COND_EGR=as.factor(datos_trn$COND_EGR)


indice=which(colnames(datos_trn)=="COND_EGR")
datos_balanceados=datos_trn[,-indice]
datos_balanceados=ubSMOTE(X=datos_balanceados, Y= datos_trn$COND_EGR)
datos_balanceados=cbind(datos_balanceados$X, COND_EGR=datos_balanceados$Y)

#Balance
COND=table(datos_balanceados$COND_EGR)
COND=round(rbind(COND,COND/sum(COND)),2)
colnames(COND)=c("Vivo/Viva","Fallecido/Fallecida")
rownames(COND)=c("Fa","Fr")
knitr::kable(COND,align = "r")

	Vivo/Viva	Fallecido/Fallecida
Fa	6620.00	4965.00
Fr	0.57	0.43

La regresión con los datos balanceados será la siguiente:

#Organización de datos
modelo=caret::train(COND_EGR~SEXO+EDAD+DIAS_ESTAD+ESTAB+INTERV_Q+C_ESTAB,data=datos_balanceados,method="glm",
                    family=binomial(),trControl=fitControl)

#Ajuste de los datos de test
datos_tst$COND_EGR=as.numeric(datos_tst$COND_EGR)
datos_tst$COND_EGR[which(datos_tst$COND_EGR==1)]=0        #Mayoritaria 0
datos_tst$COND_EGR[which(datos_tst$COND_EGR==2)]=1        #Minoritaria 1
datos_tst$COND_EGR=as.factor(datos_tst$COND_EGR)

#Datos del modelo
print(modelo)

## Generalized Linear Model 
## 
## 11585 samples
##     6 predictor
##     2 classes: '0', '1' 
## 
## No pre-processing
## Resampling: Cross-Validated (10 fold) 
## Summary of sample sizes: 10426, 10427, 10427, 10426, 10427, 10426, ... 
## Resampling results:
## 
##   Accuracy   Kappa    
##   0.7823027  0.5585539

summary(modelo)

## 
## Call:
## NULL
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.6582  -0.6613  -0.2747   0.7637   2.9934  
## 
## Coefficients: (1 not defined because of singularities)
##                                                Estimate Std. Error z value
## (Intercept)                                   -3.949407   0.097028 -40.704
## SEXO2                                         -0.379880   0.048101  -7.898
## SEXO3                                                NA         NA      NA
## EDAD                                           0.052176   0.001216  42.923
## DIAS_ESTAD                                     0.012363   0.001586   7.794
## ESTAB113130                                   -0.183448   0.208263  -0.881
## ESTAB113150                                    0.514247   0.083893   6.130
## ESTAB113160                                    0.552605   0.120075   4.602
## ESTAB113170                                  -16.240845 159.917251  -0.102
## ESTAB113180                                   -0.068407   0.063486  -1.078
## ESTAB113190                                   -0.262430   0.088796  -2.955
## INTERV_Q2                                      0.837288   0.054526  15.356
## `C_ESTABEstablecimiento Mediana Complejidad`   0.690937   0.075370   9.167
##                                              Pr(>|z|)    
## (Intercept)                                   < 2e-16 ***
## SEXO2                                        2.84e-15 ***
## SEXO3                                              NA    
## EDAD                                          < 2e-16 ***
## DIAS_ESTAD                                   6.51e-15 ***
## ESTAB113130                                   0.37840    
## ESTAB113150                                  8.80e-10 ***
## ESTAB113160                                  4.18e-06 ***
## ESTAB113170                                   0.91911    
## ESTAB113180                                   0.28125    
## ESTAB113190                                   0.00312 ** 
## INTERV_Q2                                     < 2e-16 ***
## `C_ESTABEstablecimiento Mediana Complejidad`  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 15823  on 11584  degrees of freedom
## Residual deviance: 10779  on 11573  degrees of freedom
## AIC: 10803
## 
## Number of Fisher Scoring iterations: 13

varImp(modelo)

## glm variable importance
## 
##                                              Overall
## EDAD                                         100.000
## INTERV_Q2                                     35.623
## `C_ESTABEstablecimiento Mediana Complejidad`  21.171
## SEXO2                                         18.206
## DIAS_ESTAD                                    17.963
## ESTAB113150                                   14.077
## ESTAB113160                                   10.510
## ESTAB113190                                    6.665
## ESTAB113180                                    2.279
## ESTAB113130                                    1.820
## ESTAB113170                                    0.000

mod_pred = predict(modelo,datos_tst)
confusionMatrix(mod_pred,datos_tst$COND_EGR)

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction     0     1
##          0 14887   179
##          1  3871   507
##                                           
##                Accuracy : 0.7917          
##                  95% CI : (0.7859, 0.7974)
##     No Information Rate : 0.9647          
##     P-Value [Acc > NIR] : 1               
##                                           
##                   Kappa : 0.1483          
##                                           
##  Mcnemar's Test P-Value : <2e-16          
##                                           
##             Sensitivity : 0.7936          
##             Specificity : 0.7391          
##          Pos Pred Value : 0.9881          
##          Neg Pred Value : 0.1158          
##              Prevalence : 0.9647          
##          Detection Rate : 0.7656          
##    Detection Prevalence : 0.7748          
##       Balanced Accuracy : 0.7664          
##                                           
##        'Positive' Class : 0               
##