Análisis de la base de datos

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),]

Regresión logística

Entrenamiento

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.

Validación

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

Análisis discriminante lineal

Entrenamiento

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.

Validación

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.

Naive Bayes

Entrenamiento

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.

Validación

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%

Conclusiones

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.