PLANTEAMIENTO DEL EJERCICIO SOBRE UN MODELO PREDICTIVO

La Hipertensión Arterial (HTA) se ubica como un problema de Salud Pública de gran importancia, principalmente porque es una enfermedad crónica que no da síntomas, lo que dificulta su diagnóstico oportuno. Hay datos que mencionan que alrededor de un 40% a 50% de las personas con hipertensión desconocen que la padecen, lo que imposibilita un tratamiento precoz. Se han realizado estudios en distintas localidades del mundo. Por ejemplo, en México se estima que alrededor de 30 millones de personas la padecen. En este contexto, se ha realizado un trabajo para investigar los valores de tensión arterial (TA) inicialmente en un grupo de participantes (n=912) provenientes de diversas ciudades (Cleveland, Hungría, Suiza y VA Long Beach). Existe evidencia de que la TA está influida por diversos factores, entre ellos la edad y altos niveles de colesterol. Dado que en una base de datos de UCI Machine Learning Repository se dispone de diversas mediciones, se decidió explorar la influencia del colesterol, la frecuencia cardiaca y la edad sobre la tensión arterial.

Preguntas de investigación:

¿Existe relación entre la edad y la TA en reposo? ¿Será significativa la relación entre la TA en reposo y el colesterol? ¿Será positiva y alta la relación entre la TA en reposo y la frecuencia cardiaca máxima alcanzada? En un modelo de regresión múltiple, ¿cómo influyen la edad, el colesterol y la frecuencia cardiaca en la TA en reposo?
Se espera que la variable que más explique la TA sea el nivel de colesterol.

El trabajo sobre modelo predictivo se hará con la base heart_disease_uci

library(tidyverse)
## Warning: package 'tidyverse' was built under R version 4.5.2
## Warning: package 'ggplot2' was built under R version 4.5.2
## Warning: package 'dplyr' was built under R version 4.5.2
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.5
## ✔ forcats   1.0.1     ✔ stringr   1.5.2
## ✔ ggplot2   4.0.1     ✔ tibble    3.3.0
## ✔ lubridate 1.9.4     ✔ tidyr     1.3.1
## ✔ purrr     1.1.0     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(readxl)
## Warning: package 'readxl' was built under R version 4.5.2
a4_heart_disease_uci <- read_excel("D:/Ejercicios del taller en R/a4_heart_disease_uci.xlsx")
View(a4_heart_disease_uci)

##Renombrando la base de datos

datos_heart<-a4_heart_disease_uci
View(datos_heart)

###Revisión de la estructura de la base de datos

str(datos_heart)
## tibble [920 × 16] (S3: tbl_df/tbl/data.frame)
##  $ id        : num [1:920] 1 2 3 4 5 6 7 8 9 10 ...
##  $ edad      : num [1:920] 63 67 67 37 41 56 62 57 63 53 ...
##  $ sexo      : chr [1:920] "Male" "Male" "Male" "Male" ...
##  $ dataset   : chr [1:920] "Cleveland" "Cleveland" "Cleveland" "Cleveland" ...
##  $ cp        : chr [1:920] "typical angina" "asymptomatic" "asymptomatic" "non-anginal" ...
##  $ Taenreposo: num [1:920] 145 160 120 130 130 120 140 120 130 140 ...
##  $ colesterol: num [1:920] 233 286 229 250 204 236 268 354 254 203 ...
##  $ fbs       : logi [1:920] TRUE FALSE FALSE FALSE FALSE FALSE ...
##  $ restecg   : chr [1:920] "lv hypertrophy" "lv hypertrophy" "lv hypertrophy" "normal" ...
##  $ Fcmáxalca : num [1:920] 150 108 129 187 172 178 160 163 147 155 ...
##  $ exang     : logi [1:920] FALSE TRUE TRUE FALSE FALSE FALSE ...
##  $ oldpeak   : num [1:920] 2.3 1.5 2.6 3.5 1.4 0.8 3.6 0.6 1.4 3.1 ...
##  $ slope     : chr [1:920] "downsloping" "flat" "flat" "downsloping" ...
##  $ ca        : num [1:920] 0 3 2 0 0 0 2 0 1 0 ...
##  $ thal      : chr [1:920] "fixed defect" "normal" "reversable defect" "normal" ...
##  $ num       : num [1:920] 0 2 1 0 0 0 3 0 2 1 ...

###Análisis descriptivo de las variables que se incluirán en el modelo

sum(datos_heart$edad)
## [1] 49230
mean(datos_heart$edad)
## [1] 53.51087

La edad media de los participantes es de 53.5 años

Análisis descriptivo con los valores válidos de la variable edad

mean(datos_heart$edad, nar.rm=TRUE)
## [1] 53.51087

Incluso eliminando datos faltantes se mantiene el mismo promedio de edad

###Abriendo una librería para la manipulación y limpieza que se requiera de los datos

datos_heartL<- na.omit(datos_heart)
nrow(datos_heartL)
## [1] 299
View(datos_heartL)

``datos_heartL<- na.omit(datos_heart) nrow(datos_heartL) View(datos_heartL)

datos_heartL
## # A tibble: 299 × 16
##       id  edad sexo  dataset cp    Taenreposo colesterol fbs   restecg Fcmáxalca
##    <dbl> <dbl> <chr> <chr>   <chr>      <dbl>      <dbl> <lgl> <chr>       <dbl>
##  1     1    63 Male  Clevel… typi…        145        233 TRUE  lv hyp…       150
##  2     2    67 Male  Clevel… asym…        160        286 FALSE lv hyp…       108
##  3     3    67 Male  Clevel… asym…        120        229 FALSE lv hyp…       129
##  4     4    37 Male  Clevel… non-…        130        250 FALSE normal        187
##  5     5    41 Fema… Clevel… atyp…        130        204 FALSE lv hyp…       172
##  6     6    56 Male  Clevel… atyp…        120        236 FALSE normal        178
##  7     7    62 Fema… Clevel… asym…        140        268 FALSE lv hyp…       160
##  8     8    57 Fema… Clevel… asym…        120        354 FALSE normal        163
##  9     9    63 Male  Clevel… asym…        130        254 FALSE lv hyp…       147
## 10    10    53 Male  Clevel… asym…        140        203 TRUE  lv hyp…       155
## # ℹ 289 more rows
## # ℹ 6 more variables: exang <lgl>, oldpeak <dbl>, slope <chr>, ca <dbl>,
## #   thal <chr>, num <dbl>
str(datos_heartL)
## tibble [299 × 16] (S3: tbl_df/tbl/data.frame)
##  $ id        : num [1:299] 1 2 3 4 5 6 7 8 9 10 ...
##  $ edad      : num [1:299] 63 67 67 37 41 56 62 57 63 53 ...
##  $ sexo      : chr [1:299] "Male" "Male" "Male" "Male" ...
##  $ dataset   : chr [1:299] "Cleveland" "Cleveland" "Cleveland" "Cleveland" ...
##  $ cp        : chr [1:299] "typical angina" "asymptomatic" "asymptomatic" "non-anginal" ...
##  $ Taenreposo: num [1:299] 145 160 120 130 130 120 140 120 130 140 ...
##  $ colesterol: num [1:299] 233 286 229 250 204 236 268 354 254 203 ...
##  $ fbs       : logi [1:299] TRUE FALSE FALSE FALSE FALSE FALSE ...
##  $ restecg   : chr [1:299] "lv hypertrophy" "lv hypertrophy" "lv hypertrophy" "normal" ...
##  $ Fcmáxalca : num [1:299] 150 108 129 187 172 178 160 163 147 155 ...
##  $ exang     : logi [1:299] FALSE TRUE TRUE FALSE FALSE FALSE ...
##  $ oldpeak   : num [1:299] 2.3 1.5 2.6 3.5 1.4 0.8 3.6 0.6 1.4 3.1 ...
##  $ slope     : chr [1:299] "downsloping" "flat" "flat" "downsloping" ...
##  $ ca        : num [1:299] 0 3 2 0 0 0 2 0 1 0 ...
##  $ thal      : chr [1:299] "fixed defect" "normal" "reversable defect" "normal" ...
##  $ num       : num [1:299] 0 2 1 0 0 0 3 0 2 1 ...
##  - attr(*, "na.action")= 'omit' Named int [1:621] 88 167 193 267 288 303 304 305 306 307 ...
##   ..- attr(*, "names")= chr [1:621] "88" "167" "193" "267" ...

Al eliminar participantes (renglones) en los que no hay datos el valor de n=299

Como se indicó, las variables que incluirá el modelo predictivo son TA en reposo, edad, colesterol y Frec Cardiaca máxima alcanzada.

mean(datos_heartL$Taenreposo)
## [1] 131.7157

El valor medio de la TA de los participantes es de 132 mmHg

#Resumen estadístico de TA en reposo

summary(datos_heartL$Taenreposo) 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    94.0   120.0   130.0   131.7   140.0   200.0

El resumen estadístico de la TA arroja la presencia de valores altos (140-200)

Resumen estadístico de colesterol

summary(datos_heartL$colesterol)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   100.0   211.0   242.0   246.8   275.5   564.0

Considerando que lo normal es un valor de colesterolmenor de 200mg/dL, destaca la notable diferencia del valor medio y el máximo de colesterol.

Resumen estadístico de Frecuencia máxima alcanzada

summary(datos_heartL$Fcmáxalca)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    71.0   132.5   152.0   149.3   165.5   202.0

En lo referente a la frecuencia cardiaca se obtuvo una media de 149.

Otros análisis que ayudan a caracterizar al grupo de participantes en el estudio

Respecto a la variable edad

mean(datos_heartL$edad)
## [1] 54.52174
summary(datos_heartL$edad)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   29.00   48.00   56.00   54.52   61.00   77.00

Se encontró una amplitud grande en esta variable (29 a 77 años)

sd(datos_heartL$edad)
## [1] 9.030264

La ds también es grande (9.03)

table(datos_heartL$edad)
## 
## 29 34 35 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 
##  1  2  4  2  1  4  3 10  8  7 11  8  7  6  7  5  7 12 11  7 16  8 12 17 18 14 
## 60 61 62 63 64 65 66 67 68 69 70 71 74 76 77 
## 12  8 11  9 10  8  7  9  4  3  4  3  1  1  1

Respecto al diagnóstico de enfermedad cardiaca (0=sin enfermedad a 4=nivel severo)

table(datos_heartL$num)
## 
##   0   1   2   3   4 
## 160  56  35  35  13

La diferencia en la frecuencia de sin enfermedad (0) a nivel leve a severo (4) de enfermedad, es pequeña.

La distribución de diagnóstico según el sexo de los participantes fue la siguiente:

tabla1<-table(datos_heartL$sexo, datos_heartL$num)
tabla1
##         
##           0  1  2  3  4
##   Female 71  9  7  7  2
##   Male   89 47 28 28 11

Los participantes masculinos presentan las frecuencias más altas.

Estructura de la base de datos

str(datos_heartL)
## tibble [299 × 16] (S3: tbl_df/tbl/data.frame)
##  $ id        : num [1:299] 1 2 3 4 5 6 7 8 9 10 ...
##  $ edad      : num [1:299] 63 67 67 37 41 56 62 57 63 53 ...
##  $ sexo      : chr [1:299] "Male" "Male" "Male" "Male" ...
##  $ dataset   : chr [1:299] "Cleveland" "Cleveland" "Cleveland" "Cleveland" ...
##  $ cp        : chr [1:299] "typical angina" "asymptomatic" "asymptomatic" "non-anginal" ...
##  $ Taenreposo: num [1:299] 145 160 120 130 130 120 140 120 130 140 ...
##  $ colesterol: num [1:299] 233 286 229 250 204 236 268 354 254 203 ...
##  $ fbs       : logi [1:299] TRUE FALSE FALSE FALSE FALSE FALSE ...
##  $ restecg   : chr [1:299] "lv hypertrophy" "lv hypertrophy" "lv hypertrophy" "normal" ...
##  $ Fcmáxalca : num [1:299] 150 108 129 187 172 178 160 163 147 155 ...
##  $ exang     : logi [1:299] FALSE TRUE TRUE FALSE FALSE FALSE ...
##  $ oldpeak   : num [1:299] 2.3 1.5 2.6 3.5 1.4 0.8 3.6 0.6 1.4 3.1 ...
##  $ slope     : chr [1:299] "downsloping" "flat" "flat" "downsloping" ...
##  $ ca        : num [1:299] 0 3 2 0 0 0 2 0 1 0 ...
##  $ thal      : chr [1:299] "fixed defect" "normal" "reversable defect" "normal" ...
##  $ num       : num [1:299] 0 2 1 0 0 0 3 0 2 1 ...
##  - attr(*, "na.action")= 'omit' Named int [1:621] 88 167 193 267 288 303 304 305 306 307 ...
##   ..- attr(*, "names")= chr [1:621] "88" "167" "193" "267" ...
# install.packages("ggplot2")
library(ggplot2)
ggplot(data = datos_heartL, aes(x=num))+
  geom_histogram(color= "white", fill="orange")+
  labs(x= "diagnóstico de enfermedad", y= "frecuencia absoluta", title = "NÚMERO DE CASOS SEGÚN ENFERMEDAD CARDIACA")
## `stat_bin()` using `bins = 30`. Pick better value `binwidth`.

Distribución respecto al sexo

table(datos_heartL$sexo)
## 
## Female   Male 
##     96    203

Los participantes predominantemente son de sexo masculino.

El modelo pretende predecir el papel de la edad, el valor del colesterol, y la Frecuencia cardiaca máxima alcanzada (variable explicativa o predictiva) en la tensión arterial (variable de respuesta):

TA= a + (a1)edad + (a2)colesterol + (a3)Frcardiaca + error.

Se explorará visualmente el patrón de dispersión de las variables que incluye el modelo.

plot((datos_heartL$edad))

plot(datos_heartL$colesterol)

plot(datos_heartL$Fcmáxalca)

Explorando la correlación de las variables del modelo con TA.

cor(datos_heartL$Taenreposo,datos_heartL$edad)
## [1] 0.2861491
cor(datos_heartL$Taenreposo,datos_heartL$colesterol)
## [1] 0.1342404
cor(datos_heartL$Taenreposo,datos_heartL$Fcmáxalca)
## [1] -0.05331993

La correlación más alta y positiva se encontró entre edad y TA.

#Para observar gráficamente la correlación entre colesterol y TA se instaló la paquetería requerida.

library(tidyverse)
# install.packages("PerformanceAnalytics")
library(PerformanceAnalytics)
## Warning: package 'PerformanceAnalytics' was built under R version 4.5.2
## Cargando paquete requerido: xts
## Warning: package 'xts' was built under R version 4.5.2
## Cargando paquete requerido: zoo
## Warning: package 'zoo' was built under R version 4.5.2
## 
## Adjuntando el paquete: 'zoo'
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
## 
## ######################### Warning from 'xts' package ##########################
## #                                                                             #
## # The dplyr lag() function breaks how base R's lag() function is supposed to  #
## # work, which breaks lag(my_xts). Calls to lag(my_xts) that you type or       #
## # source() into this session won't work correctly.                            #
## #                                                                             #
## # Use stats::lag() to make sure you're not using dplyr::lag(), or you can add #
## # conflictRules('dplyr', exclude = 'lag') to your .Rprofile to stop           #
## # dplyr from breaking base R's lag() function.                                #
## #                                                                             #
## # Code in packages is not affected. It's protected by R's namespace mechanism #
## # Set `options(xts.warn_dplyr_breaks_lag = FALSE)` to suppress this warning.  #
## #                                                                             #
## ###############################################################################
## 
## Adjuntando el paquete: 'xts'
## The following objects are masked from 'package:dplyr':
## 
##     first, last
## 
## Adjuntando el paquete: 'PerformanceAnalytics'
## The following object is masked from 'package:graphics':
## 
##     legend
plot(datos_heartL$Taenreposo, datos_heartL$colesterol)
abline(lm(datos_heartL$Taenreposo~datos_heartL$colesterol), col="blue", lwd=2)

### Se puede observar que la relación entre ambas variables (TA y colesterol) presenta heterocedasticidad. Se considera que esta condición significa en este contexto que el modelo propuesto no es confiable.

Modelo predictivo

MP <-lm(Taenreposo ~ edad + colesterol + Fcmáxalca, data = datos_heartL)
summary(MP)
## 
## Call:
## lm(formula = Taenreposo ~ edad + colesterol + Fcmáxalca, data = datos_heartL)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -39.148 -11.556  -1.409  10.042  67.121 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 87.31499   11.43434   7.636 3.13e-13 ***
## edad         0.57715    0.12119   4.762 3.01e-06 ***
## colesterol   0.02529    0.01924   1.315    0.190    
## Fcmáxalca    0.04482    0.04639   0.966    0.335    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 17.01 on 295 degrees of freedom
## Multiple R-squared:  0.09097,    Adjusted R-squared:  0.08172 
## F-statistic:  9.84 on 3 and 295 DF,  p-value: 3.325e-06

CONCLUSIONES

Los resultados sugieren que solamente la variable edad contribuye de manera significativa a la explicación de la variable dependiente (TA). Sin embargo, dado que el valor observado del coeficiente de determinación es muy bajo (.09) se puede concluir que el modelo examInado no es muy exacto. Finalmente, la significancia asociada (p < .05) al valor de F obtenido indica que al menos una de las variables contribuye significativamente a la explicación de la TA.