1 Objetivo

Implementar el modelo de regresión logística binaria con datos relacionados a una condición de salud de las personas para predecir anomalías de corazón y evaluar la exactitud del modelo mediante la matriz de confusión.

2 Descripción

Se cargan librerías y se descargan los datos: https://raw.githubusercontent.com/rpizarrog/Analisis-Inteligente-de-datos/main/datos/heart_2020_cleaned.csv

Los datos están relacionados con aspectos médicos y son valores numéricos de varias variables que caracterizan el estado de salud de 319,795 personas.

Se pretende construir un modelo utilizando algoritmos supervisados para resolver la tarea de clasificación binaria e identificar si una persona padece del corazón o no.

Se construyen datos de entrenamiento y validación al 80% y 20% cada uno.

Se desarrollan los modelos de:

Regresión Logística binaria
Árbol de Clasificación tipo class
K Means
SVM Lineal
SVM Polinomial
SVM Radial
Los modelo se aceptan si tienen un valor de exactitud (“Accuracy”) por encima del 70%..

3 Fundamento teórico

La regresión logística ofrece solución para clasificar y para predecir valores lógicos, es decir con un valor etiquetado tal vez 0 o 1; bueno o malo, alto o bajo, entre otras etiquetas que distingan una polaridad o significado dicotómico, o un valor u otro.

Para predicciones el modelo de regresión logística binaria encuentra la probabilidad de ocurrencia de un evento determinado y dicha probabilidad se hallará siempre dentro del rango.

Cuando la variable respuesta posee dos categorías, entonces se estará delante de una regresión logística binaria.

En cambio, si la variable respuesta posee más de dos categorías, se usará la regresión logística multinomial (Zang 2020).

En este caso que se presenta y describe a continuación, se utiliza la regresión logística binomial como parte de los algoritmos supervisados de machine learning.

El modelo requiere una cantidad de variables independientes del modelo x1,x2…xnx1,x2…xn ó β1,β2…βnβ1,β2…βn.

Se debe identificar la variable dependiente YY o la variable respuesta de tipo binaria, donde cada componente de 𝑌 se distribuye mediante una distribución de Bernoulli [0|1][0|1].

Se necesitan n𝑛 el número de observaciones.

Entonces X=(x1,…,xn)T𝑋=(𝑥1,…,𝑥𝑛)T el conjunto de variable independientes.

Se identifica como θθ el vector de parámetros asociado al modelo, de forma que θ∈Rk+1θ∈Rk+1 que significa que los valores del vector resultante pertenecen a cada una de las variables.

Sea π(θTxi)π(θT𝑥𝑖) la probabilidad de que YiYi tome un valor igual a 11, entonces su modelo se puede escribir como:

π(θTxi)=P(Y=1|X=x)=11+e

Si θTxiθTxi los valores ajustados toma valores elevados y positivos, entonces … … se aproximará a 0 y, en consecuencia, el valor de la función anterior será igual a 1. En caso de que θTxiθTxi tome valores elevados pero negativos, entonces el valor de la función será 00 dado que eθTxieθTxi tenderá a infinito. (Zang 2020).

El valor ee como número irracional y basado en la teoría de logaritmos naturales es el valor constante que se puede obtener en lenguaje R con la función exp(1) igual a 2.7182818.

Efectuando la transformación logit a la expresión inicial, se obtiene:

logit(π(θTxi))=ln(π(θTxi)1−π(θTxi))logit(π(θTxi))=ln(π(θTxi)1−π(θTxi))

que significa calcular el logaritmo natural de cada valor de de xixi para determinar su probabilidad.

4 Desarrollo

4.1 Cargar librerías

library(readr)
library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(caret)

## Loading required package: ggplot2

## Loading required package: lattice

library(rpart)
library(rpart.plot)
library(knitr)
library(e1071)
library(rpart)

4.2 Cargar datos

Cargar datos de manera local por la tardanza de hacerlo desde la ruta de github. Lo recomendable es descargar los datos en ruta local.

datos <- read.csv("https://raw.githubusercontent.com/rpizarrog/Analisis-Inteligente-de-datos/main/datos/heart_2020_cleaned.csv")

4.3 Explorar datos

Son 319795 observaciones y 17 variables.

str(datos)

## 'data.frame':    319795 obs. of  18 variables:
##  $ HeartDisease    : chr  "No" "No" "No" "No" ...
##  $ BMI             : num  16.6 20.3 26.6 24.2 23.7 ...
##  $ Smoking         : chr  "Yes" "No" "Yes" "No" ...
##  $ AlcoholDrinking : chr  "No" "No" "No" "No" ...
##  $ Stroke          : chr  "No" "Yes" "No" "No" ...
##  $ PhysicalHealth  : num  3 0 20 0 28 6 15 5 0 0 ...
##  $ MentalHealth    : num  30 0 30 0 0 0 0 0 0 0 ...
##  $ DiffWalking     : chr  "No" "No" "No" "No" ...
##  $ Sex             : chr  "Female" "Female" "Male" "Female" ...
##  $ AgeCategory     : chr  "55-59" "80 or older" "65-69" "75-79" ...
##  $ Race            : chr  "White" "White" "White" "White" ...
##  $ Diabetic        : chr  "Yes" "No" "Yes" "No" ...
##  $ PhysicalActivity: chr  "Yes" "Yes" "Yes" "No" ...
##  $ GenHealth       : chr  "Very good" "Very good" "Fair" "Good" ...
##  $ SleepTime       : num  5 7 8 6 8 12 4 9 5 10 ...
##  $ Asthma          : chr  "Yes" "No" "Yes" "No" ...
##  $ KidneyDisease   : chr  "No" "No" "No" "No" ...
##  $ SkinCancer      : chr  "Yes" "No" "No" "Yes" ...

summary(datos)

##  HeartDisease            BMI          Smoking          AlcoholDrinking   
##  Length:319795      Min.   :12.02   Length:319795      Length:319795     
##  Class :character   1st Qu.:24.03   Class :character   Class :character  
##  Mode  :character   Median :27.34   Mode  :character   Mode  :character  
##                     Mean   :28.33                                        
##                     3rd Qu.:31.42                                        
##                     Max.   :94.85                                        
##     Stroke          PhysicalHealth    MentalHealth    DiffWalking       
##  Length:319795      Min.   : 0.000   Min.   : 0.000   Length:319795     
##  Class :character   1st Qu.: 0.000   1st Qu.: 0.000   Class :character  
##  Mode  :character   Median : 0.000   Median : 0.000   Mode  :character  
##                     Mean   : 3.372   Mean   : 3.898                     
##                     3rd Qu.: 2.000   3rd Qu.: 3.000                     
##                     Max.   :30.000   Max.   :30.000                     
##      Sex            AgeCategory            Race             Diabetic        
##  Length:319795      Length:319795      Length:319795      Length:319795     
##  Class :character   Class :character   Class :character   Class :character  
##  Mode  :character   Mode  :character   Mode  :character   Mode  :character  
##                                                                             
##                                                                             
##                                                                             
##  PhysicalActivity    GenHealth           SleepTime         Asthma         
##  Length:319795      Length:319795      Min.   : 1.000   Length:319795     
##  Class :character   Class :character   1st Qu.: 6.000   Class :character  
##  Mode  :character   Mode  :character   Median : 7.000   Mode  :character  
##                                        Mean   : 7.097                     
##                                        3rd Qu.: 8.000                     
##                                        Max.   :24.000                     
##  KidneyDisease       SkinCancer       
##  Length:319795      Length:319795     
##  Class :character   Class :character  
##  Mode  :character   Mode  :character  
##                                       
##                                       
##

4.4 Transformar datos

Crear variable llamada HeartDisease01 que se utilizará en el modelo de Regresión Logística tendrá valores 0 de para no daño y 1 para daño del corazón.

datos = mutate (datos,HeartDisease_01=if_else(HeartDisease=='Yes',1,0))

4.5 Las variables de interés

Todas las variables de entrada o variables independientes:

“BMI”: Indice de masa corporal con valores entre 12.02 y 94.85.
“Smoking”: Si la persona es fumadora o no con valores categóritos de ‘Yes’ o ‘No’.
“AlcoholDrinking” : Si consume alcohol o no, con valores categóricos de ‘Yes’ o ‘No’.
“Stroke”: Si padece alguna anomalía cerebrovascular, apoplejia o algo similar, con valores categóricos de ‘Yes’ o ‘No’.
“PhysicalHealth” Estado físico en lo general con valores entre 0 y 30.
“MentalHealth”. Estado mental en lo general con valores entre 0 y 30.
“DiffWalking” . Que si se le dificulta caminar o tiene algún padecimiento al caminar, con valores categóritoc de ‘Yes’ o ‘No’.
“Sex”: Género de la persona, con valores de ‘Female’ y ‘Male’ para distinguir al género femenino y masculino respectivamente.
“AgeCategory”: Una clasificación de la edad de la persona de entre 18 y 80 años. La primera categoría con un rango de edad entre 18-24, a partir de 25 con rangos de 5 en 5 hasta la clase de 75-80 y una última categoría mayores de 80 años.
“Race”. Raza u origen de la persona con valores categóricos de ‘American Indian/Alaskan Native’, ‘Asian’,‘Black’, ‘Hispanic’, ‘Other’ y’White’.
“Diabetic”. Si padece o ha padecido de diabetes en cuatro condiciones siendo Yes y No para si o no: ‘No’, ‘borderline diabetes’ condición antes de detectarse diabetes tipo 2, ‘Yes’, y ‘Yes (during pregnancy)’ durante embarazo.
“PhysicalActivity” que si realiza actividad física, con valores categóricos de ‘Yes’ o ‘No’.
“GenHealth”: EStado general de salud de la persona con valores categóricos de ‘Excellent’, ‘Very good’, ‘Good’, ‘Fair’ y ‘Poor’ con significado en español de excelente, muy buena, buena, regular y pobre o deficiente.
“SleepTime”: valor numérico de las horas de sueño u horas que duerme la persona con valores en un rango entre 1 y 24.
“Asthma”: si padece de asma o no, con valores categóricos de ‘Yes’ o ‘No’.
“KidneyDisease”: si tiene algún padecimiento en los riñones, con valores categóricos de ‘Yes’ o ‘No’.
“SkinCancer”: si padece algún tipo de cáncer de piel, con valores categóricos de ‘Yes’ o ‘No’.

La variable de interés como dependiente o variable de salida es la de daño al corazón (HeartDisease), con valores categóricos de ‘Yes’ o ‘No’.

4.6 Datos de entrenamiento y validación

Se parten los datos en en datos de entrenamiento con el 80% y datos de validación con el 20%.

set.seed(1550)
entrena <- createDataPartition(y = datos$HeartDisease, 
                               p = 0.8, 
                               list = FALSE, 
                               times = 1)
# Datos entrenamiento
datos.entrenamiento <- datos[entrena, ]  # [renglones, columna]
# Datos validación
datos.validacion <- datos[-entrena, ]

4.6.1 Datos de entrenamiento

Se muestran los primeros 20 registros datos de entrenamiento.

kable(head(datos.entrenamiento, 20), caption = "Primeros 20 registros de datos de entrenamiento")

Primeros 20 registros de datos de entrenamiento
	HeartDisease	BMI	Smoking	AlcoholDrinking	Stroke	PhysicalHealth	MentalHealth	DiffWalking	Sex	AgeCategory	Race	Diabetic	PhysicalActivity	GenHealth	SleepTime	Asthma	KidneyDisease	SkinCancer	HeartDisease_01
2	No	20.34	No	No	Yes	0	0	No	Female	80 or older	White	No	Yes	Very good	7	No	No	No	0
4	No	24.21	No	No	No	0	0	No	Female	75-79	White	No	No	Good	6	No	No	Yes	0
5	No	23.71	No	No	No	28	0	Yes	Female	40-44	White	No	Yes	Very good	8	No	No	No	0
7	No	21.63	No	No	No	15	0	No	Female	70-74	White	No	Yes	Fair	4	Yes	No	Yes	0
8	No	31.64	Yes	No	No	5	0	Yes	Female	80 or older	White	Yes	No	Good	9	Yes	No	No	0
9	No	26.45	No	No	No	0	0	No	Female	80 or older	White	No, borderline diabetes	No	Fair	5	No	Yes	No	0
10	No	40.69	No	No	No	0	0	Yes	Male	65-69	White	No	Yes	Good	10	No	No	No	0
11	Yes	34.30	Yes	No	No	30	0	Yes	Male	60-64	White	Yes	No	Poor	15	Yes	No	No	1
12	No	28.71	Yes	No	No	0	0	No	Female	55-59	White	No	Yes	Very good	5	No	No	No	0
15	No	29.29	Yes	No	No	0	30	Yes	Female	60-64	White	No	No	Good	5	No	No	No	0
16	No	29.18	No	No	No	1	0	No	Female	50-54	White	No	Yes	Very good	6	No	No	No	0
17	No	26.26	No	No	No	5	2	No	Female	70-74	White	No	No	Very good	10	No	No	No	0
18	No	22.59	Yes	No	No	0	30	Yes	Male	70-74	White	No, borderline diabetes	Yes	Good	8	No	No	No	0
19	No	29.86	Yes	No	No	0	0	Yes	Female	75-79	Black	Yes	No	Fair	5	No	Yes	No	0
20	No	18.13	No	No	No	0	0	No	Male	80 or older	White	No	Yes	Excellent	8	No	No	Yes	0
21	No	21.16	No	No	No	0	0	No	Female	80 or older	Black	No, borderline diabetes	No	Good	8	No	No	No	0
22	No	28.90	No	No	No	2	5	No	Female	70-74	White	Yes	No	Very good	7	No	No	No	0
24	No	25.82	Yes	No	No	0	30	No	Male	80 or older	White	Yes	Yes	Fair	8	No	No	No	0
25	No	25.75	No	No	No	0	0	No	Female	80 or older	White	No	Yes	Very good	6	No	No	Yes	0
26	No	29.18	Yes	No	No	30	30	Yes	Female	60-64	White	No	No	Poor	6	Yes	No	No	0

4.6.2 Datos de validación

Se muestran los primeros 20 registros de datos de validación.

kable(head(datos.entrenamiento, 20), caption = "Primeros 20 registros de datos de entrenamiento")

Primeros 20 registros de datos de entrenamiento
	HeartDisease	BMI	Smoking	AlcoholDrinking	Stroke	PhysicalHealth	MentalHealth	DiffWalking	Sex	AgeCategory	Race	Diabetic	PhysicalActivity	GenHealth	SleepTime	Asthma	KidneyDisease	SkinCancer	HeartDisease_01
2	No	20.34	No	No	Yes	0	0	No	Female	80 or older	White	No	Yes	Very good	7	No	No	No	0
4	No	24.21	No	No	No	0	0	No	Female	75-79	White	No	No	Good	6	No	No	Yes	0
5	No	23.71	No	No	No	28	0	Yes	Female	40-44	White	No	Yes	Very good	8	No	No	No	0
7	No	21.63	No	No	No	15	0	No	Female	70-74	White	No	Yes	Fair	4	Yes	No	Yes	0
8	No	31.64	Yes	No	No	5	0	Yes	Female	80 or older	White	Yes	No	Good	9	Yes	No	No	0
9	No	26.45	No	No	No	0	0	No	Female	80 or older	White	No, borderline diabetes	No	Fair	5	No	Yes	No	0
10	No	40.69	No	No	No	0	0	Yes	Male	65-69	White	No	Yes	Good	10	No	No	No	0
11	Yes	34.30	Yes	No	No	30	0	Yes	Male	60-64	White	Yes	No	Poor	15	Yes	No	No	1
12	No	28.71	Yes	No	No	0	0	No	Female	55-59	White	No	Yes	Very good	5	No	No	No	0
15	No	29.29	Yes	No	No	0	30	Yes	Female	60-64	White	No	No	Good	5	No	No	No	0
16	No	29.18	No	No	No	1	0	No	Female	50-54	White	No	Yes	Very good	6	No	No	No	0
17	No	26.26	No	No	No	5	2	No	Female	70-74	White	No	No	Very good	10	No	No	No	0
18	No	22.59	Yes	No	No	0	30	Yes	Male	70-74	White	No, borderline diabetes	Yes	Good	8	No	No	No	0
19	No	29.86	Yes	No	No	0	0	Yes	Female	75-79	Black	Yes	No	Fair	5	No	Yes	No	0
20	No	18.13	No	No	No	0	0	No	Male	80 or older	White	No	Yes	Excellent	8	No	No	Yes	0
21	No	21.16	No	No	No	0	0	No	Female	80 or older	Black	No, borderline diabetes	No	Good	8	No	No	No	0
22	No	28.90	No	No	No	2	5	No	Female	70-74	White	Yes	No	Very good	7	No	No	No	0
24	No	25.82	Yes	No	No	0	30	No	Male	80 or older	White	Yes	Yes	Fair	8	No	No	No	0
25	No	25.75	No	No	No	0	0	No	Female	80 or older	White	No	Yes	Very good	6	No	No	Yes	0
26	No	29.18	Yes	No	No	30	30	Yes	Female	60-64	White	No	No	Poor	6	Yes	No	No	0

4.7 Regresión Logística binomial

Se construye el modelo con los datos de entrenamiento mediante la función glm() indicando que es regresión logística binomial es decir solo dos valores.

modelo.rl = glm(data = datos.entrenamiento,formula =    HeartDisease_01 ~ BMI+Smoking+AlcoholDrinking+Stroke+PhysicalHealth+MentalHealth+DiffWalking+Sex
+AgeCategory+Race+Diabetic+PhysicalActivity+GenHealth+SleepTime+Asthma+KidneyDisease+SkinCancer, family = binomial())

4.7.1 Resumen y/o estadísticos del modelo

El resumen del modelo muestra algunos estadísticos importantes: se interpreta que la gran mayoría de las variables independiente tienen significación estadística ‘***’, presenta los coeficientes numéricos en la ecuación de regresión logística entre otras cosas.

summary(modelo.rl)

## 
## Call:
## glm(formula = HeartDisease_01 ~ BMI + Smoking + AlcoholDrinking + 
##     Stroke + PhysicalHealth + MentalHealth + DiffWalking + Sex + 
##     AgeCategory + Race + Diabetic + PhysicalActivity + GenHealth + 
##     SleepTime + Asthma + KidneyDisease + SkinCancer, family = binomial(), 
##     data = datos.entrenamiento)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.1082  -0.4118  -0.2449  -0.1299   3.6085  
## 
## Coefficients:
##                                   Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                     -6.3445684  0.1286104 -49.332  < 2e-16 ***
## BMI                              0.0092184  0.0012728   7.242 4.41e-13 ***
## SmokingYes                       0.3660675  0.0160686  22.782  < 2e-16 ***
## AlcoholDrinkingYes              -0.2332792  0.0372790  -6.258 3.91e-10 ***
## StrokeYes                        1.0520092  0.0252520  41.660  < 2e-16 ***
## PhysicalHealth                   0.0029245  0.0009657   3.028 0.002458 ** 
## MentalHealth                     0.0048965  0.0009837   4.977 6.44e-07 ***
## DiffWalkingYes                   0.2128607  0.0202699  10.501  < 2e-16 ***
## SexMale                          0.7111019  0.0162831  43.671  < 2e-16 ***
## AgeCategory25-29                 0.1291696  0.1386487   0.932 0.351527    
## AgeCategory30-34                 0.5245042  0.1233484   4.252 2.12e-05 ***
## AgeCategory35-39                 0.5479610  0.1197641   4.575 4.75e-06 ***
## AgeCategory40-44                 0.9963797  0.1118022   8.912  < 2e-16 ***
## AgeCategory45-49                 1.3300605  0.1077367  12.345  < 2e-16 ***
## AgeCategory50-54                 1.7451342  0.1040205  16.777  < 2e-16 ***
## AgeCategory55-59                 1.9801815  0.1024859  19.321  < 2e-16 ***
## AgeCategory60-64                 2.2386636  0.1015491  22.045  < 2e-16 ***
## AgeCategory65-69                 2.4559379  0.1012690  24.252  < 2e-16 ***
## AgeCategory70-74                 2.7582724  0.1011800  27.261  < 2e-16 ***
## AgeCategory75-79                 2.9577125  0.1017900  29.057  < 2e-16 ***
## AgeCategory80 or older           3.2201733  0.1015110  31.722  < 2e-16 ***
## RaceAsian                       -0.4877178  0.0941037  -5.183 2.19e-07 ***
## RaceBlack                       -0.2941225  0.0651204  -4.517 6.28e-06 ***
## RaceHispanic                    -0.2238999  0.0663729  -3.373 0.000743 ***
## RaceOther                       -0.0019905  0.0719566  -0.028 0.977932    
## RaceWhite                       -0.0514965  0.0584321  -0.881 0.378153    
## DiabeticNo, borderline diabetes  0.1722833  0.0460529   3.741 0.000183 ***
## DiabeticYes                      0.4736057  0.0187145  25.307  < 2e-16 ***
## DiabeticYes (during pregnancy)   0.1763274  0.1155684   1.526 0.127075    
## PhysicalActivityYes              0.0075909  0.0179372   0.423 0.672154    
## GenHealthFair                    1.5013719  0.0366385  40.978  < 2e-16 ***
## GenHealthGood                    1.0394994  0.0329268  31.570  < 2e-16 ***
## GenHealthPoor                    1.8794487  0.0456577  41.164  < 2e-16 ***
## GenHealthVery good               0.4590181  0.0338381  13.565  < 2e-16 ***
## SleepTime                       -0.0233950  0.0048638  -4.810 1.51e-06 ***
## AsthmaYes                        0.2852416  0.0214413  13.303  < 2e-16 ***
## KidneyDiseaseYes                 0.5621398  0.0273859  20.527  < 2e-16 ***
## SkinCancerYes                    0.0955424  0.0219048   4.362 1.29e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 149527  on 255836  degrees of freedom
## Residual deviance: 116266  on 255799  degrees of freedom
## AIC: 116342
## 
## Number of Fisher Scoring iterations: 7

Entonces una posible predicción sería de la siguiente manera:

Y=β0+β1⋅(coeficiente)+β2⋅(coeficiente)+β3⋅(coeficiente)+…+βn⋅(coeficienteY=β0+β1⋅(coeficiente)+β2⋅(coeficiente)+β3⋅(coeficiente)+...+βn⋅(coeficiente

entonces …

HeartDisease01=−6.3411940+BMI⋅(coeficiente)+SmokingYes⋅(coeficiente)+…+SkinCancerYes⋅(coeficiente)HeartDisease01=−6.3411940+BMI⋅(coeficiente)+SmokingYes⋅(coeficiente)+...+SkinCancerYes⋅(coeficiente)

4.7.2 Generar predicciones del modelo regresión logística

Se generan predicciones con datos de validación generando un valor numérico que deberá convertirse a valor probabilístico, condicionando que si el valor de la probabilidad de predicción está por debajo del 50% es 0 y si está por encima entonces será 1.

prediciones_rl = predict(object = modelo.rl,newdata = datos.validacion, se.fit = TRUE)

4.7.3 Probabilidad con la función logit

Se transforman los valores de las predicciones generadas a valores probabilísticos usando para ello el concepto de la función logit.

prob=exp(prediccion)(1+exp(prediccion))

prediciones_rl_prob <- exp(prediciones_rl$fit) / (1 + exp(prediciones_rl$fit))

4.7.4 Generar tabla comparativa

Se construye una tabla comparativa con los valores de interés

t_comparativa = data.frame(datos.validacion[,c('HeartDisease', 'HeartDisease_01')],prediciones_rl_prob)
t_comparativa <- t_comparativa %>%
  mutate(heartDiseasePred = if_else(prediciones_rl_prob < 0.50, 0, 1))
top20 = head(t_comparativa,20)
kable(top20,caption = 'Primeros 20 registros')

Primeros 20 registros
	HeartDisease	HeartDisease_01	prediciones_rl_prob
1	No	0	0.0732980
3	No	0	0.4177790
6	Yes	1	0.1682984
13	No	0	0.2434713
14	No	0	0.1409616
23	No	0	0.0169731
31	No	0	0.1557111
40	No	0	0.1568084
52	No	0	0.0340648
55	No	0	0.1031679
60	No	0	0.3944674
67	No	0	0.3459920
69	No	0	0.1254390
79	Yes	1	0.4839865
84	No	0	0.2011134
87	No	0	0.0181851
88	No	0	0.0882722
89	No	0	0.2054314
94	No	0	0.0928255
96	No	0	0.0085159

4.7.5 Evaluando el modelo

Una matriz de confusión es una herramienta que permite evaluación de un modelo de clasificación

Cada columna de la matriz representa el número de predicciones de cada clase, mientras que cada fila representa a las instancias en la clase real.

Uno de los beneficios de las matrices de confusión es que facilitan ver si el sistema está confundiendo las diferentes clases o resultados.

Hay que encontrar a cuantos casos se le atinaron utilizando los datos de validación y con ello encontrar el porcentaje de aciertos.

Se puede evaluar el modelo con la matriz de confusión interpretando algunos estadísticos:

Se evalúa el modelo de acuerdo a estas condiciones:

Accuracy o exactitud

accuracy=VP+VNVP+FP+FN+VNn=VP+FP+FN+VNaccuracy=VP+VNVP+FP+FN+VNn=VP+FP+FN+VN
Precision o precisión

precision=VPVP+FPprecision=VPVP+FP
Recall o recuperación

recall=VPVP+FNrecall=VPVP+FN
Especificity o especificidad (tasa de verdaderos negativos)

especificity=VNVN+FP

4.7.5.1 Construyendo la matriz de confusión del modelo de regresión logística

Factorizar las columnas “HeartDisease_01” & “heartDiseasePred” de la tabla comparativa

Factorizar en R significa categorizar con la función “as.factor()” o “factor”

Se muestra a tabla con las columnas de interés para interpretar las predicciones.

t_comparativa$HeartDisease_01 = as.factor(t_comparativa$HeartDisease_01)
t_comparativa$heartDiseasePred = as.factor(t_comparativa$heartDiseasePred)
kable(head(t_comparativa, 20), caption = "Tabla comparativa, primeros 20 registros")

Tabla comparativa, primeros 20 registros
	HeartDisease	HeartDisease_01	prediciones_rl_prob
1	No	0	0.0732980
3	No	0	0.4177790
6	Yes	1	0.1682984
13	No	0	0.2434713
14	No	0	0.1409616
23	No	0	0.0169731
31	No	0	0.1557111
40	No	0	0.1568084
52	No	0	0.0340648
55	No	0	0.1031679
60	No	0	0.3944674
67	No	0	0.3459920
69	No	0	0.1254390
79	Yes	1	0.4839865
84	No	0	0.2011134
87	No	0	0.0181851
88	No	0	0.0882722
89	No	0	0.2054314
94	No	0	0.0928255
96	No	0	0.0085159

Creando de la matriz de confusión con la función confusionMatrix() de la librería caret con las variables de interés: “HeartDisease_01” y “heartDiseasePred”, que representan los valores reales y las predicciones respectivamente.

matrixConfusion <- confusionMatrix(t_comparativa$HeartDisease_01,t_comparativa$heartDiseasePred)
matrixConfusion

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction     0     1
##          0 58021   463
##          1  4865   609
##                                           
##                Accuracy : 0.9167          
##                  95% CI : (0.9145, 0.9188)
##     No Information Rate : 0.9832          
##     P-Value [Acc > NIR] : 1               
##                                           
##                   Kappa : 0.1626          
##                                           
##  Mcnemar's Test P-Value : <2e-16          
##                                           
##             Sensitivity : 0.9226          
##             Specificity : 0.5681          
##          Pos Pred Value : 0.9921          
##          Neg Pred Value : 0.1113          
##              Prevalence : 0.9832          
##          Detection Rate : 0.9072          
##    Detection Prevalence : 0.9144          
##       Balanced Accuracy : 0.7454          
##                                           
##        'Positive' Class : 0               
##

El valor estadístico de Accuracy = Exactitud igual a 0.9153 significa un valor del 91.53%; se interpreta que de cada 100 el modelo acierta en la predicción el 91.53% de las ocasiones.

Si la métrica era que debiera tener un valor por encima del 70% el modelo se acepta pero debe compararse contra otro modelo de clasificación para ver cual es más eficiente en relación tan solo en el estadístico de Exactitud.

Este valor de Accuracy = Exactitud deberá compararse contra otros modelos.

4.8 Predicciones con datos nuevos

Se crea un registro de una persona con ciertas condiciones de salud.

BMI <- 38
Smoking <- 'Yes'
AlcoholDrinking = 'Yes'
Stroke <- 'Yes'
PhysicalHealth <- 2
MentalHealth = 5
DiffWalking = 'Yes'
Sex = 'Male'
AgeCategory = '70-74'
Race = 'Black'
Diabetic <- 'Yes'
PhysicalActivity = "No"
GenHealth = "Fair"
SleepTime = 12
Asthma = "Yes"
KidneyDisease = "Yes"
SkinCancer = 'No'
persona <- data.frame(BMI,Smoking, AlcoholDrinking, Stroke, PhysicalHealth, MentalHealth, DiffWalking, Sex, AgeCategory, Race, Diabetic, PhysicalActivity, GenHealth, SleepTime, Asthma, KidneyDisease, SkinCancer)
persona

##   BMI Smoking AlcoholDrinking Stroke PhysicalHealth MentalHealth DiffWalking
## 1  38     Yes             Yes    Yes              2            5         Yes
##    Sex AgeCategory  Race Diabetic PhysicalActivity GenHealth SleepTime Asthma
## 1 Male       70-74 Black      Yes               No      Fair        12    Yes
##   KidneyDisease SkinCancer
## 1           Yes         No

Se hace la predicción con estos valores para estimar si tiene daño o no de corazón:

prediccion <- predict(object = modelo.rl, newdata = persona, se.fit = TRUE)
prediccion

## $fit
##        1 
## 1.150592 
## 
## $se.fit
## [1] 0.06985214
## 
## $residual.scale
## [1] 1

Este valor 0.06985214 a valor probabilístico:

prob <- exp(prediccion$fit) / (1 + exp(prediccion$fit))
prob

##        1 
## 0.759619

Tiene un valor de 0.759619 es decir un 75.96%

Entonces en predicción es:

pred <- if_else (prob > 0.5, 1, 0)
pred

## [1] 1

Si la predicción es 0 no tienen afección del corazón en caso se contrario si el resultado es 1 entonces la predicción implica que si tiene daño del corazón.

5 Interpretación

Utilizando la semilla 1550, obtuve que el modelo de predicción tuvo una certeza del 91.67%, según la matriz de confusión, con un total de 58021 verdaderos positivos, 463 verdaderos negativos, 4865 falsos positivos y 609 falsos negativos.

Según los registros de la persona inventada previamente, obtuve un índice probabilístico de 0.759619, osea, 75.96% de probabilidad de que la persona tenga problemas cardiacos.

Caso 8. Regresión Logística Binaria. Predicciones de daño corazón.

Edwin Jesús Kato Montelongo

2022-11-23