pacman::p_load(tidyverse, tidymodels, GGally, ISLR, ggvis, boot, yardstick, mlbench)
theme_set(theme_minimal())Evaluación intermedia
Carga de Librerías
Datos
data(PimaIndiansDiabetes)
datos <- PimaIndiansDiabetesAnálisis Exploratorio de Datos
summary(datos) pregnant glucose pressure triceps
Min. : 0.000 Min. : 0.0 Min. : 0.00 Min. : 0.00
1st Qu.: 1.000 1st Qu.: 99.0 1st Qu.: 62.00 1st Qu.: 0.00
Median : 3.000 Median :117.0 Median : 72.00 Median :23.00
Mean : 3.845 Mean :120.9 Mean : 69.11 Mean :20.54
3rd Qu.: 6.000 3rd Qu.:140.2 3rd Qu.: 80.00 3rd Qu.:32.00
Max. :17.000 Max. :199.0 Max. :122.00 Max. :99.00
insulin mass pedigree age diabetes
Min. : 0.0 Min. : 0.00 Min. :0.0780 Min. :21.00 neg:500
1st Qu.: 0.0 1st Qu.:27.30 1st Qu.:0.2437 1st Qu.:24.00 pos:268
Median : 30.5 Median :32.00 Median :0.3725 Median :29.00
Mean : 79.8 Mean :31.99 Mean :0.4719 Mean :33.24
3rd Qu.:127.2 3rd Qu.:36.60 3rd Qu.:0.6262 3rd Qu.:41.00
Max. :846.0 Max. :67.10 Max. :2.4200 Max. :81.00 ggpairs(datos, columns = c(2, 6, 7,8))
El análisis gráfico en un primer momento muestra que las variables glucosa y masa se distribuyen de forma normal, mientras que las variables de genealogía y edad presentan un sesgo a la derecha, por lo que se considera importante normaliazar los predictores del modelo a formularse.
Análisis usando función base de R (glm)
modelo_logit <- glm(diabetes ~ glucose + mass+ pedigree + age , family = "binomial", data = datos)
summary(modelo_logit)
Call:
glm(formula = diabetes ~ glucose + mass + pedigree + age, family = "binomial",
data = datos)
Deviance Residuals:
Min 1Q Median 3Q Max
-2.6358 -0.7421 -0.4378 0.7551 2.8432
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) -8.654488 0.681804 -12.694 < 2e-16 ***
glucose 0.032183 0.003361 9.575 < 2e-16 ***
mass 0.078652 0.013537 5.810 6.25e-09 ***
pedigree 0.829960 0.289284 2.869 0.00412 **
age 0.030228 0.007667 3.942 8.07e-05 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
(Dispersion parameter for binomial family taken to be 1)
Null deviance: 993.48 on 767 degrees of freedom
Residual deviance: 747.23 on 763 degrees of freedom
AIC: 757.23
Number of Fisher Scoring iterations: 5anova(modelo_logit, test = "Chisq")Analysis of Deviance Table
Model: binomial, link: logit
Response: diabetes
Terms added sequentially (first to last)
Df Deviance Resid. Df Resid. Dev Pr(>Chi)
NULL 767 993.48
glucose 1 184.764 766 808.72 < 2.2e-16 ***
mass 1 37.317 765 771.40 1.004e-09 ***
pedigree 1 8.532 764 762.87 0.003489 **
age 1 15.637 763 747.23 7.673e-05 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1El modelo logit muestra que la variable que más incide en la probabilidad de que una persona tenga diabetes es la genética (pedigree) o prexistencia de esta enfermedad en parientes y familiares: El cambio en una unidad en la Diabetes pedigree function, incrementa en 0,83 puntos la probabilidad de tener diabetes. Esta variable es significativa dentro del modelo a un 95% de nivel de significancia.
Por otro lado, un incremento de una unidad en la glucosa, incremente un 3% la probabilidad de tener diabetes. Asimismo, el incremento de una unidad en el ínide de masa corporal ((peso/altura) al cuadrado), incrementa en 8% la probabilidad de presentar diabetes.
Finalmente, por cada año que transcurre, la probabilidad de tener diabetes incrementa en 3%.
Estos resultados parciales deben ser aplicados a un conjunto de datos de testeo para estimar resultados definitivos. Este proceso se hará a continuación.
Particionamiento
set.seed(1234)
conf_particionam <- initial_split(datos, prop = 0.8)
diabetes_training <- training(conf_particionam)
diabetes_testing <- testing(conf_particionam)Creación de receta
receta <- recipe(diabetes ~ glucose + mass+ pedigree + age , family = "binomial", data = datos) %>%
step_normalize(all_numeric_predictors()) %>%
prep()
# recetaCreación de receta
#```{r} #| label: receta #receta <- recipe(diabetes ~ glucose + mass+ pedigree + age , family = “binomial”, data = #datos) %>% # prep()
receta
#```
Aplicación de receta
diabetes_train_juice <- receta %>%
juice()
glimpse(diabetes_train_juice)Rows: 768
Columns: 5
$ glucose <dbl> 0.84777132, -1.12266474, 1.94245802, -0.99755769, 0.50372693,~
$ mass <dbl> 0.2038799, -0.6839762, -1.1025370, -0.4937213, 1.4088275, -0.~
$ pedigree <dbl> 0.46818687, -0.36482303, 0.60400370, -0.92016296, 5.48133703,~
$ age <dbl> 1.42506672, -0.19054773, -0.10551539, -1.04087112, -0.0204830~
$ diabetes <fct> pos, neg, pos, neg, pos, neg, pos, neg, pos, pos, neg, pos, n~diabetes_test_bake <- receta %>%
bake(diabetes_testing)
glimpse(diabetes_test_bake)Rows: 154
Columns: 5
$ glucose <dbl> 0.50372693, -0.15308509, -1.34160209, 2.38033270, 0.12840577,~
$ mass <dbl> 1.4088275002, -0.8108128025, -0.1258952234, -0.1893135178, -0~
$ pedigree <dbl> 5.48133703, -0.81754580, -0.67569267, -0.94732633, -0.8054732~
$ age <dbl> -0.02048305, -0.27558007, -0.61570943, 1.68016374, 0.65977566~
$ diabetes <fct> pos, neg, pos, pos, pos, pos, neg, pos, pos, neg, neg, neg, p~Especificación genérica del modelo
modelo_logistico <- logistic_reg() %>%
set_engine("glm") %>%
set_mode("classification")
translate(modelo_logistico)Logistic Regression Model Specification (classification)
Computational engine: glm
Model fit template:
stats::glm(formula = missing_arg(), data = missing_arg(), weights = missing_arg(),
family = stats::binomial)Entrenamiento del modelo
ml_ajuste <- modelo_logistico %>% fit(diabetes ~ glucose + mass+ pedigree + age, family= "binomial", data = diabetes_train_juice)
ml_ajuste %>%
pluck("fit") %>%
summary()
Call:
stats::glm(formula = diabetes ~ glucose + mass + pedigree + age,
family = stats::binomial, data = data)
Deviance Residuals:
Min 1Q Median 3Q Max
-2.6358 -0.7421 -0.4378 0.7551 2.8432
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) -0.85095 0.09479 -8.978 < 2e-16 ***
glucose 1.02899 0.10746 9.575 < 2e-16 ***
mass 0.62011 0.10673 5.810 6.25e-09 ***
pedigree 0.27499 0.09585 2.869 0.00412 **
age 0.35548 0.09017 3.942 8.07e-05 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
(Dispersion parameter for binomial family taken to be 1)
Null deviance: 993.48 on 767 degrees of freedom
Residual deviance: 747.23 on 763 degrees of freedom
AIC: 757.23
Number of Fisher Scoring iterations: 5Una vez obtenidos nuevos coeficientes, estos se aplicarán a los datos de testeo para contraster el valor inferido con el valor observado de diabeltes (positivo o negativo)
Aplicación del modelo a los datos de testeo
ml_predicc <- ml_ajuste %>%
predict(diabetes_test_bake) %>%
bind_cols(diabetes_test_bake)
ml_predicc_augment <- augment(ml_ajuste, diabetes_test_bake)
ml_predicc_augment# A tibble: 154 x 8
glucose mass pedigree age diabetes .pred_class .pred_neg .pred_pos
<dbl> <dbl> <dbl> <dbl> <fct> <fct> <dbl> <dbl>
1 0.504 1.41 5.48 -0.0205 pos pos 0.115 0.885
2 -0.153 -0.811 -0.818 -0.276 neg neg 0.862 0.138
3 -1.34 -0.126 -0.676 -0.616 pos neg 0.938 0.0621
4 2.38 -0.189 -0.947 1.68 pos pos 0.140 0.860
5 0.128 -0.113 -0.805 0.660 pos neg 0.685 0.315
6 0.816 0.940 -0.649 0.830 pos pos 0.334 0.666
7 0.535 0.153 -0.157 0.150 neg neg 0.549 0.451
8 1.57 1.70 0.752 1.77 pos pos 0.0660 0.934
9 1.85 1.27 4.29 -0.701 pos pos 0.0590 0.941
10 0.785 -0.291 0.278 -0.361 neg neg 0.568 0.432
# i 144 more rowsEvaluación del modelo
ml_predicc_augment %>%
conf_mat(truth = diabetes, estimate = .pred_class) %>%
autoplot(type="heatmap")
ml_predicc_augment %>%
accuracy(truth = diabetes, estimate= .pred_class)# A tibble: 1 x 3
.metric .estimator .estimate
<chr> <chr> <dbl>
1 accuracy binary 0.773El modelo bajo el planteamiento realizado ha sido capaz de estimar adecuadamente el 77% de los datos observados, una vez que ha sido entrenado y ajustado. Así, de un total de 92 casos negativos de diabetes, se estimaron adecuadamente 84 casos y de un total de 62 casos de positivos de diabetes se estimaron correctamente 62 casos.
ml_predicc_augment %>%
f_meas(truth = diabetes, estimate= .pred_class)# A tibble: 1 x 3
.metric .estimator .estimate
<chr> <chr> <dbl>
1 f_meas binary 0.828multi_metricas <- metric_set(accuracy, f_meas, kap)
ml_predicc_augment %>%
multi_metricas(truth = diabetes, estimate= .pred_class)# A tibble: 3 x 3
.metric .estimator .estimate
<chr> <chr> <dbl>
1 accuracy binary 0.773
2 f_meas binary 0.828
3 kap binary 0.503ml_predicc_augment %>%
roc_curve(truth = diabetes, .pred_neg) %>%
autoplot()
El gráfico anterior muestra el área bajo la curva. Entre más se acerca al área superior izquierda, el modelo tiene mejor ajuste. En consecuencia, si se asume que el uso de este modelo es para efectos de “prevención”, se considera adecuado para trabajar en los factores que inciden en mayor medida en la probabilidad de presentar diabetes.
Referencias Bibliográficas
Buzai, G. D., & Baxendale, C. A. (2009). Análisis exploratorio de datos espaciales. Geografı́a y Sistemas de Información Geográfica, N° 1,(2009).
Deaz, P. K. M., Oliveros, E. I. G., & Arias, Y. A. J. (2019). ANÁLISIS EXPLORATORIO DE DATOS a UNA BASE DE DATOS DE LA BIBLIOTECA DE LA UNIVERSIDAD DE LA SALLE. Encuentro Internacional de Educación En Ingenierı́a.