En primer lugar, cargamos la base de datos
framingham <- read.csv("framingham.csv")Estudiamos las características de la base de datos
names(framingham)## [1] "male" "age" "education" "currentSmoker"
## [5] "cigsPerDay" "BPMeds" "prevalentStroke" "prevalentHyp"
## [9] "diabetes" "totChol" "sysBP" "diaBP"
## [13] "BMI" "heartRate" "glucose" "TenYearCHD"
dim(framingham)## [1] 4238 16
summary(framingham)## male age education currentSmoker
## Min. :0.0000 Min. :32.00 Min. :1.000 Min. :0.0000
## 1st Qu.:0.0000 1st Qu.:42.00 1st Qu.:1.000 1st Qu.:0.0000
## Median :0.0000 Median :49.00 Median :2.000 Median :0.0000
## Mean :0.4292 Mean :49.58 Mean :1.979 Mean :0.4941
## 3rd Qu.:1.0000 3rd Qu.:56.00 3rd Qu.:3.000 3rd Qu.:1.0000
## Max. :1.0000 Max. :70.00 Max. :4.000 Max. :1.0000
## NA's :105
## cigsPerDay BPMeds prevalentStroke prevalentHyp
## Min. : 0.000 Min. :0.00000 Min. :0.000000 Min. :0.0000
## 1st Qu.: 0.000 1st Qu.:0.00000 1st Qu.:0.000000 1st Qu.:0.0000
## Median : 0.000 Median :0.00000 Median :0.000000 Median :0.0000
## Mean : 9.003 Mean :0.02963 Mean :0.005899 Mean :0.3105
## 3rd Qu.:20.000 3rd Qu.:0.00000 3rd Qu.:0.000000 3rd Qu.:1.0000
## Max. :70.000 Max. :1.00000 Max. :1.000000 Max. :1.0000
## NA's :29 NA's :53
## diabetes totChol sysBP diaBP
## Min. :0.00000 Min. :107.0 Min. : 83.5 Min. : 48.00
## 1st Qu.:0.00000 1st Qu.:206.0 1st Qu.:117.0 1st Qu.: 75.00
## Median :0.00000 Median :234.0 Median :128.0 Median : 82.00
## Mean :0.02572 Mean :236.7 Mean :132.4 Mean : 82.89
## 3rd Qu.:0.00000 3rd Qu.:263.0 3rd Qu.:144.0 3rd Qu.: 89.88
## Max. :1.00000 Max. :696.0 Max. :295.0 Max. :142.50
## NA's :50
## BMI heartRate glucose TenYearCHD
## Min. :15.54 Min. : 44.00 Min. : 40.00 Min. :0.000
## 1st Qu.:23.07 1st Qu.: 68.00 1st Qu.: 71.00 1st Qu.:0.000
## Median :25.40 Median : 75.00 Median : 78.00 Median :0.000
## Mean :25.80 Mean : 75.88 Mean : 81.97 Mean :0.152
## 3rd Qu.:28.04 3rd Qu.: 83.00 3rd Qu.: 87.00 3rd Qu.:0.000
## Max. :56.80 Max. :143.00 Max. :394.00 Max. :1.000
## NA's :19 NA's :1 NA's :388
Una primera observación de la base de datos nos muestra que existen varios casos con errores (na), por lo que depuramos la base de datos omitiendolo los casos que muestran dichos errores.
framingham2 <- na.omit(framingham)Volvemos a estudiar las características de la nueva base de datos
names(framingham2)## [1] "male" "age" "education" "currentSmoker"
## [5] "cigsPerDay" "BPMeds" "prevalentStroke" "prevalentHyp"
## [9] "diabetes" "totChol" "sysBP" "diaBP"
## [13] "BMI" "heartRate" "glucose" "TenYearCHD"
dim(framingham2)## [1] 3656 16
summary(framingham2)## male age education currentSmoker
## Min. :0.0000 Min. :32.00 Min. :1.00 Min. :0.0000
## 1st Qu.:0.0000 1st Qu.:42.00 1st Qu.:1.00 1st Qu.:0.0000
## Median :0.0000 Median :49.00 Median :2.00 Median :0.0000
## Mean :0.4437 Mean :49.56 Mean :1.98 Mean :0.4891
## 3rd Qu.:1.0000 3rd Qu.:56.00 3rd Qu.:3.00 3rd Qu.:1.0000
## Max. :1.0000 Max. :70.00 Max. :4.00 Max. :1.0000
## cigsPerDay BPMeds prevalentStroke prevalentHyp
## Min. : 0.000 Min. :0.00000 Min. :0.000000 Min. :0.0000
## 1st Qu.: 0.000 1st Qu.:0.00000 1st Qu.:0.000000 1st Qu.:0.0000
## Median : 0.000 Median :0.00000 Median :0.000000 Median :0.0000
## Mean : 9.022 Mean :0.03036 Mean :0.005744 Mean :0.3115
## 3rd Qu.:20.000 3rd Qu.:0.00000 3rd Qu.:0.000000 3rd Qu.:1.0000
## Max. :70.000 Max. :1.00000 Max. :1.000000 Max. :1.0000
## diabetes totChol sysBP diaBP
## Min. :0.00000 Min. :113.0 Min. : 83.5 Min. : 48.00
## 1st Qu.:0.00000 1st Qu.:206.0 1st Qu.:117.0 1st Qu.: 75.00
## Median :0.00000 Median :234.0 Median :128.0 Median : 82.00
## Mean :0.02708 Mean :236.9 Mean :132.4 Mean : 82.91
## 3rd Qu.:0.00000 3rd Qu.:263.2 3rd Qu.:144.0 3rd Qu.: 90.00
## Max. :1.00000 Max. :600.0 Max. :295.0 Max. :142.50
## BMI heartRate glucose TenYearCHD
## Min. :15.54 Min. : 44.00 Min. : 40.00 Min. :0.0000
## 1st Qu.:23.08 1st Qu.: 68.00 1st Qu.: 71.00 1st Qu.:0.0000
## Median :25.38 Median : 75.00 Median : 78.00 Median :0.0000
## Mean :25.78 Mean : 75.73 Mean : 81.86 Mean :0.1524
## 3rd Qu.:28.04 3rd Qu.: 82.00 3rd Qu.: 87.00 3rd Qu.:0.0000
## Max. :56.80 Max. :143.00 Max. :394.00 Max. :1.0000
A continuación se convierte la variable male en factor ( Female y Male)
framingham2$male <- as.factor(framingham2$male)
framingham2$male <- factor(framingham2$male, labels = c("Female", "Male"))Ahora separaramos la base de datos en dos: entrenamiento (80% de los datos) y validación (20% restante de los datos)
entrenamiento <- framingham2 [-c(2926:3656),]
validación <- framingham2 [c(2926:3656),]Realizamos el modelo de regresión logística con la base de datos de entrenamiento
modelo_logísitca <- glm(male ~ . , data = entrenamiento, family = "binomial")
summary(modelo_logísitca)##
## Call:
## glm(formula = male ~ ., family = "binomial", data = entrenamiento)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.5240 -0.9226 -0.6149 1.0548 2.7254
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.698749 0.595355 -1.174 0.24053
## age 0.017779 0.005707 3.115 0.00184 **
## education 0.039149 0.041620 0.941 0.34689
## currentSmoker -0.576315 0.146409 -3.936 8.27e-05 ***
## cigsPerDay 0.094819 0.007087 13.379 < 2e-16 ***
## BPMeds -0.682622 0.275895 -2.474 0.01335 *
## prevalentStroke 0.263359 0.592093 0.445 0.65647
## prevalentHyp 0.197799 0.129994 1.522 0.12811
## diabetes 0.189268 0.332420 0.569 0.56911
## totChol -0.003560 0.001000 -3.560 0.00037 ***
## sysBP -0.028586 0.003883 -7.362 1.81e-13 ***
## diaBP 0.045976 0.006324 7.270 3.60e-13 ***
## BMI 0.061860 0.011568 5.348 8.91e-08 ***
## heartRate -0.030004 0.003765 -7.969 1.60e-15 ***
## glucose 0.003763 0.002340 1.608 0.10776
## TenYearCHD 0.366598 0.121633 3.014 0.00258 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 4013.2 on 2924 degrees of freedom
## Residual deviance: 3417.0 on 2909 degrees of freedom
## AIC: 3449
##
## Number of Fisher Scoring iterations: 4
Al igual que en el tema anterior, usaremos la técnia Backward Selection para eliminar variables que no son significativas para el modelo que buscamos. En primer lugar, eliminamos la variabe prevalentStroke
entrenamiento_2 <- entrenamiento [,-7]
modelo_logísitca_2 <- glm(male ~ . , data = entrenamiento_2, family = "binomial")
summary(modelo_logísitca_2)##
## Call:
## glm(formula = male ~ ., family = "binomial", data = entrenamiento_2)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.5241 -0.9214 -0.6148 1.0549 2.7248
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.7022256 0.5952981 -1.180 0.238151
## age 0.0178142 0.0057058 3.122 0.001795 **
## education 0.0386234 0.0416014 0.928 0.353191
## currentSmoker -0.5765704 0.1463940 -3.938 8.20e-05 ***
## cigsPerDay 0.0948055 0.0070870 13.377 < 2e-16 ***
## BPMeds -0.6784193 0.2758008 -2.460 0.013901 *
## prevalentHyp 0.1980728 0.1299803 1.524 0.127542
## diabetes 0.1904867 0.3323468 0.573 0.566539
## totChol -0.0035574 0.0009999 -3.558 0.000374 ***
## sysBP -0.0285818 0.0038815 -7.364 1.79e-13 ***
## diaBP 0.0460325 0.0063222 7.281 3.31e-13 ***
## BMI 0.0617312 0.0115631 5.339 9.36e-08 ***
## heartRate -0.0300028 0.0037646 -7.970 1.59e-15 ***
## glucose 0.0037772 0.0023397 1.614 0.106440
## TenYearCHD 0.3683831 0.1215551 3.031 0.002441 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 4013.2 on 2924 degrees of freedom
## Residual deviance: 3417.2 on 2910 degrees of freedom
## AIC: 3447.2
##
## Number of Fisher Scoring iterations: 4
A continuación eliminamos la variable diabetes
entrenamiento_3 <- entrenamiento_2 [,-8]
modelo_logísitca_3 <- glm(male ~ . , data = entrenamiento_3, family = "binomial")
summary(modelo_logísitca_3)##
## Call:
## glm(formula = male ~ ., family = "binomial", data = entrenamiento_3)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.5247 -0.9232 -0.6142 1.0541 2.7239
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.772188 0.582344 -1.326 0.184840
## age 0.017908 0.005704 3.140 0.001692 **
## education 0.038662 0.041602 0.929 0.352720
## currentSmoker -0.576982 0.146381 -3.942 8.09e-05 ***
## cigsPerDay 0.094853 0.007088 13.383 < 2e-16 ***
## BPMeds -0.678144 0.275942 -2.458 0.013989 *
## prevalentHyp 0.198955 0.129932 1.531 0.125715
## totChol -0.003552 0.001000 -3.550 0.000385 ***
## sysBP -0.028592 0.003882 -7.365 1.77e-13 ***
## diaBP 0.046015 0.006321 7.280 3.34e-13 ***
## BMI 0.061966 0.011554 5.363 8.17e-08 ***
## heartRate -0.029974 0.003763 -7.966 1.64e-15 ***
## glucose 0.004544 0.001917 2.371 0.017740 *
## TenYearCHD 0.369263 0.121528 3.039 0.002378 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 4013.2 on 2924 degrees of freedom
## Residual deviance: 3417.6 on 2911 degrees of freedom
## AIC: 3445.6
##
## Number of Fisher Scoring iterations: 4
A continuación eliminamos la variable education
entrenamiento_4 <- entrenamiento_3 [,-3]
modelo_logísitca_4 <- glm(male ~ . , data = entrenamiento_4, family = "binomial")
summary(modelo_logísitca_4)##
## Call:
## glm(formula = male ~ ., family = "binomial", data = entrenamiento_4)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.5371 -0.9222 -0.6196 1.0534 2.7107
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.6280038 0.5612194 -1.119 0.263141
## age 0.0172438 0.0056577 3.048 0.002305 **
## currentSmoker -0.5768348 0.1463668 -3.941 8.11e-05 ***
## cigsPerDay 0.0947597 0.0070830 13.378 < 2e-16 ***
## BPMeds -0.6712291 0.2756987 -2.435 0.014906 *
## prevalentHyp 0.2020120 0.1298290 1.556 0.119712
## totChol -0.0034993 0.0009984 -3.505 0.000457 ***
## sysBP -0.0288529 0.0038713 -7.453 9.13e-14 ***
## diaBP 0.0463764 0.0063075 7.353 1.94e-13 ***
## BMI 0.0607738 0.0114790 5.294 1.19e-07 ***
## heartRate -0.0301328 0.0037579 -8.019 1.07e-15 ***
## glucose 0.0045435 0.0019175 2.370 0.017810 *
## TenYearCHD 0.3658325 0.1214767 3.012 0.002599 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 4013.2 on 2924 degrees of freedom
## Residual deviance: 3418.4 on 2912 degrees of freedom
## AIC: 3444.4
##
## Number of Fisher Scoring iterations: 4
A continuación eliminamos la variable prevalentHyp
entrenamiento_5 <- entrenamiento_4 [,-6]
modelo_logísitca_5 <- glm(male ~ . , data = entrenamiento_5, family = "binomial")
summary(modelo_logísitca_5)##
## Call:
## glm(formula = male ~ ., family = "binomial", data = entrenamiento_5)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.4981 -0.9239 -0.6147 1.0575 2.7521
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.036013 0.496532 -2.086 0.036933 *
## age 0.017841 0.005642 3.162 0.001566 **
## currentSmoker -0.573846 0.146218 -3.925 8.69e-05 ***
## cigsPerDay 0.094565 0.007072 13.372 < 2e-16 ***
## BPMeds -0.612950 0.272859 -2.246 0.024678 *
## totChol -0.003508 0.000999 -3.511 0.000446 ***
## sysBP -0.026808 0.003629 -7.387 1.50e-13 ***
## diaBP 0.047935 0.006234 7.690 1.47e-14 ***
## BMI 0.061918 0.011449 5.408 6.37e-08 ***
## heartRate -0.029951 0.003751 -7.986 1.40e-15 ***
## glucose 0.004503 0.001917 2.349 0.018816 *
## TenYearCHD 0.372924 0.121398 3.072 0.002127 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 4013.2 on 2924 degrees of freedom
## Residual deviance: 3420.8 on 2913 degrees of freedom
## AIC: 3444.8
##
## Number of Fisher Scoring iterations: 4
En este modelo todas las variables son significativas, por tanto lo cogemos como modelo de entrenamiento
modelo_entrenamiento <- entrenamiento_5
glm.fits <- glm(male ~ . , data = modelo_entrenamiento, family = "binomial")
summary(glm.fits)##
## Call:
## glm(formula = male ~ ., family = "binomial", data = modelo_entrenamiento)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.4981 -0.9239 -0.6147 1.0575 2.7521
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.036013 0.496532 -2.086 0.036933 *
## age 0.017841 0.005642 3.162 0.001566 **
## currentSmoker -0.573846 0.146218 -3.925 8.69e-05 ***
## cigsPerDay 0.094565 0.007072 13.372 < 2e-16 ***
## BPMeds -0.612950 0.272859 -2.246 0.024678 *
## totChol -0.003508 0.000999 -3.511 0.000446 ***
## sysBP -0.026808 0.003629 -7.387 1.50e-13 ***
## diaBP 0.047935 0.006234 7.690 1.47e-14 ***
## BMI 0.061918 0.011449 5.408 6.37e-08 ***
## heartRate -0.029951 0.003751 -7.986 1.40e-15 ***
## glucose 0.004503 0.001917 2.349 0.018816 *
## TenYearCHD 0.372924 0.121398 3.072 0.002127 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 4013.2 on 2924 degrees of freedom
## Residual deviance: 3420.8 on 2913 degrees of freedom
## AIC: 3444.8
##
## Number of Fisher Scoring iterations: 4
Como hemos podido observar, hay variables que tienes más peso que otras, además de exisitr vaiables con signo negativo. Así por ejemplo, el caso de la variable currentSmoker sugiere que si hay una puntuación alta en el mismo es menos probable que sea hombre, mientras que la variable de cigsperDay es un indicador muy presente en el caso de los hombres.
A continuación , a través de la función predict() pronosticarmeos la probabilidad de que el paciente sea mujer u hombre. Únicamente como ejercicio lo realizaré con la misma base de datos, aunque más adelante usaré la base de validación. Observamos las primeras 10 posibilidades
glm.probs <- predict(glm.fits, type = "response")
glm.probs[1:10]## 1 2 3 4 5 6 7 8
## 0.2911512 0.2355080 0.5825179 0.9381019 0.5485671 0.3530982 0.5203727 0.5091140
## 9 10
## 0.3024317 0.7434408
Ahora convierto estas prediciones en etiquestas “Male” y “Female” (mujer todos los casos inferiores a .5 y hombre los superiores a .5)
glm.pred <- rep("Female", 2925)
glm.pred[glm.probs > .5] = "Male"Con la función table() obtengo una matríz de confusión para determinar cuantas observaciones fueron clasificadas correcta o incorrectamente.
table(glm.pred, modelo_entrenamiento$male)##
## glm.pred Female Male
## Female 1356 591
## Male 281 697
Los elementos de la diagonal indican predicciones correctas. Es decir, nuestro modelo predijo correctamente el caso de 495 hombres y 1296 mujeres parta un total de 1791 casos. Es decir, la predcicción fue correcta en un 52.89% de los casos.
Sin embargo, tal como se ha estudiado, realizar la comprobación con la misma base de datos con las que se ha diseñado el modelo puede conducir a error, por lo que enfrentaré el modelo creado a la base de datos creada para validarlo (aprox. el 20% de los casos de framingham). En primer lugar elimino las variables que no se tuvieron en cuenta en el modelo.
validación2 <- validación[,- c(3,7,8,9)]A continuación realizo la prueba con la nueva base de datos (validación2)
glm.probs <- predict(glm.fits, validación2, type = "response")
glm.probs[1:10]## 3407 3408 3410 3411 3412 3413 3414 3415
## 0.5473828 0.9194387 0.3195304 0.4931510 0.6469859 0.3195236 0.3308732 0.2469985
## 3416 3417
## 0.3889307 0.2653260
Ahora, nuevamente, convierto estas prediciones en etiquestas “Male” y “Female” (mujer todos los casos inferiores a .5 y hombre los superiores a .5)
glm.pred <- rep("Female", 731)
glm.pred[glm.probs > .5] = "Male"Vuelvo a usar la función tabe() para obtener una matríz de confusión para determinar cuantas observaciones fueron clasificadas correcta o incorrectamente.
table (glm.pred, validación2$male)##
## glm.pred Female Male
## Female 318 175
## Male 79 159
Con la función mean podemos calcular el porcentaje de aciertos
mean(glm.pred == validación2$male)## [1] 0.6525308
Como se puede observar, el modelo entrenado es incluso más fiable en la muestra de validación. Dicho modelo es correcto en un 65.25% de los casos
Para poder realizar este análisis cargo la librería MASS
library(MASS)A continuación ajusto el modelo conl as observaciones del modelo de entreamineto
lda.fit <- lda(male ~ . , data = modelo_entrenamiento)
lda.fit## Call:
## lda(male ~ ., data = modelo_entrenamiento)
##
## Prior probabilities of groups:
## Female Male
## 0.5596581 0.4403419
##
## Group means:
## age currentSmoker cigsPerDay BPMeds totChol sysBP diaBP
## Female 49.76542 0.3970678 5.463653 0.03604154 240.1081 133.1234 82.30269
## Male 49.21273 0.6118012 13.565994 0.01940994 234.1110 130.8300 83.60326
## BMI heartRate glucose TenYearCHD
## Female 25.45134 76.71472 81.24496 0.1233965
## Male 26.15818 73.90916 81.81211 0.1840062
##
## Coefficients of linear discriminants:
## LD1
## age 0.017398757
## currentSmoker -0.402549631
## cigsPerDay 0.089813983
## BPMeds -0.571288981
## totChol -0.003696090
## sysBP -0.026375262
## diaBP 0.048264120
## BMI 0.064138766
## heartRate -0.030249762
## glucose 0.004701788
## TenYearCHD 0.424751463
El resultado del LDA indica que el 55.98% de las observaciones corresponde a mujeres y que el 44.02% corresponden a hombres. También proporciona las medias del grupo, estas son las medias de cada predictor dentro de cada sexo. De esta forma se puede observar, por ejemplo, que la variable age influye ligeramente más en las mujeres, mientras que la variable diaBP lo hace en los hombres.
Al igual que en el modelo anterior, la función predict() nos ayuda a la validación del modelo.
lda.pred <- predict(lda.fit, validación2)names(lda.pred)## [1] "class" "posterior" "x"
Finalmente, volvemos a realizar la tabla donde observamos que la
lda.class <- lda.pred$class
table(lda.class, validación2$male)##
## lda.class Female Male
## Female 326 183
## Male 71 151
mean(lda.class == validación2$male)## [1] 0.6525308
Así pues, como se puede observar, el modelo realizado con el Análisis discriminante lineal tiene una validez del 65.25%. Es decir, igual que el realizado con la Regresión Logística.
Para poder realizar este análisis cargo la librería e1071
library(e1071)La sintxis para la construcción del modelo es muy parecida a las usadas hasta ahora.
nb.fit <- naiveBayes(male ~ . , data = modelo_entrenamiento, family =binomial)
nb.fit##
## Naive Bayes Classifier for Discrete Predictors
##
## Call:
## naiveBayes.default(x = X, y = Y, laplace = laplace, family = ..1)
##
## A-priori probabilities:
## Y
## Female Male
## 0.5596581 0.4403419
##
## Conditional probabilities:
## age
## Y [,1] [,2]
## Female 49.76542 8.579127
## Male 49.21273 8.511873
##
## currentSmoker
## Y [,1] [,2]
## Female 0.3970678 0.4894398
## Male 0.6118012 0.4875295
##
## cigsPerDay
## Y [,1] [,2]
## Female 5.463653 8.718607
## Male 13.565994 13.693401
##
## BPMeds
## Y [,1] [,2]
## Female 0.03604154 0.1864505
## Male 0.01940994 0.1380144
##
## totChol
## Y [,1] [,2]
## Female 240.1081 46.85426
## Male 234.1110 40.77578
##
## sysBP
## Y [,1] [,2]
## Female 133.1234 23.78847
## Male 130.8300 18.97813
##
## diaBP
## Y [,1] [,2]
## Female 82.30269 12.06127
## Male 83.60326 11.36446
##
## BMI
## Y [,1] [,2]
## Female 25.45134 4.429711
## Male 26.15818 3.411561
##
## heartRate
## Y [,1] [,2]
## Female 76.71472 12.02244
## Male 73.90916 11.77589
##
## glucose
## Y [,1] [,2]
## Female 81.24496 21.02026
## Male 81.81211 23.30215
##
## TenYearCHD
## Y [,1] [,2]
## Female 0.1233965 0.3289922
## Male 0.1840062 0.3876398
Los datos obtenidos en el modelo son muy parecidos a los obtenidos tanto con la Regresión Logísitca como con el Análisis Discriminate Lineal. Por ejemplo, se vuelve a observar como la variable CigsperDay influye mucho en los hombres mientras que la variable heartRate es más habitual en las mujeres.
La formulación para la validación vuelve a ser muy parecida.
nb.class <- predict(nb.fit, validación2)
table(nb.class, validación2$male)##
## nb.class Female Male
## Female 284 143
## Male 113 191
mean(nb.class == validación2$male)## [1] 0.6497948
Como se puede observar, este caso el modelo realizado con el Native Bayes tiene una validez del 64.97%
Si bien las tres propuestas realizadas tienen un comportamiento y validez similar, Native Bayes mostró una validez un tanto inferior. En cualquier caso, y a modo personal, la más clara, por mostrar de manera muy intuitiva los diferentes componentes del modelo, me ha parecido el Análisis Discriminante Lineal, por lo que en mi actividad investigadora usaré la Regresión Logística para concretar qué variables intervienen en el modelo y Análisis Discriminante Lineal para estudiar como intervienen.