Predicción de diabetes en pacientes
Mario Sequeda
2023-05-25
Introducción
Teniendo como caso de estudio la base de datos “Pima Indians Diabetes Database”. El objetivo del conjunto de datos es predecir diagnósticamente si un paciente tiene o no diabetes, basándose en determinadas mediciones diagnósticas incluidas en el conjunto de datos. Se impusieron varias restricciones a la selección de estos casos de una base de datos más amplia. En concreto, todos los pacientes son mujeres de al menos 21 años y de ascendencia india pima.
Contenido
Los conjuntos de datos constan de varias variables médicas predictoras y una variable objetivo, Outcome (si posee o no diabetes). Las variables predictoras incluyen el número de embarazos que ha tenido la paciente, su IMC, nivel de insulina, edad, etc.
Haciendo uso de los metodos Ridge, Lasso y LDA se buscará predecir cuando una paciente padecerá o no diabetes.
Modelación
Procedemos a cargar las librerias a utilizar y la base de datos usando el paquete “readr”
library(tidyverse)## Warning: package 'tidyverse' was built under R version 4.2.3## Warning: package 'ggplot2' was built under R version 4.2.3## Warning: package 'tibble' was built under R version 4.2.3## Warning: package 'tidyr' was built under R version 4.2.3## Warning: package 'readr' was built under R version 4.2.3## Warning: package 'purrr' was built under R version 4.2.3## Warning: package 'dplyr' was built under R version 4.2.3## Warning: package 'stringr' was built under R version 4.2.3## Warning: package 'forcats' was built under R version 4.2.3## Warning: package 'lubridate' was built under R version 4.2.3## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.2 ✔ readr 2.1.4
## ✔ forcats 1.0.0 ✔ stringr 1.5.0
## ✔ ggplot2 3.4.2 ✔ tibble 3.2.1
## ✔ lubridate 1.9.2 ✔ tidyr 1.3.0
## ✔ purrr 1.0.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the ]8;;http://conflicted.r-lib.org/conflicted package]8;; to force all conflicts to become errorslibrary(glmnet)## Warning: package 'glmnet' was built under R version 4.2.3## Loading required package: Matrix
##
## Attaching package: 'Matrix'
##
## The following objects are masked from 'package:tidyr':
##
## expand, pack, unpack
##
## Loaded glmnet 4.1-7library(plotly)## Warning: package 'plotly' was built under R version 4.2.3##
## Attaching package: 'plotly'
##
## The following object is masked from 'package:ggplot2':
##
## last_plot
##
## The following object is masked from 'package:stats':
##
## filter
##
## The following object is masked from 'package:graphics':
##
## layoutlibrary(MASS)##
## Attaching package: 'MASS'
##
## The following object is masked from 'package:plotly':
##
## select
##
## The following object is masked from 'package:dplyr':
##
## selectlibrary(pROC)## Warning: package 'pROC' was built under R version 4.2.3## Type 'citation("pROC")' for a citation.
##
## Attaching package: 'pROC'
##
## The following objects are masked from 'package:stats':
##
## cov, smooth, vardiabetes <- read_csv("diabetes.csv")## Rows: 768 Columns: 9
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## dbl (9): Pregnancies, Glucose, BloodPressure, SkinThickness, Insulin, BMI, D...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.Preprocesamiento de datos
Como preprocesamiento de datos dividimos los datos, caracteristícas (x), y variable objetivo (y), siendo “y”, el outcome o resultado
X <- diabetes[, -9] # Todas las columnas excepto la última
y <- diabetes %>% pull(9) # Convierte la columna 9 en un vector numérico
# Normalizar las características
X_scaled <- scale(X)División de datos
set.seed(123) # Para reproducibilidad
train_indices <- sample(1:nrow(diabetes), nrow(diabetes) * 0.7) # 70% de los datos para entrenamiento
X_train <- X_scaled[train_indices, ]
y_train <- y[train_indices]
X_test <- X_scaled[-train_indices, ]
y_test <- y[-train_indices]Se divide los datos en un conjunto de entrenamiento y un conjunto de prueba, asignando el 70% de los datos aleatoriamente seleccionados a X_train y y_train, mientras que el 30% restante se asigna a X_test y y_test. Esta división es comúnmente utilizada para evaluar el rendimiento del modelo en datos no vistos.
Entrenamiento del modelo Ridge
Ajustar el modelo Ridge con selección automática del parámetro de regularización lambda
ridge_model <- glmnet(X_train, y_train, alpha = 0) # alpha = 0 para RidgeValidación cruzada
cv_model <- cv.glmnet(X_train, y_train, alpha = 0) # Realiza validación cruzada en los datos de entrenamiento
best_lambda_ridge <- cv_model$lambda.min # Lambda que minimiza el error de validación cruzada
print(best_lambda_ridge)## [1] 0.04677006Se utilizó validación cruzada para evaluar el rendimiento del modelo Ridge para diferentes valores de lambda en los datos de entrenamiento. Luego, seleccionó el valor de lambda que minimiza el error de validación cruzada y lo asignó a best_lambda_ridge. Este valor de lambda se utilizará luego para realizar predicciones en el conjunto de prueba y evaluar el modelo Ridge.
Predicción en el conjunto de prueba con Ridge
ridge_predictions <- predict(ridge_model, newx = X_test, s = best_lambda_ridge) # Realiza predicciones en el conjunto de pruebaesta línea de código aplica el modelo Ridge ajustado a los datos de características del conjunto de prueba (X_test) utilizando el valor de lambda óptimo (best_lambda_ridge) y obtiene las predicciones correspondientes. Estas predicciones se almacenan en la variable ridge_predictions a manera de vector y se utilizarán más adelante para evaluar el rendimiento del modelo Ridge en el conjunto de prueba.
Umbral de decisión para Ridge
threshold_ridge <- 0.5
ridge_predictions_binary <- ifelse(ridge_predictions >= threshold_ridge, 1, 0)Debido a que la variable objetivo “outcome” es binaria, se establece un umbral de desición el cual si es mayor a 0,5, nos dara como resultado 1 es decir, si padece diabetes, de lo contrario 0, no padecerá diabetes
Evaluación del modelo de Ridge en el conjunto de prueba
accuracy_ridge <- sum(ridge_predictions_binary == y_test) / length(y_test)
confusion_matrix_ridge <- table(ridge_predictions_binary, y_test)Metodo Lasso
El procedimiento a seguir en Lasso es similar
Ajuste del modelo Lasso con selección automática del parámetro de regularización lambda
lasso_model <- glmnet(X_train, y_train, alpha = 1) # alpha = 1 para LassoSelección del mejor valor de lambda usando los datos de entrenamiento para Lasso
cv_model_lasso <- cv.glmnet(X_train, y_train, alpha = 1) # Realiza validación cruzada en los datos de entrenamiento para Lasso
best_lambda_lasso <- cv_model_lasso$lambda.min # Lambda que minimiza el error de validación cruzada para LassoPredicción en el conjunto de prueba con Lasso
lasso_predictions <- predict(lasso_model, newx = X_test, s = best_lambda_lasso) # Realiza predicciones en el conjunto de prueba con LassoUmbral de decisión para Lasso
threshold_lasso <- 0.5
lasso_predictions_binary <- ifelse(lasso_predictions >= threshold_lasso, 1, 0)Evaluación del modelo de Lasso en el conjunto de prueba
accuracy_lasso <- sum(lasso_predictions_binary == y_test) / length(y_test)
confusion_matrix_lasso <- table(lasso_predictions_binary, y_test)Resultados
Imprimimos los resultados tanto de ridge como de lasso, mostrando la exactitud y matriz de confusión para ambos
#Resultados de Ridge
print(paste("Exactitud:", accuracy_ridge))## [1] "Exactitud: 0.774891774891775"print(confusion_matrix_ridge)## y_test
## ridge_predictions_binary 0 1
## 0 138 40
## 1 12 41#Resultados de Lasso
print(paste("Exactitud:", accuracy_lasso))## [1] "Exactitud: 0.783549783549784"print(confusion_matrix_lasso)## y_test
## lasso_predictions_binary 0 1
## 0 138 38
## 1 12 43Comparar valor real vs predicciones
Crear un data frame con las predicciones y los valores reales para Ridge
ridge_predictions_df <- data.frame(Real = y_test, Predicciones = ridge_predictions_binary)
ridge_predictions_df <- ridge_predictions_df %>%
rename(Predicciones = s1)Predicciones modelo Ridge
print("Predicciones del modelo Ridge:")## [1] "Predicciones del modelo Ridge:"print(ridge_predictions_df)## Real Predicciones
## 1 1 1
## 2 1 1
## 3 0 0
## 4 1 1
## 5 1 1
## 6 1 0
## 7 1 0
## 8 0 0
## 9 1 1
## 10 0 0
## 11 1 1
## 12 0 0
## 13 0 1
## 14 0 0
## 15 1 1
## 16 1 1
## 17 0 0
## 18 0 0
## 19 0 0
## 20 0 0
## 21 1 0
## 22 0 0
## 23 0 0
## 24 0 0
## 25 1 0
## 26 0 0
## 27 0 0
## 28 0 0
## 29 0 0
## 30 0 0
## 31 0 0
## 32 0 0
## 33 0 0
## 34 0 0
## 35 1 1
## 36 0 0
## 37 0 0
## 38 0 0
## 39 0 0
## 40 1 0
## 41 1 1
## 42 0 0
## 43 0 0
## 44 1 0
## 45 0 0
## 46 0 0
## 47 0 0
## 48 0 1
## 49 0 0
## 50 0 0
## 51 0 0
## 52 1 0
## 53 0 0
## 54 1 1
## 55 0 0
## 56 0 0
## 57 0 0
## 58 1 1
## 59 1 0
## 60 1 1
## 61 0 1
## 62 1 0
## 63 1 0
## 64 1 1
## 65 1 0
## 66 1 1
## 67 0 0
## 68 0 0
## 69 0 0
## 70 0 0
## 71 0 0
## 72 1 0
## 73 1 0
## 74 0 0
## 75 0 1
## 76 0 0
## 77 0 0
## 78 1 1
## 79 0 0
## 80 0 0
## 81 0 0
## 82 1 1
## 83 1 0
## 84 1 1
## 85 0 0
## 86 0 1
## 87 0 0
## 88 0 0
## 89 1 1
## 90 0 0
## 91 0 0
## 92 1 1
## 93 1 1
## 94 1 0
## 95 1 1
## 96 0 0
## 97 1 0
## 98 0 1
## 99 1 0
## 100 0 0
## 101 1 1
## 102 0 0
## 103 0 1
## 104 1 1
## 105 0 0
## 106 0 0
## 107 0 0
## 108 0 0
## 109 1 1
## 110 0 0
## 111 1 1
## 112 0 0
## 113 0 0
## 114 0 0
## 115 0 0
## 116 1 0
## 117 0 0
## 118 0 0
## 119 0 0
## 120 0 0
## 121 0 0
## 122 1 0
## 123 1 0
## 124 0 0
## 125 0 0
## 126 1 0
## 127 0 0
## 128 1 1
## 129 0 0
## 130 0 0
## 131 0 0
## 132 0 0
## 133 0 0
## 134 0 0
## 135 1 1
## 136 0 0
## 137 1 0
## 138 1 0
## 139 0 0
## 140 1 0
## 141 0 1
## 142 0 0
## 143 0 0
## 144 0 0
## 145 1 1
## 146 1 1
## 147 1 0
## 148 0 0
## 149 0 0
## 150 0 0
## 151 1 0
## 152 0 0
## 153 0 1
## 154 0 0
## 155 0 0
## 156 1 0
## 157 0 0
## 158 0 1
## 159 1 1
## 160 0 0
## 161 0 0
## 162 0 0
## 163 0 0
## 164 0 0
## 165 1 0
## 166 1 0
## 167 0 0
## 168 1 0
## 169 0 0
## 170 0 0
## 171 0 1
## 172 1 0
## 173 0 0
## 174 0 0
## 175 0 0
## 176 1 0
## 177 0 0
## 178 1 1
## 179 0 0
## 180 0 0
## 181 0 0
## 182 1 1
## 183 0 0
## 184 0 0
## 185 1 1
## 186 0 0
## 187 0 0
## 188 0 1
## 189 0 0
## 190 0 0
## 191 0 0
## 192 0 0
## 193 1 0
## 194 0 0
## 195 0 0
## 196 1 0
## 197 0 0
## 198 0 0
## 199 1 0
## 200 0 0
## 201 0 0
## 202 1 1
## 203 1 1
## 204 0 0
## 205 0 0
## 206 1 1
## 207 0 0
## 208 1 0
## 209 1 1
## 210 0 0
## 211 1 1
## 212 0 0
## 213 1 1
## 214 1 1
## 215 0 0
## 216 1 0
## 217 0 0
## 218 0 0
## 219 0 0
## 220 0 0
## 221 0 0
## 222 1 0
## 223 0 0
## 224 1 0
## 225 0 0
## 226 1 0
## 227 0 0
## 228 0 0
## 229 0 0
## 230 0 0
## 231 0 0Crear un data frame con las predicciones y los valores reales para Lasso
lasso_predictions_df <- data.frame(Real = y_test, Predicciones = lasso_predictions_binary)
lasso_predictions_df <- lasso_predictions_df %>%
rename(Predicciones = s1)Predicciones modelo lasso
print(lasso_predictions_df)## Real Predicciones
## 1 1 1
## 2 1 1
## 3 0 0
## 4 1 1
## 5 1 1
## 6 1 0
## 7 1 0
## 8 0 0
## 9 1 1
## 10 0 0
## 11 1 1
## 12 0 0
## 13 0 1
## 14 0 0
## 15 1 1
## 16 1 1
## 17 0 0
## 18 0 0
## 19 0 0
## 20 0 0
## 21 1 0
## 22 0 0
## 23 0 0
## 24 0 0
## 25 1 0
## 26 0 0
## 27 0 0
## 28 0 0
## 29 0 0
## 30 0 0
## 31 0 0
## 32 0 0
## 33 0 0
## 34 0 0
## 35 1 1
## 36 0 0
## 37 0 0
## 38 0 0
## 39 0 0
## 40 1 0
## 41 1 1
## 42 0 0
## 43 0 0
## 44 1 0
## 45 0 0
## 46 0 0
## 47 0 0
## 48 0 1
## 49 0 0
## 50 0 0
## 51 0 0
## 52 1 0
## 53 0 0
## 54 1 1
## 55 0 0
## 56 0 0
## 57 0 0
## 58 1 1
## 59 1 0
## 60 1 1
## 61 0 1
## 62 1 1
## 63 1 0
## 64 1 1
## 65 1 0
## 66 1 1
## 67 0 0
## 68 0 0
## 69 0 0
## 70 0 0
## 71 0 0
## 72 1 0
## 73 1 0
## 74 0 0
## 75 0 1
## 76 0 0
## 77 0 0
## 78 1 1
## 79 0 0
## 80 0 0
## 81 0 0
## 82 1 1
## 83 1 0
## 84 1 1
## 85 0 0
## 86 0 1
## 87 0 0
## 88 0 0
## 89 1 1
## 90 0 0
## 91 0 0
## 92 1 1
## 93 1 1
## 94 1 0
## 95 1 1
## 96 0 0
## 97 1 0
## 98 0 1
## 99 1 0
## 100 0 0
## 101 1 1
## 102 0 0
## 103 0 1
## 104 1 1
## 105 0 0
## 106 0 0
## 107 0 0
## 108 0 0
## 109 1 1
## 110 0 0
## 111 1 1
## 112 0 0
## 113 0 0
## 114 0 0
## 115 0 0
## 116 1 0
## 117 0 0
## 118 0 0
## 119 0 0
## 120 0 0
## 121 0 0
## 122 1 0
## 123 1 0
## 124 0 0
## 125 0 0
## 126 1 0
## 127 0 0
## 128 1 1
## 129 0 0
## 130 0 0
## 131 0 0
## 132 0 0
## 133 0 0
## 134 0 0
## 135 1 1
## 136 0 0
## 137 1 0
## 138 1 0
## 139 0 0
## 140 1 1
## 141 0 1
## 142 0 0
## 143 0 0
## 144 0 0
## 145 1 1
## 146 1 1
## 147 1 0
## 148 0 0
## 149 0 0
## 150 0 0
## 151 1 0
## 152 0 0
## 153 0 1
## 154 0 0
## 155 0 0
## 156 1 0
## 157 0 0
## 158 0 1
## 159 1 1
## 160 0 0
## 161 0 0
## 162 0 0
## 163 0 0
## 164 0 0
## 165 1 0
## 166 1 0
## 167 0 0
## 168 1 0
## 169 0 0
## 170 0 0
## 171 0 1
## 172 1 0
## 173 0 0
## 174 0 0
## 175 0 0
## 176 1 0
## 177 0 0
## 178 1 1
## 179 0 0
## 180 0 0
## 181 0 0
## 182 1 1
## 183 0 0
## 184 0 0
## 185 1 1
## 186 0 0
## 187 0 0
## 188 0 1
## 189 0 0
## 190 0 0
## 191 0 0
## 192 0 0
## 193 1 0
## 194 0 0
## 195 0 0
## 196 1 0
## 197 0 0
## 198 0 0
## 199 1 0
## 200 0 0
## 201 0 0
## 202 1 1
## 203 1 1
## 204 0 0
## 205 0 0
## 206 1 1
## 207 0 0
## 208 1 0
## 209 1 1
## 210 0 0
## 211 1 1
## 212 0 0
## 213 1 1
## 214 1 1
## 215 0 0
## 216 1 0
## 217 0 0
## 218 0 0
## 219 0 0
## 220 0 0
## 221 0 0
## 222 1 0
## 223 0 0
## 224 1 0
## 225 0 0
## 226 1 0
## 227 0 0
## 228 0 0
## 229 0 0
## 230 0 0
## 231 0 0Comparar graficamente la exactitud de lasso vs ridge
crear un dataframe accuracy_df que contiene dos columnas: “Modelo” y “Exactitud”. La columna “Modelo” tiene los valores “Lasso” y “Ridge”, y la columna “Exactitud” tiene los valores de exactitud correspondientes a los modelos Lasso y Ridge. Este dataframe se utilizará luego para crear un gráfico de comparación de la exactitud entre los dos modelos.
accuracy_df <- data.frame(Modelo = c("Lasso", "Ridge"),
Exactitud = c(accuracy_lasso, accuracy_ridge))Crear el gráfico de comparación de exactitud
plot1<-ggplot(accuracy_df, aes(x = Modelo, y = Exactitud)) +
geom_bar(stat = "identity", fill = "red", alpha = 0.8) +
labs(title = "Comparación de Exactitud Lasso vs Ridge",
x = "Modelo",
y = "Exactitud") +
theme_minimal()
plot1
Graficar matrices de confusión
Procedemos a graficar las matrices de consufión para Ridge y Lasso
Ridge
plot3 <- plot_ly(z = confusion_matrix_ridge, type = "heatmap") %>%
layout(title = "Matriz de Confusión - Ridge",
xaxis = list(title = "Valor Real"),
yaxis = list(title = "Valor Predicho"))
plot3Lasso
#Matriz de confusion Lasso
plot2<-plot_ly(z=confusion_matrix_lasso,type = "heatmap") %>%
layout(title="Matriz de confusión - Lasso",
xaxis=list(title="valor Real"),
yaxis=list(title="valor Predicho"))
plot2Analisis lineal discriminante (LDA)
Ya habiendo hecho uso de metodos de regresión como ridge y lasso, haremos uso de LDA, método de clasificación que se utiliza cuando se desea clasificar observaciones en diferentes categorías para luego realizar la comparativa de exactitud con respecto a los otros dos metodos.
Entrenamiento deL modelo LDA
lda_model <- lda(X_train, y_train)Predicción en el conjunto de prueba con LDA
lda_predictions <- predict(lda_model, newdata = X_test)$class
print(lda_predictions)## [1] 1 1 0 1 1 0 0 0 1 0 1 0 1 0 1 1 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0
## [38] 0 0 1 1 0 0 0 0 0 0 1 0 0 0 0 0 1 0 0 0 1 0 1 1 1 0 1 0 1 0 0 0 0 0 0 0 0
## [75] 1 0 0 1 0 0 0 1 0 1 1 1 0 0 1 0 0 1 1 0 1 0 0 1 0 0 1 0 1 1 0 0 0 0 1 0 1
## [112] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 1 0 0 0 0 1 1 0 0 0 1 1 0 0
## [149] 0 0 0 0 1 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 1 0 0 0 1 0 0 1
## [186] 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 1 0 0 1 0 1 0 1 1 0 0 0 0 0 0 0 0
## [223] 0 0 0 0 0 0 0 0 0
## Levels: 0 1Evaluación del modelo LDA en el conjunto de prueba
accuracy_lda <- sum(lda_predictions == y_test) / length(y_test)
confusion_matrix_lda <- table(lda_predictions, y_test)Crear un dataframe para comprar valores reales con valores predichos
lda_predictions_df <- data.frame(Real = y_test, Predicciones = lda_predictions)
print(lda_predictions_df)## Real Predicciones
## 1 1 1
## 2 1 1
## 3 0 0
## 4 1 1
## 5 1 1
## 6 1 0
## 7 1 0
## 8 0 0
## 9 1 1
## 10 0 0
## 11 1 1
## 12 0 0
## 13 0 1
## 14 0 0
## 15 1 1
## 16 1 1
## 17 0 0
## 18 0 0
## 19 0 0
## 20 0 0
## 21 1 1
## 22 0 0
## 23 0 0
## 24 0 0
## 25 1 0
## 26 0 0
## 27 0 0
## 28 0 0
## 29 0 0
## 30 0 0
## 31 0 0
## 32 0 0
## 33 0 0
## 34 0 0
## 35 1 1
## 36 0 0
## 37 0 0
## 38 0 0
## 39 0 0
## 40 1 1
## 41 1 1
## 42 0 0
## 43 0 0
## 44 1 0
## 45 0 0
## 46 0 0
## 47 0 0
## 48 0 1
## 49 0 0
## 50 0 0
## 51 0 0
## 52 1 0
## 53 0 0
## 54 1 1
## 55 0 0
## 56 0 0
## 57 0 0
## 58 1 1
## 59 1 0
## 60 1 1
## 61 0 1
## 62 1 1
## 63 1 0
## 64 1 1
## 65 1 0
## 66 1 1
## 67 0 0
## 68 0 0
## 69 0 0
## 70 0 0
## 71 0 0
## 72 1 0
## 73 1 0
## 74 0 0
## 75 0 1
## 76 0 0
## 77 0 0
## 78 1 1
## 79 0 0
## 80 0 0
## 81 0 0
## 82 1 1
## 83 1 0
## 84 1 1
## 85 0 1
## 86 0 1
## 87 0 0
## 88 0 0
## 89 1 1
## 90 0 0
## 91 0 0
## 92 1 1
## 93 1 1
## 94 1 0
## 95 1 1
## 96 0 0
## 97 1 0
## 98 0 1
## 99 1 0
## 100 0 0
## 101 1 1
## 102 0 0
## 103 0 1
## 104 1 1
## 105 0 0
## 106 0 0
## 107 0 0
## 108 0 0
## 109 1 1
## 110 0 0
## 111 1 1
## 112 0 0
## 113 0 0
## 114 0 0
## 115 0 0
## 116 1 0
## 117 0 0
## 118 0 0
## 119 0 0
## 120 0 0
## 121 0 0
## 122 1 0
## 123 1 0
## 124 0 0
## 125 0 0
## 126 1 0
## 127 0 0
## 128 1 1
## 129 0 0
## 130 0 0
## 131 0 0
## 132 0 0
## 133 0 0
## 134 0 0
## 135 1 1
## 136 0 0
## 137 1 0
## 138 1 0
## 139 0 0
## 140 1 1
## 141 0 1
## 142 0 0
## 143 0 0
## 144 0 0
## 145 1 1
## 146 1 1
## 147 1 0
## 148 0 0
## 149 0 0
## 150 0 0
## 151 1 0
## 152 0 0
## 153 0 1
## 154 0 0
## 155 0 0
## 156 1 0
## 157 0 0
## 158 0 1
## 159 1 1
## 160 0 0
## 161 0 0
## 162 0 0
## 163 0 0
## 164 0 0
## 165 1 0
## 166 1 0
## 167 0 0
## 168 1 0
## 169 0 0
## 170 0 0
## 171 0 1
## 172 1 0
## 173 0 0
## 174 0 0
## 175 0 0
## 176 1 0
## 177 0 0
## 178 1 1
## 179 0 0
## 180 0 0
## 181 0 0
## 182 1 1
## 183 0 0
## 184 0 0
## 185 1 1
## 186 0 0
## 187 0 0
## 188 0 1
## 189 0 0
## 190 0 0
## 191 0 0
## 192 0 0
## 193 1 0
## 194 0 0
## 195 0 0
## 196 1 0
## 197 0 0
## 198 0 0
## 199 1 0
## 200 0 0
## 201 0 0
## 202 1 1
## 203 1 1
## 204 0 0
## 205 0 0
## 206 1 1
## 207 0 0
## 208 1 0
## 209 1 1
## 210 0 0
## 211 1 1
## 212 0 0
## 213 1 1
## 214 1 1
## 215 0 0
## 216 1 0
## 217 0 0
## 218 0 0
## 219 0 0
## 220 0 0
## 221 0 0
## 222 1 0
## 223 0 0
## 224 1 0
## 225 0 0
## 226 1 0
## 227 0 0
## 228 0 0
## 229 0 0
## 230 0 0
## 231 0 0Matriz de confunsión Modelo LDA
plot4 <- plot_ly(z = confusion_matrix_lda, type = "heatmap") %>%
layout(title = "Matriz de Confusión - LDA",
xaxis = list(title = "Valor Real"),
yaxis = list(title = "Valor Predicho"))
plot4Comparativa vs Ridge vs Lasso
Al gráfico de barras realizado anteriormente, agregamos la exactitud del modelo LDA, creando primero el dataframe y posteriormente graficando
accuracy_df2 <- data.frame(Modelo = c("Lasso", "Ridge","LDA"),
Exactitud = c(accuracy_lasso, accuracy_ridge,accuracy_lda))
plot1 <- ggplot(accuracy_df2, aes(x = Modelo, y = Exactitud, fill = Modelo)) +
geom_bar(stat = "identity", alpha = 0.7) +
labs(title = "Comparación de Exactitud Lasso vs LDA vs Ridge",
x = "Modelo",
y = "Exactitud") +
scale_fill_manual(values = c("Lasso" = "red", "LDA" = "blue", "Ridge" = "green")) +
theme_minimal()
plot1
print(accuracy_df2)## Modelo Exactitud
## 1 Lasso 0.7835498
## 2 Ridge 0.7748918
## 3 LDA 0.7878788A su vez, se imprimieron los valores de exactitud.
Curva ROC y AUC
Como sabemos la curva ROC y el AUC permiten evaluar y comparar la capacidad predictiva de diferentes modelos de clasificación, siendo el AUC una medida resumida de la calidad del modelo que considera todos los posibles umbrales de clasificación. Por lo tanto, procederemos a hallarlos para los 3 metodos
ROC Y AUC para Ridge
Calcular las probabilidades predichas por el modelo Ridge
ridge_probabilities <- predict(ridge_model, newx = X_test, s = best_lambda_ridge, type = "response")Calcular la curva ROC y el área bajo la curva (AUC)
roc_ridge <- roc(as.numeric(y_test), as.numeric(ridge_probabilities))## Setting levels: control = 0, case = 1## Setting direction: controls < casesauc_ridge <- auc(roc_ridge)Graficar la curva ROC y AUC
rocridge_graf<-plot(roc_ridge, main = "Curva ROC - Ridge"); lines(x = c(0, 1), y = c(0, 1), lty = 2); legend("bottomright", legend = paste("AUC =", round(auc_ridge, 2)), bty = "n")
rocridge_graf##
## Call:
## roc.default(response = as.numeric(y_test), predictor = as.numeric(ridge_probabilities))
##
## Data: as.numeric(ridge_probabilities) in 150 controls (as.numeric(y_test) 0) < 81 cases (as.numeric(y_test) 1).
## Area under the curve: 0.844ROC Y AUC para Lasso
Calcular las probabilidades predichas por el modelo Lasso
lasso_probabilities <- predict(lasso_model, newx = X_test, s = best_lambda_lasso, type = "response")Calcular la curva ROC y el área bajo la curva (AUC)
roc_lasso <- roc(as.numeric(y_test), as.numeric(lasso_probabilities))## Setting levels: control = 0, case = 1## Setting direction: controls < casesauc_lasso <- auc(roc_lasso)Graficar la curva ROC
roclasso_graf<-plot(roc_lasso, main = "Curva ROC - Lasso"); lines(x = c(1, 0), y = c(1, 0), lty = 2); legend("bottomright", legend = paste("AUC =", round(auc_lasso, 2)), bty = "n")
roclasso_graf##
## Call:
## roc.default(response = as.numeric(y_test), predictor = as.numeric(lasso_probabilities))
##
## Data: as.numeric(lasso_probabilities) in 150 controls (as.numeric(y_test) 0) < 81 cases (as.numeric(y_test) 1).
## Area under the curve: 0.843ROC Y AUC para LDA
Calcular las probabilidades predichas por el modelo LDA
lda_probabilities <- predict(lda_model, newdata = X_test)$posterior[, "1"]Calcular la curva ROC y el área bajo la curva (AUC)
roc_lda <- roc(as.numeric(y_test), lda_probabilities)## Setting levels: control = 0, case = 1## Setting direction: controls < casesauc_lda <- auc(roc_lda)Graficar la curva ROC
roclda_graf<-plot(roc_lda, main = "Curva ROC - LDA"); lines(x = c(1, 0), y = c(1, 0), lty = 2); legend("bottomright", legend = paste("AUC =", round(auc_lda, 2)), bty = "n")
roclda_graf##
## Call:
## roc.default(response = as.numeric(y_test), predictor = lda_probabilities)
##
## Data: lda_probabilities in 150 controls (as.numeric(y_test) 0) < 81 cases (as.numeric(y_test) 1).
## Area under the curve: 0.8435Gráfico interactivo combinado
Crear un dataframe con los valores de las curvas ROC y los nombres de los modelos
roc_data <- data.frame(
Modelo = c(rep("LDA", length(roc_lda$sens)), rep("Ridge", length(roc_ridge$sens)), rep("Lasso", length(roc_lasso$sens))),
TasaFalsosPositivos = c(roc_lda$spec, roc_ridge$spec, roc_lasso$spec),
TasaVerdaderosPositivos = c(roc_lda$sens, roc_ridge$sens, roc_lasso$sens)
)Crear el gráfico de curvas ROC
ggplot_graf <- ggplot(roc_data, aes(x = TasaFalsosPositivos, y = TasaVerdaderosPositivos, color = Modelo)) +
geom_line() +
geom_abline(intercept = 0, slope = 1, linetype = "dashed") +
labs(title = "Comparativa Curvas ROC",
x = "Tasa de falsos positivos",
y = "Tasa de verdaderos positivos") +
scale_color_manual(values = c("LDA" = "red", "Ridge" = "blue", "Lasso" = "green")) +
theme_minimal()
plotly_graf <- ggplotly(ggplot_graf)
plotly_grafConclusiones finales
Teniendo en cuenta todos los resultados obtenidos podemos decir que los 3 metodos poseen una gran capacidad predictoria para el conjunto de datos a estudiado, obteniendo resultados similares en cada uno de los 3 metodos, siendo LDA aquel que tuvo una mayor exactitud respecto a los otros dos modelos, a su vez también se considera este como el mejor metodo a usar debido a que se usa cuando se busca establecer unas clases a partir de un resultado, siendo usado comunmente por esto en problemas de clasificación, permitiendonos en este caso, establecer de mejor manera las clases para nuestra variable objetivo la cual era predecir si padece o no diabetes una paciente, siendo 1 que si, y 0 que no.