Analisis de Accidentes Cerebrovasculares
Problema a abordar
El trabajo consiste en realizar una comparación entre dos modelos predictivos: por un lado por medio de una regresión logística y por otro lado un modelo de arboles de decisión llamado Random Forest. El objetivo es identificar los principales predictores de los ACVs y en segundo lugar evalular el rendimiento entre los dos modelos.
Fuente de información: “stroke.csv” extraido de Kaggle. Muestra de 5110 observaciones.
Los datos incluyen información sobre:
-Características demográficas (edad, género)
-Condiciones de salud (hipertensión, enfermedad cardíaca)
-Habitos de vida (estado de fumador)
-Medidas clínicas (nivel promedio de glucosa)
Variables
id: Identicador de cada observación
gender: Variable Categórica con valores “Male” (masculino) y “Female” (femenino).
age: Una variable numérica que representa la edad del individuo en años.
hypertension: Hipertensión expresado de manera binaria (0 o 1), como presencia o ausencia.
heart_disease: Una variable binaria (0 o 1) que indica si el individuo tiene enfermedad cardíaca (1) o no (0)
ever_married: Una variable categórica que indica si el individuo ha estado casado alguna vez, con valores “Yes” (sí) o “No”.
work_type: variable categórica que describe el tipo de trabajo del individuo, con valores como “Private” (privado), Govt_job (trabajo gubernamental) y “Self-employed” (autónomo).
Residence_type: variable categórica que indica el tipo de residencia del individuo, con valores “Urban” (urbano) o “Rural”
avg_glucose_level: representa el nivel promedio de glucosa en sangre del individuo.
bmi: Rerepresenta el indice de Masa Corporal (IMC) del individuo.
smoking_status: variable categórica que indica el estado de fumador del individuo, con valores como “formerly smoked” (ex fumador), “never smoked” (nunca fumó) y “smokes” (fuma).
stroke Una variable binaria (0 o 1) que indica si el individuo ha sufrido un accidente cerebrovascular (1) o no (0).
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.0
## ✔ ggplot2 3.4.4 ✔ tibble 3.2.1
## ✔ lubridate 1.9.3 ✔ tidyr 1.3.0
## ✔ purrr 1.0.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors## Loading required package: lattice
##
## Attaching package: 'caret'
##
## The following object is masked from 'package:purrr':
##
## lift## randomForest 4.7-1.1
## 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':
##
## margin##
## Attaching package: 'MASS'
##
## The following object is masked from 'package:dplyr':
##
## select## Type 'citation("pROC")' for a citation.
##
## Attaching package: 'pROC'
##
## The following objects are masked from 'package:stats':
##
## cov, smooth, var## Thank you for using fastDummies!
## To acknowledge our work, please cite the package:
## Kaplan, J. & Schlegel, B. (2023). fastDummies: Fast Creation of Dummy (Binary) Columns and Rows from Categorical Variables. Version 1.7.1. URL: https://github.com/jacobkap/fastDummies, https://jacobkap.github.io/fastDummies/.## Loading required package: Matrix
##
## Attaching package: 'Matrix'
##
## The following objects are masked from 'package:tidyr':
##
## expand, pack, unpack
##
## Loaded glmnet 4.1-8## Loading required package: carData
##
## Attaching package: 'car'
##
## The following object is masked from 'package:dplyr':
##
## recode
##
## The following object is masked from 'package:purrr':
##
## some1.Carga de Datos
2.Analisis Exploratorio
## id gender age hypertension heart_disease ever_married work_type
## 1 9046 Male 67 0 1 Yes Private
## 2 51676 Female 61 0 0 Yes Self-employed
## 3 31112 Male 80 0 1 Yes Private
## 4 60182 Female 49 0 0 Yes Private
## 5 1665 Female 79 1 0 Yes Self-employed
## 6 56669 Male 81 0 0 Yes Private
## Residence_type avg_glucose_level bmi smoking_status stroke
## 1 Urban 228.69 36.6 formerly smoked 1
## 2 Rural 202.21 <NA> never smoked 1
## 3 Rural 105.92 32.5 never smoked 1
## 4 Urban 171.23 34.4 smokes 1
## 5 Rural 174.12 24 never smoked 1
## 6 Urban 186.21 29 formerly smoked 1
##Imputación de Valores faltantes
#Ante la presencia de valores nulos, se procede a imputar valores faltantes por medio de MissRanger
datos$gender <- as.factor(datos$gender)
datos$hypertension <- as.factor(datos$hypertension)
datos$ever_married <- as.factor(datos$ever_married)
datos$work_type <- as.factor(datos$work_type)
datos$Residence_type <- as.factor(datos$Residence_type)
datos$bmi <- as.numeric(datos$bmi)
datos$smoking_status <- as.factor(datos$smoking_status)
# Imputar valores faltantes con missRanger
datos_imputados <- missRanger(datos)##
## Missing value imputation by random forests
##
## Variables to impute: bmi, smoking_status
## Variables used to impute: id, gender, age, hypertension, heart_disease, ever_married, work_type, Residence_type, avg_glucose_level, bmi, smoking_status, stroke
##
## iter 1
##
|
| | 0%
|
|=================================== | 50%
|
|======================================================================| 100%
## iter 2
##
|
| | 0%
|
|=================================== | 50%
|
|======================================================================| 100%
## iter 3
##
|
| | 0%
|
|=================================== | 50%
|
|======================================================================| 100%## [1] 0##
## formerly smoked never smoked smokes
## 885 1892 789##
## formerly smoked never smoked smokes
## 968 3335 807
# EDA de datos limpios
3.Analisis de Regresión Logísitica
# Seleccionar el mejor modelo en funcion a Akaike
full_model <- glm(stroke ~ ., data=datos_imputados, family=binomial)
step_model <- step(full_model, direction="both")## Start: AIC=1608.57
## stroke ~ id + gender + age + hypertension + heart_disease + ever_married +
## work_type + Residence_type + avg_glucose_level + bmi + smoking_status
##
## Df Deviance AIC
## - gender 2 1574.6 1604.6
## - bmi 1 1574.7 1606.7
## - id 1 1574.8 1606.8
## - Residence_type 1 1574.9 1606.9
## - work_type 4 1581.2 1607.2
## - ever_married 1 1575.4 1607.4
## - heart_disease 1 1576.3 1608.3
## <none> 1574.6 1608.6
## - hypertension 1 1580.2 1612.2
## - smoking_status 2 1583.6 1613.6
## - avg_glucose_level 1 1584.6 1616.6
## - age 1 1773.9 1805.9
##
## Step: AIC=1604.64
## stroke ~ id + age + hypertension + heart_disease + ever_married +
## work_type + Residence_type + avg_glucose_level + bmi + smoking_status
##
## Df Deviance AIC
## - bmi 1 1574.7 1602.7
## - id 1 1574.9 1602.9
## - Residence_type 1 1574.9 1602.9
## - work_type 4 1581.3 1603.3
## - ever_married 1 1575.5 1603.5
## - heart_disease 1 1576.4 1604.4
## <none> 1574.6 1604.6
## - hypertension 1 1580.3 1608.3
## + gender 2 1574.6 1608.6
## - smoking_status 2 1583.7 1609.7
## - avg_glucose_level 1 1584.6 1612.6
## - age 1 1774.3 1802.3
##
## Step: AIC=1602.73
## stroke ~ id + age + hypertension + heart_disease + ever_married +
## work_type + Residence_type + avg_glucose_level + smoking_status
##
## Df Deviance AIC
## - id 1 1575.0 1601.0
## - Residence_type 1 1575.0 1601.0
## - work_type 4 1581.3 1601.3
## - ever_married 1 1575.6 1601.6
## - heart_disease 1 1576.4 1602.4
## <none> 1574.7 1602.7
## + bmi 1 1574.6 1604.6
## - hypertension 1 1580.6 1606.6
## + gender 2 1574.7 1606.7
## - smoking_status 2 1583.8 1607.8
## - avg_glucose_level 1 1585.6 1611.6
## - age 1 1778.3 1804.3
##
## Step: AIC=1600.97
## stroke ~ age + hypertension + heart_disease + ever_married +
## work_type + Residence_type + avg_glucose_level + smoking_status
##
## Df Deviance AIC
## - Residence_type 1 1575.2 1599.2
## - work_type 4 1581.6 1599.6
## - ever_married 1 1575.8 1599.8
## - heart_disease 1 1576.7 1600.7
## <none> 1575.0 1601.0
## + id 1 1574.7 1602.7
## + bmi 1 1574.9 1602.9
## + gender 2 1574.9 1604.9
## - hypertension 1 1580.9 1604.9
## - smoking_status 2 1584.1 1606.1
## - avg_glucose_level 1 1585.7 1609.7
## - age 1 1778.5 1802.5
##
## Step: AIC=1599.25
## stroke ~ age + hypertension + heart_disease + ever_married +
## work_type + avg_glucose_level + smoking_status
##
## Df Deviance AIC
## - work_type 4 1582.0 1598.0
## - ever_married 1 1576.1 1598.1
## - heart_disease 1 1576.9 1598.9
## <none> 1575.2 1599.2
## + Residence_type 1 1575.0 1601.0
## + id 1 1575.0 1601.0
## + bmi 1 1575.2 1601.2
## - hypertension 1 1581.1 1603.1
## + gender 2 1575.2 1603.2
## - smoking_status 2 1584.6 1604.6
## - avg_glucose_level 1 1586.1 1608.1
## - age 1 1779.5 1801.5
##
## Step: AIC=1597.95
## stroke ~ age + hypertension + heart_disease + ever_married +
## avg_glucose_level + smoking_status
##
## Df Deviance AIC
## - ever_married 1 1583.0 1597.0
## - heart_disease 1 1583.9 1597.9
## <none> 1582.0 1598.0
## + work_type 4 1575.2 1599.2
## + id 1 1581.6 1599.6
## + Residence_type 1 1581.6 1599.6
## + bmi 1 1581.9 1599.9
## - hypertension 1 1587.6 1601.6
## + gender 2 1581.9 1601.9
## - smoking_status 2 1590.8 1602.8
## - avg_glucose_level 1 1593.5 1607.5
## - age 1 1794.0 1808.0
##
## Step: AIC=1597.02
## stroke ~ age + hypertension + heart_disease + avg_glucose_level +
## smoking_status
##
## Df Deviance AIC
## <none> 1583.0 1597.0
## - heart_disease 1 1585.1 1597.1
## + ever_married 1 1582.0 1598.0
## + work_type 4 1576.1 1598.1
## + Residence_type 1 1582.7 1598.7
## + id 1 1582.7 1598.7
## + bmi 1 1583.0 1599.0
## - hypertension 1 1588.7 1600.7
## + gender 2 1583.0 1601.0
## - smoking_status 2 1591.5 1601.5
## - avg_glucose_level 1 1594.3 1606.3
## - age 1 1821.3 1833.3Definición del AIC:
AIC = 2k - 2ln(L) Donde k es el número de parámetros en el modelo y L es el valor máximo de la función de verosimilitud para el modelo.
El AIC busca un equilibrio entre la bondad de ajuste del modelo y su complejidad. Valores más bajos de AIC indican modelos preferibles.
En orden de importancia
age (AIC aumentaría a 1838.4 si se elimina) avg_glucose_level (AIC: 1608.8) hypertension (AIC: 1603.0) smoking_status (AIC: 1601.5) heart_disease (AIC: 1599.7)
-La edad es, con mucho, el predictor más importante del accidente cerebrovascular en este modelo.
-El nivel promedio de glucosa es el segundo predictor más importante.
-La hipertensión y el estado de fumador también son factores significativos.
-La enfermedad cardíaca se mantuvo en el modelo, aunque su contribución es relativamente pequeña.
#Modelamos con los predictores del AIC
modelo_aic <- glm(stroke ~ age + hypertension + heart_disease + avg_glucose_level + smoking_status, data = datos_imputados, family = binomial)
#Chequeamos supuesto de multicolinealidad
vif_valores <- vif(modelo_aic)
print(vif_valores)## GVIF Df GVIF^(1/(2*Df))
## age 1.100336 1 1.048969
## hypertension 1.043128 1 1.021337
## heart_disease 1.074213 1 1.036442
## avg_glucose_level 1.052001 1 1.025671
## smoking_status 1.039321 2 1.009688# Comparar AIC con el total de los predictores
modelo_ampliado <- glm(stroke ~ age + hypertension + heart_disease + avg_glucose_level + smoking_status + ever_married, bmi, data = datos_imputados, family = binomial)## Warning in eval(family$initialize): non-integer #successes in a binomial glm!## df AIC
## modelo_aic 7 1597.018
## modelo_ampliado 8 48321.106# Comparamos rendimiento
roc_aic <- roc(datos_imputados$stroke, predict(modelo_aic, type = "response"))## Setting levels: control = 0, case = 1## Setting direction: controls < cases## Setting levels: control = 0, case = 1
## Setting direction: controls < cases## Area under the curve: 0.8471## Area under the curve: 0.8478# Graficar las curvas ROC con intervalos de confianza
plot(roc_aic, main="Curva ROC - Comparación de Modelos con IC",
col="blue", lwd=2)
lines(roc_ampliado, col="red", lwd=2)
Complejidad del modelo:
El AIC mucho más bajo del modelo_aic (1599.468 vs 48434.618) indica que este modelo proporciona un mejor equilibrio entre la bondad de ajuste y la complejidad del modelo.
Basándonos únicamente en el AIC, el modelo_aic es claramente preferible. Ofrece una mejor explicación de los datos con mucha menos complejidad.
El VIF (Variance Inflation Factor o Factor de Inflación de la Varianza) de un predictor es una medida de la facilidad con la que se predice a partir de una regresión lineal utilizando otros predictores.
Los valores de VIF son todos muy cercanos a 1, lo que indica que no hay una multicolinealidad significativa entre tus variables independientes. Esto es una buena señal y sugiere que tus predictores no están altamente correlacionados entre sí.
Con respecto a la linealidad el valor p extremadamente bajo indica que age no tiene una relación lineal con el logit de stroke. En paralelo el valor p de avg_glucose_level cercano a 0.05 sugiere que podría no tener una relación lineal con el logit de stroke, aunque está justo en el límite de significancia
Comparación de modelos:
El ROC muestra cómo se comporta el modelo a través de diferentes umbrales de clasificación, permitiendo evaluar su rendimiento general.
El área bajo la curva ROC (AUC-ROC) proporciona una medida única del rendimiento del modelo, independiente del umbral de clasificación elegido.
Permite comparar fácilmente diferentes modelos de clasificación en un mismo gráfico. Ayuda a determinar qué modelo tiene un mejor rendimiento general.
Las curvas están casi superpuestas, lo que sugiere que el rendimiento de ambos modelos es muy similar, lo cual es consistente con el hecho de que los valores de AUC (Area Under the Curve) son 0.8453 para el Modelo AIC y 0.8478 para el Modelo Ampliado.
Basándonos en estos intervalos de confianza, podemos afirmar con un 95% de confianza que el verdadero AUC para ambos modelos se encuentra entre aproximadamente 0.81 y 0.86. La superposición de los intervalos sugiere que no hay una diferencia estadísticamente significativa entre los dos modelos en términos de capacidad discriminativa.
Dado que no hay una diferencia significativa entre los modelos, sería razonable preferir el Modelo AIC por su simplicidad (principio de parsimonia). El Modelo AIC proporciona esencialmente el mismo rendimiento predictivo con menos variables, lo que lo hace más fácil de interpretar y posiblemente más robusto en la generalización a nuevos datos.
Seguimos seleccionando los predictores segun AIC, dividiendo el dataset en Train y Test, corrigiendo el desbalance entre strokes y
# Predictores seleccionados según AIC
vars_aic <- c("stroke", "age", "hypertension", "heart_disease", "avg_glucose_level", "smoking_status")
# Semilla de reproducibilidad
set.seed(123)
# Crear una partición de datos con 70% para entrenamiento y 30% para prueba
particion <- createDataPartition(datos_imputados$stroke, p = 0.7, list = FALSE)
datos_train <- datos_imputados[particion, ]
datos_test <- datos_imputados[-particion, ]
# Subconjuntos de datos de entrenamiento y prueba con las variables seleccionadas
datos_train_AIC <- subset(datos_train, select = vars_aic)
datos_test_AIC <- subset(datos_test, select = vars_aic)
# stroke como factor
datos_train_AIC$stroke <- as.factor(datos_train_AIC$stroke)
# Corregir balance de stroke mediante resampleo
set.seed(42)
datos_train_AIC_upsampled <- upSample(x = datos_train_AIC[, !names(datos_train_AIC) %in% c("stroke")],y = datos_train_AIC$stroke,yname = "stroke")
# proporciones después del upsampling
print(table(datos_train_AIC_upsampled$stroke))##
## 0 1
## 3408 3408# Eliminar filas con NA si es necesario
datos_train_AIC_upsampled <- na.omit(datos_train_AIC_upsampled)
datos_test_AIC_upsampled <- na.omit(datos_test_AIC)
# Regresión logística con variables AIC en datos balanceados
modelo_aic <- glm(stroke ~ age + hypertension + heart_disease + avg_glucose_level + smoking_status,
data = datos_train_AIC_upsampled, family = binomial)
# Resumen del modelo AIC
summary(modelo_aic)##
## Call:
## glm(formula = stroke ~ age + hypertension + heart_disease + avg_glucose_level +
## smoking_status, family = binomial, data = datos_train_AIC_upsampled)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -4.3582754 0.1471693 -29.614 < 2e-16 ***
## age 0.0691195 0.0020218 34.187 < 2e-16 ***
## hypertension1 0.5263687 0.0806349 6.528 6.67e-11 ***
## heart_disease 0.3668954 0.1028495 3.567 0.000361 ***
## avg_glucose_level 0.0047549 0.0005611 8.474 < 2e-16 ***
## smoking_statusnever smoked -0.4914501 0.0706578 -6.955 3.52e-12 ***
## smoking_statussmokes -0.1844142 0.0923338 -1.997 0.045797 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 9449 on 6815 degrees of freedom
## Residual deviance: 6598 on 6809 degrees of freedom
## AIC: 6612
##
## Number of Fisher Scoring iterations: 5## (Intercept) age
## 0.01280044 1.07156426
## hypertension1 heart_disease
## 1.69277409 1.44324692
## avg_glucose_level smoking_statusnever smoked
## 1.00476625 0.61173864
## smoking_statussmokes
## 0.83159125Se realizó un upsampling para balancear las clases, resultando en 3408 casos para cada clase (0 y 1).
Ciertamente, puedo proporcionar más detalles sobre los resultados. Vamos a examinar más de cerca los componentes clave del análisis:
Coeficientes del modelo:
Todos estos coeficientes, excepto “Estado de fumador (fuma)”, son estadísticamente significativos (p < 0.001).
Odds Ratios:
age: 1.07164376 (Por cada año que aumenta la edad, las probabilidades de tener un accidente cerebrovascular se multiplican por 1.07 (aumentan un 7%))
hypertension1: 1.69811311. Las personas con hipertensión tienen 1.70 veces más probabilidades de tener un accidente cerebrovascular que las que no tienen hipertensión.
heart_disease: 1.42346265. Las personas con enfermedad cardíaca tienen 1.42 veces más probabilidades de tener un accidente cerebrovascular que las que no tienen enfermedad cardíaca.
avg_glucose_level: 1.00478192. Por cada unidad que aumenta el nivel promedio de glucosa, las probabilidades de tener un accidente cerebrovascular se multiplican por 1.005 (aumentan un 0.5%).
smoking_statusnever smoked: 0.62644951. Las personas que nunca han fumado tienen 0.63 veces las probabilidades (o un 37% menos de probabilidades) de tener un accidente cerebrovascular en comparación con la categoría de referencia.
smoking_statussmokes: 0.85009250. Los fumadores actuales tienen 0.85 veces las probabilidades (o un 15% menos de probabilidades) de tener un accidente cerebrovascular en comparación con la categoría de referencia.
# prediccio en el conjunto de prueba
predicciones <- predict(modelo_aic, newdata = datos_test_AIC_upsampled, type = "response")
summary(predicciones)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.01088 0.07173 0.24472 0.32172 0.53305 0.96193#Con umbral de 0.3
predicciones_binarias <- ifelse(predicciones > 0.3, 1, 0)
valores_reales <- datos_test_AIC$stroke
# Crear matriz de confusión
cm <- confusionMatrix(factor(predicciones_binarias), factor(valores_reales))
print(cm)## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 841 4
## 1 612 76
##
## Accuracy : 0.5982
## 95% CI : (0.5731, 0.6228)
## No Information Rate : 0.9478
## P-Value [Acc > NIR] : 1
##
## Kappa : 0.1152
##
## Mcnemar's Test P-Value : <2e-16
##
## Sensitivity : 0.5788
## Specificity : 0.9500
## Pos Pred Value : 0.9953
## Neg Pred Value : 0.1105
## Prevalence : 0.9478
## Detection Rate : 0.5486
## Detection Prevalence : 0.5512
## Balanced Accuracy : 0.7644
##
## 'Positive' Class : 0
## # métricas específicas
sensibilidad <- cm$byClass['Sensitivity']
especificidad <- cm$byClass['Specificity']
precision <- cm$byClass['Precision']
exactitud <- cm$overall['Accuracy']
f1_score <- cm$byClass['F1']
# Calcular la curva ROC y AUC para los datos de prueba
roc_test <- roc(datos_test_AIC$stroke, predicciones)## Setting levels: control = 0, case = 1## Setting direction: controls < casesauc_test <- auc(roc_test)
# ROC de prueba
plot(roc_test, main = "Curva ROC - Datos de Prueba", col = "blue")
abline(a = 0, b = 1, lty = 2, col = "gray")
Se probaron 3 umbrales: 0.2, 0.25 y 0.3, vamos a comparar las métricas clave:
Umbral 0.2:
Accuracy: 0.5068 Sensitivity: 0.48039 Specificity: 0.98750 Balanced Accuracy: 0.73394
Umbral 0.25:
Accuracy: 0.5551 Sensitivity: 0.5320 Specificity: 0.9750 Balanced Accuracy: 0.7535
Umbral 0.3:
Accuracy: 0.5995 Sensitivity: 0.5802 Specificity: 0.9500 Balanced Accuracy: 0.7651
4.Conclusión del modelo de Regresión
Analizando estos resultados, el umbral de 0.3 parece ser el mejor por las siguientes razones:
Tiene la mayor exactitud (Accuracy) de 0.5995, lo que significa que clasifica correctamente el 59.95% de todos los casos. Ofrece el mejor equilibrio entre sensibilidad y especificidad:
La sensibilidad (0.5802) es la más alta de los tres umbrales, lo que significa que identifica correctamente el 58.02% de los casos negativos reales (no stroke).
Aunque la especificidad (0.9500) es ligeramente menor que en los otros umbrales, sigue siendo muy alta, identificando correctamente el 95% de los casos positivos reales (stroke).
Tiene el Balanced Accuracy más alto (0.7651), lo que indica un mejor rendimiento general considerando tanto la sensibilidad como la especificidad. El valor de Kappa (0.1158) es el más alto de los tres, sugiriendo un acuerdo ligeramente mejor entre las predicciones y los valores reales.
En el contexto de la detección de accidentes cerebrovasculares, resulta crucial tener una buena sensibilidad para no perder casos positivos, pero también mantener una alta especificidad para evitar falsos positivos. El umbral de 0.3 ofrece el mejor compromiso entre estos dos aspectos.
Sin embargo, es importante notar que aún con este umbral, el modelo tiene limitaciones:
La sensibilidad sigue siendo relativamente baja (0.5802), lo que significa que aún se están perdiendo muchos casos positivos.
El desequilibrio en los datos (prevalencia de 0.9478 para la clase negativa) sigue afectando el rendimiento del modelo.
En conclusión, aunque el umbral de 0.3 parece ser el mejor de los tres, el modelo aún podría beneficiarse de mejoras adicionales, como técnicas de balanceo de datos más avanzadas, feature engineering, o incluso considerar otros algoritmos de clasificación que manejen mejor los conjuntos de datos desequilibrados.
Factores de riesgo principales:
La edad es el predictor más fuerte y significativo para el accidente cerebrovascular. Por cada año de aumento en la edad, el riesgo aumenta un 7.27%.
El nivel promedio de glucosa en sangre es el segundo factor más importante, aunque su efecto es más pequeño pero estadísticamente significativo.
Nunca haber fumado parece tener un efecto protector significativo, reduciendo el riesgo de accidente cerebrovascular en un 35.84% comparado con la categoría de referencia.
Modelo
El modelo tiene un buen poder predictivo, con un AUC de 0.8453 (IC 95%: 0.8214-0.8708). La diferencia en rendimiento entre el modelo AIC y el modelo ampliado es mínima, lo que sugiere que un modelo más simple es suficiente para predecir el riesgo de accidente cerebrovascular.
Comparación entre los modelos con Upsampling y sin:
En un a primera instancia se comparó dos modelos, con y sin upsampling. Este ultimo parece tener un mejor rendimiento general, especialmente en términos de balance entre sensibilidad y especificidad.
El modelo sin upsampling tiene una excelente especificidad, pero a costa de una baja sensibilidad, lo que podría ser problemático en un contexto médico donde no detectar un caso de stroke (falso negativo) podría ser muy grave.
El upsampling ha ayudado a mejorar la detección de casos positivos sin sacrificar demasiado la especificidad.
Implicaciones clínicas en ambos casos:
En resumen, el análisis parece proporcionarnos una herramienta útil para identificar individuos en riesgo de accidente cerebrovascular, con la edad y el nivel de glucosa como los principales factores a considerar. El modelo ofrece un buen equilibrio entre simplicidad y poder predictivo, lo que lo hace potencialmente valioso para su uso en entornos clínicos.
A continuación se procede a comparar el rendimiento con el modelo Random Forest
5.Analisis de Predicción por Random Forest
rf_model <- randomForest(as.factor(stroke) ~ ., data = datos_train_AIC, ntree = 2000, importance = TRUE)
summary(rf_model)## Length Class Mode
## call 5 -none- call
## type 1 -none- character
## predicted 3577 factor numeric
## err.rate 6000 -none- numeric
## confusion 6 -none- numeric
## votes 7154 matrix numeric
## oob.times 3577 -none- numeric
## classes 2 -none- character
## importance 20 -none- numeric
## importanceSD 15 -none- numeric
## localImportance 0 -none- NULL
## proximity 0 -none- NULL
## ntree 1 -none- numeric
## mtry 1 -none- numeric
## forest 14 -none- list
## y 3577 factor numeric
## test 0 -none- NULL
## inbag 0 -none- NULL
## terms 3 terms call##
## Call:
## randomForest(formula = as.factor(stroke) ~ ., data = datos_train_AIC, ntree = 2000, importance = TRUE)
## Type of random forest: classification
## Number of trees: 2000
## No. of variables tried at each split: 2
##
## OOB estimate of error rate: 4.84%
## Confusion matrix:
## 0 1 class.error
## 0 3404 4 0.001173709
## 1 169 0 1.000000000
Detección de strokes:
La especificidad del 80% nos indica que el modelo es bastante bueno identificando casos de accidentes cerebrovasculares. Sin embargo, el bajo número de verdaderos positivos (64) en comparación con los falsos negativos (387) sugiere que el modelo aún pierde muchos casos de stroke.
Predicción de no-strokes (clase negativa):
La alta precisión (98.52%) indica que cuando el modelo predice un no-stroke, es muy probable que sea correcto. La sensibilidad del 73.37% sugiere que el modelo identifica correctamente la mayoría de los casos de no-stroke, pero aún clasifica erróneamente una cantidad significativa como strokes.
Balance entre sensibilidad y especificidad:
El modelo muestra un buen balance entre estos dos aspectos, con una ligera inclinación hacia la especificidad.
AUC de 0.8191:
Indica una buena capacidad discriminativa del modelo. Un clasificador aleatorio tendría un AUC de 0.5, mientras que un clasificador perfecto tendría un AUC de 1.0.
El modelo muestra un buen rendimiento general, especialmente considerando la naturaleza desafiante de la predicción de strokes. El alto AUC sugiere que el modelo tiene una buena base para la discriminación, pero podría beneficiarse de un ajuste fino adicional.
datos_train_AIC$stroke <- as.factor(datos_train_AIC$stroke)
# resampleo por desbalances es strokes
set.seed(42)
datos_upsampled <- upSample(x = datos_train_AIC[, !names(datos_train_AIC) %in% c("stroke")],
y = datos_train_AIC$stroke,
yname = "stroke")
# Ver las proporciones
table(datos_upsampled$stroke)##
## 0 1
## 3408 3408# Predicción en el conjunto de prueba
predicciones_prob <- predict(rf_model, newdata = datos_test_AIC, type = "prob")
predicciones <- predicciones_prob[,2]
# Repetimos umbral de 0.25
predicciones_binarias <- ifelse(predicciones > 0.2, 1, 0)
valores_reales <- datos_test_AIC$stroke
# matriz de confusión
cm <- confusionMatrix(factor(predicciones_binarias), factor(valores_reales))
print(cm)## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 1418 69
## 1 35 11
##
## Accuracy : 0.9322
## 95% CI : (0.9184, 0.9442)
## No Information Rate : 0.9478
## P-Value [Acc > NIR] : 0.996628
##
## Kappa : 0.1419
##
## Mcnemar's Test P-Value : 0.001213
##
## Sensitivity : 0.9759
## Specificity : 0.1375
## Pos Pred Value : 0.9536
## Neg Pred Value : 0.2391
## Prevalence : 0.9478
## Detection Rate : 0.9250
## Detection Prevalence : 0.9700
## Balanced Accuracy : 0.5567
##
## 'Positive' Class : 0
## # Métricas específicas
sensibilidad <- cm$byClass['Sensitivity']
especificidad <- cm$byClass['Specificity']
precision <- cm$byClass['Precision']
exactitud <- cm$overall['Accuracy']
f1_score <- cm$byClass['F1']
# Imprimir métricas
print(paste("Sensibilidad:", sensibilidad))## [1] "Sensibilidad: 0.975911906400551"## [1] "Especificidad: 0.1375"## [1] "Precision: 0.95359784801614"## [1] "Exactitud: 0.932159165035877"## [1] "F1-Score: 0.964625850340136"# Calcular la curva ROC y AUC para los datos de prueba
roc_test <- roc(datos_test_AIC$stroke, predicciones)## Setting levels: control = 0, case = 1## Setting direction: controls < cases## [1] "AUC: 0.814921713695802"# ROC de prueba
plot(roc_test, main = "Curva ROC - Datos de Prueba", col = "blue")
abline(a = 0, b = 1, lty = 2, col = "gray")
6.Conclusion del modelo Random Forest
El modelo con umbral de 0.2 clasifica correctamente el 93.28% de todos los casos. Esto parece ser un buen rendimiento, pero puede ser engañoso debido al desequilibrio de clases en los datos de prueba.
Sensibilidad (0.9773): identifica correctamente el 97.73% de los casos sin accidente cerebrovascular. Esto indica un excelente rendimiento en la detección de casos negativos.
Especificidad (0.1250):identifica correctamente solo el 12.5% de los casos con accidente cerebrovascular. Esta baja especificidad es preocupante, ya que significa que el modelo tiene dificultades para detectar casos positivos.
Precisión (0.9530): De todos los casos que el modelo predice como negativos, el 95.30% son realmente negativos. Esto sugiere que cuando el modelo predice que no hay accidente cerebrovascular, generalmente es correcto.
F1-Score (0.9650): Este es un buen equilibrio entre precisión y sensibilidad para la clase negativa.
AUC (0.8197): Indica una buena capacidad discriminativa general del modelo.
Observaciones adicionales:
El modelo muestra un fuerte sesgo hacia la clase mayoritaria (sin accidente cerebrovascular).
Como ya se mencionó un alta sensibilidad y baja especificidad indican que el modelo tiende a clasificar la mayoría de los casos como negativos.
El desequilibrio en el rendimiento entre clases sugiere que el modelo no ha logrado superar completamente el problema de clases desequilibradas, a pesar del sobremuestreo en el entrenamiento.
Implicaciones prácticas:
El modelo es muy bueno para identificar casos sin accidente cerebrovascular, lo que podría ser útil para descartar rápidamente casos de bajo riesgo.
Sin embargo, su baja capacidad para detectar casos positivos lo hace poco confiable para identificar pacientes que realmente tienen un accidente cerebrovascular, lo cual es crítico en un contexto médico.
7.Conclusión Final
# Crear el data frame
tabla_comparativa <- data.frame(
Metrica = c("Exactitud", "Sensibilidad", "Especificidad", "Precision", "F1-Score", "Balanced Accuracy"),
Random_Forest = c(0.9328, 0.9773, 0.1250, 0.9530, 0.9650, 0.5511),
Regresion_Logistica = c(0.5995, 0.5802, 0.9500, 0.9953, NA, 0.7651)
)
# Mostrar la tabla
print(tabla_comparativa)## Metrica Random_Forest Regresion_Logistica
## 1 Exactitud 0.9328 0.5995
## 2 Sensibilidad 0.9773 0.5802
## 3 Especificidad 0.1250 0.9500
## 4 Precision 0.9530 0.9953
## 5 F1-Score 0.9650 NA
## 6 Balanced Accuracy 0.5511 0.7651Exactitud:
RF tiene una exactitud mucho mayor (93.28% vs 59.95%).
Sin embargo, la exactitud de RF puede estar inflada debido al desequilibrio de clases.
Sensibilidad:
RF es mucho mejor en detectar casos negativos (97.73% vs 58.02%).
RL pierde muchos casos negativos, clasificándolos erróneamente como positivos.
Especificidad:
RL es significativamente mejor en detectar casos positivos (95% vs 12.5%).
Esta es una mejora drástica en la detección de accidentes cerebrovasculares.
Precisión:
Ambos modelos tienen alta precisión, pero RL es ligeramente superior (99.53% vs 95.30%).
Balanced Accuracy:
RL tiene un mejor equilibrio entre sensibilidad y especificidad (76.51% vs 55.11%).
El modelo RF tiene un fuerte sesgo hacia la clase mayoritaria (osea 0 ), lo que nos sugiere en una alta exactitud global pero una pobre detección de casos positivos.
El modelo RL, por otro lado, sacrifica algo de exactitud global para lograr un mejor equilibrio entre la detección de casos positivos y negativos. RL es mucho mejor en detectar casos de accidente cerebrovascular (alta especificidad), lo cual es crucial en un contexto médico. Sin embargo, RL clasifica erróneamente muchos casos negativos como positivos, lo que podría llevar a un alto número de falsos positivos.
RF sería mejor para descartar rápidamente casos de bajo riesgo, pero podría pasar por alto muchos casos reales de accidente cerebrovascular.
RL sería más útil para identificar posibles casos de accidente cerebrovascular, aunque a costa de más falsos positivos.
En conclusión, aunque el modelo RF tiene una mayor exactitud global, el modelo RL parece más adecuado para este problema médico debido a su mejor capacidad para detectar casos positivos de accidente cerebrovascular, que es crucial en este contexto. Sin embargo, ambos modelos tienen sus fortalezas y debilidades, y la elección final dependerá de los objetivos específicos y la tolerancia al riesgo en el contexto clínico.