Reporte de análisis de datos cardíacos
Juan Diego Parra Guarín
2026-09-10
Introducción
En este reporte se analizan los datos de enfermedades cardíacas en diferentes edades con el fin de identificar patrones y datos atípicos que puedan ser investigados a futuro.
Para este reporte se mostrará cómo se realizó el tratamiento de los datos, desde la inspección inicial de los datos, la imputación, limpieza y transformación de los datos, hasta el análisis estadístico descriptivo, la correlación de variables y la exploración probabilística de algunos eventos con el fin de poder predecir enfermedad cardíaca según grupo de edad, sexo o cualquier otro evento que se considere pertinente.
Preparación del reporte
En esta sección se ejecutan las librerías y los parámetros iniciales del documento, como la paleta de colores, que van a usarse a lo largo del reporte.
library(corrplot)
library(VIM)
library(naniar)
library(forcats)
library(tidyverse)
library(dplyr)
library(ggplot2)
library(tibble)
library(mice)
theme_set(theme_minimal(base_size = 12))
col_azul <- "#2C3E50" # Azul profundo
col_verde <- "#27AE60" # Verde brillante
col_naranja <- "#E67E22" # Naranja cálido
col_rojo <- "#C0392B" # Rojo intenso
col_gris <- "#95A5A6" # Gris neutro
col_turquesa <- "#16A085" # Turquesa fresco
paleta <- c(col_azul, col_verde, col_naranja, col_rojo, col_gris, col_turquesa)
raw_data <- read_csv("heart_disease_uci.csv")Inspección Inicial
Se utiliza la función glimpse() para identificar rápidamente el nombre de las variables y el tipo de variable de forma rápida.
glimpse(raw_data)## Rows: 920
## Columns: 16
## $ id <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18…
## $ age <dbl> 63, 67, 67, 37, 41, 56, 62, 57, 63, 53, 57, 56, 56, 44, 52, 5…
## $ sex <chr> "Male", "Male", "Male", "Male", "Female", "Male", "Female", "…
## $ dataset <chr> "Cleveland", "Cleveland", "Cleveland", "Cleveland", "Clevelan…
## $ cp <chr> "typical angina", "asymptomatic", "asymptomatic", "non-angina…
## $ trestbps <dbl> 145, 160, 120, 130, 130, 120, 140, 120, 130, 140, 140, 140, 1…
## $ chol <dbl> 233, 286, 229, 250, 204, 236, 268, 354, 254, 203, 192, 294, 2…
## $ fbs <lgl> TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE,…
## $ restecg <chr> "lv hypertrophy", "lv hypertrophy", "lv hypertrophy", "normal…
## $ thalch <dbl> 150, 108, 129, 187, 172, 178, 160, 163, 147, 155, 148, 153, 1…
## $ exang <lgl> FALSE, TRUE, TRUE, FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, T…
## $ oldpeak <dbl> 2.3, 1.5, 2.6, 3.5, 1.4, 0.8, 3.6, 0.6, 1.4, 3.1, 0.4, 1.3, 0…
## $ slope <chr> "downsloping", "flat", "flat", "downsloping", "upsloping", "u…
## $ ca <dbl> 0, 3, 2, 0, 0, 0, 2, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0…
## $ thal <chr> "fixed defect", "normal", "reversable defect", "normal", "nor…
## $ num <dbl> 0, 2, 1, 0, 0, 0, 3, 0, 2, 1, 0, 0, 2, 0, 0, 0, 1, 0, 0, 0, 0…De esta manera se determina que el set de datos cuenta con 16 variables y 3 tipos de variables, character, double y logical.
Enseguida, se realiza un resúmen estadístico de las variables mediante la función summary()
summary(raw_data)## id age sex dataset
## Min. : 1.0 Min. :28.00 Length :920 Length :920
## 1st Qu.:230.8 1st Qu.:47.00 N.unique : 2 N.unique : 4
## Median :460.5 Median :54.00 N.blank : 0 N.blank : 0
## Mean :460.5 Mean :53.51 Min.nchar: 4 Min.nchar: 7
## 3rd Qu.:690.2 3rd Qu.:60.00 Max.nchar: 6 Max.nchar: 13
## Max. :920.0 Max. :77.00
##
## cp trestbps chol fbs
## Length :920 Min. : 0.0 Min. : 0.0 Mode :logical
## N.unique : 4 1st Qu.:120.0 1st Qu.:175.0 FALSE:692
## N.blank : 0 Median :130.0 Median :223.0 TRUE :138
## Min.nchar: 11 Mean :132.1 Mean :199.1 NAs :90
## Max.nchar: 15 3rd Qu.:140.0 3rd Qu.:268.0
## Max. :200.0 Max. :603.0
## NAs :59 NAs :30
## restecg thalch exang oldpeak
## Length :920 Min. : 60.0 Mode :logical Min. :-2.6000
## N.unique : 3 1st Qu.:120.0 FALSE:528 1st Qu.: 0.0000
## N.blank : 0 Median :140.0 TRUE :337 Median : 0.5000
## Min.nchar: 6 Mean :137.5 NAs :55 Mean : 0.8788
## Max.nchar: 16 3rd Qu.:157.0 3rd Qu.: 1.5000
## NAs : 2 Max. :202.0 Max. : 6.2000
## NAs :55 NAs :62
## slope ca thal num
## Length :920 Min. :0.0000 Length :920 Min. :0.0000
## N.unique : 3 1st Qu.:0.0000 N.unique : 3 1st Qu.:0.0000
## N.blank : 0 Median :0.0000 N.blank : 0 Median :1.0000
## Min.nchar: 4 Mean :0.6764 Min.nchar: 6 Mean :0.9957
## Max.nchar: 11 3rd Qu.:1.0000 Max.nchar: 17 3rd Qu.:2.0000
## NAs :309 Max. :3.0000 NAs :486 Max. :4.0000
## NAs :611Se identifica que la base cuenta con 920 observaciones y varios datos faltantes en algunas de las variables, por ejemplo, ca y thal con 611 y 486 datos faltantes respectivamente.
Finalmente, se revisa si hay datos duplicados en la base de datos mediante la variable id siendo esta la llave primaria. Para esto se utilizan las funciones sum() y duplicated(). Esto se hace con el fin de evitar tener datos duplicados de acá en adelante para todo el análisis que se realizará.
sum(duplicated(raw_data$id))## [1] 0No se encontraron duplicados pero se determina que es necesario hacer un manejo de datos faltantes y se procede a clasificar las variables encontradas en categóricas (ordinal o nominal) y cuantitativa (discreta o continua).
Variables categóricas:
- sex - nominal
- dataset - nominal
- cp - nominal
- fbs - nominal
- restecg - nominal
- exang - nominal
- slope - nominal
- ca - ordinal
- thal - nominal
- num - ordinal
Variables cuantitativas:
- age - discreta
- trestbps - discreta
- chol - discreta
- thalch - discreta
- oldpeak - continua
La variable id no se tiene en cuenta en esta clasificación ya que es una llave primaria o identificador único y no es una variable ordinal de interés.
A continuación se evidencian los datos faltantes de manera explícita para decidir el manejo que se le dará a estos datos
miss_var_summary(raw_data)## # A tibble: 16 × 3
## variable n_miss pct_miss
## <chr> <int> <num>
## 1 ca 611 66.4
## 2 thal 486 52.8
## 3 slope 309 33.6
## 4 fbs 90 9.78
## 5 oldpeak 62 6.74
## 6 trestbps 59 6.41
## 7 thalch 55 5.98
## 8 exang 55 5.98
## 9 chol 30 3.26
## 10 restecg 2 0.217
## 11 id 0 0
## 12 age 0 0
## 13 sex 0 0
## 14 dataset 0 0
## 15 cp 0 0
## 16 num 0 0gg_miss_var(raw_data)
Datos faltantes por variable
Al evidenciar el peso de los datos faltantes se decide utilizar la imputación hotdeck para las variables con más de 2% de datos faltantes. Sin embargo, para la variable restecg se decide no incluirla en la imputación al no tener un peso considerable de datos faltantes.
Transformación, Imputación y Limpieza
Antes de realizar el manejo de datos faltantes, se realiza una transformación de las variables para definir el tipo de variable y cómo se manejará a lo largo del análisis. Esto se realiza mediante la función mutate() y las funciones as.factor(), as.integer(), as.double().
raw_data_transformation <- raw_data %>%
remove_rownames() %>%
column_to_rownames(var= "id")%>%
mutate(
across(where(is.character),
as.factor
)
)%>%
mutate(
ca = as.factor(ca),
num = as.factor(num),
age = as.integer(age),
trestbps = as.integer(trestbps),
chol = as.integer(chol),
thalch = as.integer(thalch),
oldpeak = as.double(oldpeak)
)Con este paso se establece que las variables tipo character serán consideradas como variables categoría, y las variables discretas serán tipo integer.
Ahora sí se realizará la imputación de los datos mediante la función hotdeck()
raw_data_imp <- hotdeck(
raw_data_transformation,
variable = c("ca", "thal", "slope", "fbs", "oldpeak", "trestbps", "thalch", "exang", "chol"),
domain_var = c("sex", "cp", "num"),
ord_var = c("age", "restecg")
)
miss_var_summary(raw_data_imp)## # A tibble: 24 × 3
## variable n_miss pct_miss
## <chr> <int> <num>
## 1 ca 9 0.978
## 2 thal 3 0.326
## 3 restecg 2 0.217
## 4 fbs 1 0.109
## 5 slope 1 0.109
## 6 age 0 0
## 7 sex 0 0
## 8 dataset 0 0
## 9 cp 0 0
## 10 trestbps 0 0
## # ℹ 14 more rowsDe esta manera se evidencia que los datos faltantes luego de la imputación son menores al 1%, es importante mencionar que aunque se realizó una imputación siguen habiendo datos faltantes debido a que no se encontraron vecinos lo suficientemente cercanos para poder reemplazar esos datos faltantes.
Sin embargo, al ser estos datos menores al 2% establecido anteriormente, son datos que pueden eliminarse y no generarán un gran impacto. Para eliminar estos datos se utilizará la función drop_na() y adicionalmente, se seleccionarán solo las variables que se usarán para el análisis del conjunto de datos.
raw_data_final <- raw_data_imp %>%
select(-ends_with("_imp")) %>%
drop_na()
gg_miss_var(raw_data_final)
miss_var_summary(raw_data_final)## # A tibble: 15 × 3
## variable n_miss pct_miss
## <chr> <int> <num>
## 1 age 0 0
## 2 sex 0 0
## 3 dataset 0 0
## 4 cp 0 0
## 5 trestbps 0 0
## 6 chol 0 0
## 7 fbs 0 0
## 8 restecg 0 0
## 9 thalch 0 0
## 10 exang 0 0
## 11 oldpeak 0 0
## 12 slope 0 0
## 13 ca 0 0
## 14 thal 0 0
## 15 num 0 0Con este paso la base de datos tendrá solo las variables que se mencionaron en la categorización y adicionalmente, ya la base no contará con datos faltantes, esto se evidencia en la validación que se realiza al final.
Descripción de Variables Numéricas Clave
Para poder realizar esta descripción estadística de las variables clave se agrupan las variables en una nueva variable y se define la función coeficiente de variación que serán usados en el resumen estadístico de estas variables clave
vars_num <- c("age", "trestbps", "chol", "thalch", "oldpeak")
cv <- function(x) 100 * sd(x) / mean(x)Con estas definiciones ya se puede generar el bloque de código que permitirá describir las medidas de tendencia y dispersión. Esto se realizará mediante el uso de las funciones summarise() y across() para resumir todas las variables elegidas anteriormente.Y finalmente, se usarán las funciones pivot_longer() y pivot_wider() para generar una tabla con este resumen.
descripcion <- raw_data_final |>
summarise(
across(
all_of(vars_num),
list(
n = \(x) sum(!is.na(x)),
media = \(x) mean(x),
mediana = \(x) median(x),
sd = \(x) sd(x),
ric = \(x) IQR(x),
cv = \(x) cv(x),
min = \(x) min(x),
max = \(x) max(x)
),
.names = "{.col}__{.fn}"
)
) |>
pivot_longer(everything(),
names_to = c("variable", "estadistico"),
names_sep = "__") |>
pivot_wider(names_from = estadistico, values_from = value) |>
mutate(across(where(is.numeric), \(x) round(x, 2)))
print(descripcion)## # A tibble: 5 × 9
## variable n media mediana sd ric cv min max
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 age 909 53.5 54 9.39 13 17.6 28 77
## 2 trestbps 909 132. 130 19.6 20 14.8 0 200
## 3 chol 909 201. 224 110. 92 55.0 0 603
## 4 thalch 909 137. 140 25.8 36 18.8 60 202
## 5 oldpeak 909 0.9 0.6 1.1 1.6 121. -2.6 6.2Con este análisis descriptivo se identifica que la edad promedio de
los participantes del estudio es de 53.5 y es un dato bastante cercano a
la mediana, 54, la distribución presenta algunos valores bajos que
reducen ligeramente la media, pero no generan un sesgo fuerte. Esto se
puede evidenciar con el coeficiente de variación del 17%
lo que indica una variabilidad moderada. Sin embargo, se evidencia que
hay una dispersión bastante elevada en los datos, de manera que hay una
separación de casi un poco más de 9 años con la media y así mismo una
separación entre el 25% de la muestra y el 75% de 13 años.Por último, se
identifica que los participantes estaban en un rango de edades entre 28
y 77 años.
Es importante resaltar que las variables con mayor dispersión resultan ser chol y oldpeak, es decir, el nivel de colesterol sérico en la sangre y la depresión del segmento ST respectivamente.Esto indica que son variables con una alta variación y una gran posibilidad de datos atípicos en la muestra, es decir, que no habría una homogeneidad entre los participantes del estudio.
Teniendo esto en cuenta, se realiza un histograma para estas dos variables para identificar la distribución de los datos y se utiliza la regla de la raíz cuadrada para determinar el número de columnas para el histograma.
ggplot(raw_data_final, aes(x = chol)) +
geom_histogram(bins = ceiling(sqrt(nrow(raw_data_final))), fill = col_azul, color = "black") +
labs(title = "Distribución del colesterol (chol)",
x = "Colesterol (mg/dl)", y = "Frecuencia")
Revisando el histograma sobre el nivel del colesterol, se identifica que
tiene una distribución casi normal, pero hay un dato atípico con una
alta frecuencia indicando que el colesterol era de 0mg/cl, esto es
fisiológicamente imposible y pueden interpretarse como error de
registro. Debido a este hallazgo, se revisan las demás variables donde
el 0 no pueda ser fisiológicamente posible, y se encuentra que también
el trestbps, tiene datos en 0, esto se evidencia en el valor mínimo
obtenido en la descripción que se realizó al inicio. Mantener estos
datos en la muestra puede sesgar los resultados, debido a esto se
realizará una segunda limpieza para excluir estos datos.
ggplot(raw_data_final, aes(x = oldpeak)) +
geom_histogram(bins = ceiling(sqrt(nrow(raw_data_final))), fill = col_azul, color = "black") +
labs(title = "Distribución de oldpeak",
x = "Depresión ST (mm)", y = "Frecuencia")
Para el caso del oldpeak, también se evidencia que la mayoría de los
pacientes presentaron ausencia de depresión del segmento ST, estos datos
si son clínicamente válidos y se pueden mantener en la muestra. Sin
embargo, se identifican datos menores a 0, estos datos no son válidos
clínicamente debido a que la variable solo mide si existe o no una
depresión en el segmento ST, esta no puede medir una elevación que sería
el significado de valores positivos.
Para esta limpieza de los datos, se realiza un filtro en la base de datos en donde solo se muestren los datos en donde chol y trestbps sea diferente a 0, y oldpeak sea mayor o igual a 0.
raw_data_final <- raw_data_final %>%
filter(chol != 0, trestbps != 0, oldpeak >= 0)Luego de esta limpieza se eliminaron 173 filas, esto representa casi el 20% de los datos del dataset original. Sin embargo, esta decisión se consideró necesaria para garantizar una veracidad clínica y un estudio estadístico con validez médica.
Al finalizar la segunda limpieza de los datos, se realiza nuevamente el análisis descriptivo de las variables numéricas claves usando el mismo código usado para la primera descripción de los datos.
descripcion <- raw_data_final |>
summarise(
across(
all_of(vars_num),
list(
n = \(x) sum(!is.na(x)),
media = \(x) mean(x),
mediana = \(x) median(x),
sd = \(x) sd(x),
ric = \(x) IQR(x),
cv = \(x) cv(x),
min = \(x) min(x),
max = \(x) max(x)
),
.names = "{.col}__{.fn}"
)
) |>
pivot_longer(everything(),
names_to = c("variable", "estadistico"),
names_sep = "__") |>
pivot_wider(names_from = estadistico, values_from = value) |>
mutate(across(where(is.numeric), \(x) round(x, 2)))
print(descripcion)## # A tibble: 5 × 9
## variable n media mediana sd ric cv min max
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 age 736 52.8 54 9.5 13 18.0 28 77
## 2 trestbps 736 133. 130 18.0 20 13.5 92 200
## 3 chol 736 247. 239 59.8 66.2 24.2 85 603
## 4 thalch 736 141. 142 24.8 38 17.6 69 202
## 5 oldpeak 736 0.91 0.5 1.1 1.5 121. 0 6.2Con esta nueva descripción de las variables se evidencia una reducción significativa de la dispersión de los datos para la variable chol, donde el coeficiente de variación pasó de 55% a 24,2%. Sigue habiendo presencia de datos atípicos a la derecha los cuales desplazan la media y generan una cola a la derecha. Sin embargo, no se evidencia un impacto significativo en el resto de las variables.
Se aumentó un poco la dispersión para la edad, un aumento de 0.4% según el CV, algo similar sucedió para las variables trestbps y thalch en donde la dispersión se disminuyó un 1.3% y 1.2% respectivamente.Sin embargo, en el caso del oldpeak, no se evidencia un cambio, se sigue manteniendo la misma dispersión.
ggplot(raw_data_final, aes(x = chol)) +
geom_histogram(bins = ceiling(sqrt(nrow(raw_data_final))), fill = col_turquesa, color = "black") +
labs(title = "Distribución del colesterol (chol)",
x = "Colesterol (mg/dl)", y = "Frecuencia")
ggplot(raw_data_final, aes(x = oldpeak)) +
geom_histogram(bins = ceiling(sqrt(nrow(raw_data_final))), fill = col_turquesa, color = "black") +
labs(title = "Distribución de oldpeak",
x = "Depresión ST (mm)", y = "Frecuencia")
Categorización por Edad y Enfermedad
Adicionalmente, para el análisis se crearán 2 nuevas variables categóricas que permitan analizar la población por rangos de edad y simplificar si presenta o no alguna enfermedad cardíaca. Esto se realizará mediante la función mutate() y así mismo, se usará la función case_when() para poder definir los grupos categóricos que representarán a estas variables.
raw_data_categorized <- raw_data_final |>
mutate(
age_cat = case_when(
age < 40 ~ "< 40",
age < 50 ~ "40 - 49",
age < 60 ~ "50 - 59",
age < 70 ~ "60 - 69",
.default = ">= 70"),
num_cat = case_when(
num == 0 ~ "No presenta",
.default = "Si presenta"),
age_cat = factor(age_cat,
levels = c("< 40", "40 - 49", "50 - 59", "60 - 69", ">= 70")),
num_cat = factor(num_cat,
levels = c("No presenta", "Si presenta"))
)
raw_data_categorized %>%
select(age, sex, num, age_cat, num_cat) %>%
head(20)## age sex num age_cat num_cat
## 1 63 Male 0 60 - 69 No presenta
## 2 67 Male 2 60 - 69 Si presenta
## 3 67 Male 1 60 - 69 Si presenta
## 4 37 Male 0 < 40 No presenta
## 5 41 Female 0 40 - 49 No presenta
## 6 56 Male 0 50 - 59 No presenta
## 7 62 Female 3 60 - 69 Si presenta
## 8 57 Female 0 50 - 59 No presenta
## 9 63 Male 2 60 - 69 Si presenta
## 10 53 Male 1 50 - 59 Si presenta
## 11 57 Male 0 50 - 59 No presenta
## 12 56 Female 0 50 - 59 No presenta
## 13 56 Male 2 50 - 59 Si presenta
## 14 44 Male 0 40 - 49 No presenta
## 15 52 Male 0 50 - 59 No presenta
## 16 57 Male 0 50 - 59 No presenta
## 17 48 Male 1 40 - 49 Si presenta
## 18 54 Male 0 50 - 59 No presenta
## 19 48 Female 0 40 - 49 No presenta
## 20 49 Male 0 40 - 49 No presentaSe presentan las primeras 20 filas de algunas de las columnas con el objetivo de que se puedan ver las nuevas variables que se crearon para poder categorizar más adelante el análisis y poder realizar comparaciones.
Descripción por agrupación por variable objetivo
Age vs Num
Para realizar un análisis por agrupación para la edad, se utiliza la función summarise() y se indican las medidas que se desean realizar a los datos. Finalmente, se determinar la variable por la cual se agrupará el análisis siendo la variable num y num_cat. Este proceso se repetirá para las variables numéricas claves determinadas anteriormente.
resumen_age_target <- raw_data_categorized |>
summarise(
n = n(),
media = mean(age),
mediana = median(age),
sd = sd(age),
ric = IQR(age),
cv = sd(age)/mean(age) * 100,
brecha = mean(age) - median(age),
min = min(age),
max = max(age),
.by = num
) |>
mutate(across(where(is.numeric), \(x) round(x, 2))) |>
arrange(desc(mediana))
resumen_age_target_cat <- raw_data_categorized |>
summarise(
n = n(),
media = mean(age),
mediana = median(age),
sd = sd(age),
ric = IQR(age),
cv = sd(age)/mean(age) * 100,
brecha = mean(age) - median(age),
min = min(age),
max = max(age),
.by = num_cat
) |>
mutate(across(where(is.numeric), \(x) round(x, 2))) |>
arrange(desc(mediana))
print(resumen_age_target)## num n media mediana sd ric cv brecha min max
## 1 4 22 61.00 61.5 8.12 6.75 13.31 -0.50 38 77
## 2 2 63 59.81 60.0 7.03 7.50 11.75 -0.19 42 74
## 3 3 65 59.09 59.0 8.40 11.00 14.21 0.09 39 77
## 4 1 196 52.84 54.0 8.46 10.25 16.01 -1.16 31 75
## 5 0 390 50.18 51.0 9.30 13.00 18.54 -0.82 28 76print(resumen_age_target_cat)## num_cat n media mediana sd ric cv brecha min max
## 1 Si presenta 346 55.80 57 8.84 12 15.83 -1.20 31 77
## 2 No presenta 390 50.18 51 9.30 13 18.54 -0.82 28 76De esta manera se evidencia que hay un mayor número de pacientes sanos en el reporte. Así mismo, se identifica que la mayoría de los enfermos están en una etapa 1 de severidad, aunque son el grupo con una brecha mayor de -1.16, lo que indica que hay algunos valores atípicos a la izquierda desplazando la media. Sin embargo, el CV suele ser muy similar entre cada grupo y ninguno sobrepasa el 20% de variabilidad, esto indica que la muestra es bastante homogénea.
Para evidenciar esto, se realiza un gráfico de boxplot y se presenta a continuación.
ggplot(raw_data_categorized, aes(x = num_cat, y = age, fill = num_cat)) +
geom_boxplot() +
labs(title = "Distribución de edad según presencia de enfermedad",
x = "Enfermedad", y = "Edad")
Trestbps vs Num
A continuación se presenta el análisis de la presión arterial en reposo igualmente agrupada por la variable objetivo.
resumen_trestbps_target <- raw_data_categorized |>
summarise(
n = n(),
media = mean(trestbps),
mediana = median(trestbps),
sd = sd(trestbps),
ric = IQR(trestbps),
cv = sd(trestbps)/mean(trestbps) * 100,
brecha = mean(trestbps) - median(trestbps),
min = min(trestbps),
max = max(trestbps),
.by = num
) |>
mutate(across(where(is.numeric), \(x) round(x, 2))) |>
arrange(desc(mediana))
resumen_trestbps_target_cat <- raw_data_categorized |>
summarise(
n = n(),
media = mean(trestbps),
mediana = median(trestbps),
sd = sd(trestbps),
ric = IQR(trestbps),
cv = sd(trestbps)/mean(trestbps) * 100,
brecha = mean(trestbps) - median(trestbps),
min = min(trestbps),
max = max(trestbps),
.by = num_cat
) |>
mutate(across(where(is.numeric), \(x) round(x, 2))) |>
arrange(desc(mediana))
print(resumen_trestbps_target)## num n media mediana sd ric cv brecha min max
## 1 4 22 146.50 147.5 23.71 32.75 16.19 -1.00 104 190
## 2 3 65 137.02 136.0 19.02 30.00 13.88 1.02 100 200
## 3 2 63 136.33 134.0 16.69 20.00 12.24 2.33 100 180
## 4 0 390 130.31 130.0 16.73 20.00 12.84 0.31 94 190
## 5 1 196 134.08 130.0 18.60 25.00 13.87 4.08 92 200print(resumen_trestbps_target_cat)## num_cat n media mediana sd ric cv brecha min max
## 1 Si presenta 346 135.83 132 18.87 30 13.89 3.83 92 200
## 2 No presenta 390 130.31 130 16.73 20 12.84 0.31 94 190Se evidencia que no hay una gran diferencia entre la media de los pacientes sanos y los pacientes enfermos. Ambos grupos presentan medias que indican una tendencia a la hipertensión, en donde los sanos tuvieron presiones promedio de 130.31 y los pacientes enfermos presentaron presiones arteriales de 135.83. Sin embargo, en el caso de los pacientes enfermos, se identifica una brecha de 3.83, esto indica que hubo datos atípicos más extremos hacia la derecha indicando una mayor presión arterial.
Aún así, la dispersión es moderada, el grupo de los pacientes sanos tuvo un CV de 12.85% y el de enfermos de 13.91%. Lo que indica que es una muestra bastante homogénea, esto se refleja en el gráfico de cajas que se presenta a continuación
ggplot(raw_data_categorized, aes(x = num_cat, y = trestbps, fill = num_cat)) +
geom_boxplot() +
labs(title = "Distribución de la presión arterial en reposo",
x = "Enfermedad", y = "Presión arterial (mmHg)")
Thalch vs Num
En esta sección se analiza la máxima frecuencia cardíaca alcanzada por los pacientes durante una prueba de esfuerzo, para esta sección se esperarían frecuencias cardíacas más altas en los pacientes sanos.
resumen_thalch_target <- raw_data_categorized |>
summarise(
n = n(),
media = mean(thalch),
mediana = median(thalch),
sd = sd(thalch),
ric = IQR(thalch),
cv = sd(thalch)/mean(thalch) * 100,
brecha = mean(thalch) - median(thalch),
min = min(thalch),
max = max(thalch),
.by = num
) |>
mutate(across(where(is.numeric), \(x) round(x, 2))) |>
arrange(desc(mediana))
resumen_thalch_target_cat <- raw_data_categorized |>
summarise(
n = n(),
media = mean(thalch),
mediana = median(thalch),
sd = sd(thalch),
ric = IQR(thalch),
cv = sd(thalch)/mean(thalch) * 100,
brecha = mean(thalch) - median(thalch),
min = min(thalch),
max = max(thalch),
.by = num_cat
) |>
mutate(across(where(is.numeric), \(x) round(x, 2))) |>
arrange(desc(mediana))
print(resumen_thalch_target)## num n media mediana sd ric cv brecha min max
## 1 0 390 149.44 152.0 23.55 33.00 15.76 -2.56 69 202
## 2 2 63 129.83 134.0 20.44 25.50 15.75 -4.17 71 170
## 3 1 196 132.40 130.5 23.47 34.25 17.72 1.90 82 195
## 4 3 65 128.17 128.0 21.76 28.00 16.98 0.17 73 173
## 5 4 22 131.77 126.5 22.16 23.00 16.81 5.27 84 182print(resumen_thalch_target_cat)## num_cat n media mediana sd ric cv brecha min max
## 1 No presenta 390 149.44 152 23.55 33 15.76 -2.56 69 202
## 2 Si presenta 346 131.10 130 22.52 32 17.18 1.10 71 195Luego de realizar el análisis, se comprueba la hipótesis, los pacientes sanos presentan una frecuencia cardiaca mayor con una media de 149.44, aún así, se identifica que hay una brecha de -2.56 indicando una cola a la izquierda, siendo pacientes sanos con frecuencias cardíacas bastante bajas. Esto se puede comprobar revisando la frecuencia mínima registrada, siendo esta de 69bpm, siendo la más baja entre todos los grupos de pacientes, incluyendo los pacientes enfermos.
Así mismo, se identifica que la mayor brecha se presenta en pacientes con una severidad tipo 2, en donde se registra un -4.17.Esto es un poco atípico si se tiene en cuenta que la edad de estos pacientes es de 42 a 74 años y presenta la menor variabilidad en los grupos de edades, su CV es de 11.75%.Esto podría indicar que la capacidad funcional de estos pacientes esté más comprometida que en los otros niveles de severidad pues registran frecuencias cardíacas más bajas de lo esperado teóricamente para estas edades. Teóricamente se esperarían frecuencias cardíacas entre 146bpm y 178bpm y registran una mediana de 134bpm.
Sin embargo, en términos generales, los pacientes enfermos presentan resultados esperados, y aunque tienen un mayor CV (17.18%) no se supera el 20% de variabilidad y se encuentra una cola a la derecha registrando una brecha de 1.10.
Como en los análisis anteriores, se presenta el gráfico de boxplot para mostrar la dispersión de ambos grupos, enfermos y no enfermos.
ggplot(raw_data_categorized, aes(x = num_cat, y = thalch, fill = num_cat)) +
geom_boxplot() +
labs(title = "Distribución de la frecuencia cardíaca durante la prueba de esfuerzo",
x = "Enfermedad", y = "Frecuencia cardíaca (bpm)")
Oldpeak vs Num
Finalmente, se presenta el análisis de la depresión del segmento ST, es decir, se analiza si el corazón recibe suficiente oxígeno durante el esfuerzo, esto puede indicar presencia de isquemia miocárdica.
resumen_oldpeak_target <- raw_data_categorized |>
summarise(
n = n(),
media = mean(oldpeak),
mediana = median(oldpeak),
sd = sd(oldpeak),
ric = IQR(oldpeak),
cv = sd(oldpeak)/mean(oldpeak) * 100,
brecha = mean(oldpeak) - median(oldpeak),
min = min(oldpeak),
max = max(oldpeak),
.by = num
) |>
mutate(across(where(is.numeric), \(x) round(x, 2))) |>
arrange(desc(mediana))
resumen_oldpeak_target_cat <- raw_data_categorized |>
summarise(
n = n(),
media = mean(oldpeak),
mediana = median(oldpeak),
sd = sd(oldpeak),
ric = IQR(oldpeak),
cv = sd(oldpeak)/mean(oldpeak) * 100,
brecha = mean(oldpeak) - median(oldpeak),
min = min(oldpeak),
max = max(oldpeak),
.by = num_cat
) |>
mutate(across(where(is.numeric), \(x) round(x, 2))) |>
arrange(desc(mediana))
print(resumen_oldpeak_target)## num n media mediana sd ric cv brecha min max
## 1 4 22 2.55 2.55 1.22 1.58 47.65 0.00 0 4.4
## 2 3 65 1.94 2.00 1.33 1.80 68.38 -0.06 0 6.2
## 3 2 63 1.50 1.50 1.16 2.05 77.65 0.00 0 4.0
## 4 1 196 1.19 1.00 1.02 2.00 85.06 0.19 0 5.0
## 5 0 390 0.41 0.00 0.71 0.60 173.27 0.41 0 4.2print(resumen_oldpeak_target_cat)## num_cat n media mediana sd ric cv brecha min max
## 1 Si presenta 346 1.48 1.5 1.18 1.5 80.24 -0.02 0 6.2
## 2 No presenta 390 0.41 0.0 0.71 0.6 173.27 0.41 0 4.2Para esta variable, se esperaba que los pacientes sanos tuvieran valores cercanos a 0 lo que indica que no hay presencia de isquemia miocárdica, esta hipótesis es correcta nuevamente, la mediana para estos pacientes fue de 0. Sin embargo, hay datos atípicos en donde el valor máximo registrado fue de 4.2 desplazando así la media y generando un coeficiente de variación bastante elevado del 173.27%.
También es importante resaltar que el CV es demasiado elevado para todos los grupos teniendo así una muestra completamente heterogénea. Lo cual no permite establecer un patrón claro para el comportamiento de esta variable en pacientes con o sin enfermedad coronaria.
Finalmente, se presenta el gráfico de boxplot en donde se puede evidenciar que hay un gran número de datos atípicos en los pacientes sanos, siendo esto lo que explica el alto CV que se mencionó anteriormente. Así mismo, también se ven los casos atípicos de los pacientes enfermos y resultand siendo casos con isquemias severas superando los 4mm e incluso los 6mm.
ggplot(raw_data_categorized, aes(x = num_cat, y = oldpeak, fill = num_cat)) +
geom_boxplot() +
labs(title = "Distribución de la depresión del ST",
x = "Enfermedad", y = "Depresión del ST (mm)")
## Tabla de contingencia para variables categóricas
Sex vs Num
A continuación se realiza el análisis de las variables categóricas respecto a la variable objetivo para identificar tendencias respecto al sexo. Para esto se realiza una tabla cruzada entre el sexo y la variable objetivo.
frec_sex <- table(raw_data_categorized[,"sex"])
print(round(addmargins(100*prop.table(frec_sex)),2))##
## Female Male Sum
## 24.32 75.68 100.00tc_sex_num <- table(raw_data_categorized$num_cat, raw_data_categorized$sex)
print(round(addmargins(tc_sex_num),2))##
## Female Male Sum
## No presenta 143 247 390
## Si presenta 36 310 346
## Sum 179 557 736print(round(addmargins(100*prop.table(tc_sex_num)),2))##
## Female Male Sum
## No presenta 19.43 33.56 52.99
## Si presenta 4.89 42.12 47.01
## Sum 24.32 75.68 100.00Con este análisis se evidencia una relación de 1:1.25 para los hombres, en donde por cada 4 hombres sanos hay 5 hombres enfermos. En el caso de las mujeres, se identifica una realción de 4:1, en donde por 4 mujeres sanas hay 1 mujer enferma. Teniendo en cuenta esta relaciones, a pesar que el grupo muestral es bastante disparejo teniendo un 75.68% conformado por hombres y un 24.32% conformado por mujeres, de acuerdo a las razones calculadas, se evidencia que los hombres son más propensos a enfermedades cardíacas.
A continuación se muestra el perfil de los grupos enfermos y no enfermos en mujeres y hombres.
ggplot(raw_data_categorized, aes(x = sex, fill = num_cat)) +
geom_bar(position = "fill") +
geom_hline(yintercept = c(0.193, 0.812), linetype = "dashed",
colour = "grey30", linewidth = 0.4) +
scale_y_continuous(labels = scales::percent) +
scale_fill_manual(values = c(col_verde, col_rojo, col_turquesa)) +
labs(title = "Perfil de enfermedad cardíaca por cada sexo",
subtitle = "Líneas punteadas: cortes del perfil marginal (19.3% / 18.8%)",
x = NULL, y = "Porcentaje dentro del sexo", fill = "Enfermedad Cardíaca")
De esta manera se evidencia que entre todo el grupo de mujeres casi el
80% de ellas no presenta enfermedad y el 20% se encuentra enferma. Caso
contrario a los hombres en donde casi el 55% de los hombres presenta
enfermedad cardíaca y el 45% restante no la presenta.
CP vs Num
De la misma manera se realiza el análisis para el tipo de dolor en el pecho y la presencia de enfermedad cardíaca.
frec_cp <- table(raw_data_categorized[,"cp"])
print(round(addmargins(100*prop.table(frec_cp)),2))##
## asymptomatic atypical angina non-anginal typical angina Sum
## 50.14 22.69 22.28 4.89 100.00tc_cp_num <- table(raw_data_categorized$num_cat, raw_data_categorized$cp)
print(round(addmargins(tc_cp_num),2))##
## asymptomatic atypical angina non-anginal typical angina Sum
## No presenta 96 146 122 26 390
## Si presenta 273 21 42 10 346
## Sum 369 167 164 36 736print(round(addmargins(100*prop.table(tc_cp_num)),2))##
## asymptomatic atypical angina non-anginal typical angina Sum
## No presenta 13.04 19.84 16.58 3.53 52.99
## Si presenta 37.09 2.85 5.71 1.36 47.01
## Sum 50.14 22.69 22.28 4.89 100.00De esta manera se puede evidenciar que el 50.14% de los pacientes fueron asintomáticos, y el dolor de pecho menos frecuente en los pacientes fue dolor anginoso típico con el 4.89% de la muestra. Para los otros dos dolores se evidenciaron resultados muy similares de manera que el dolor anginoso atípico se presentó en el 22.69% de los pacientes y el dolor no anginoso se presentó en el 22.28% restante.
Así mismo, se identifica que la mayoría de pacientes asintomáticos sí presentaban alguna enfermedad cardíaca. Mientras que todos los pacientes que sí presentaron algún dolor torácico no presentaban enfermedad cardíaca a excepción de unos pocos. Esto puede indicar que aquellos pacientes que presentaban algún tipo de dolor pudieron detectar a tiempo el inicio de una enfermedad cardíaca para prevenirla, mientras que los asíntomáticos al no presentar signos de alerta, terminaron con una enfermedad cardíaca en su mayoría.
raw_data_cp_filter <- raw_data_categorized %>%
filter(cp == "asymptomatic")
tc_cp_asym_num <- table(raw_data_cp_filter$num)
print(round(addmargins(tc_cp_asym_num),2))##
## 0 1 2 3 4 Sum
## 96 148 54 53 18 369print(round(addmargins(100*prop.table(tc_cp_asym_num)),2))##
## 0 1 2 3 4 Sum
## 26.02 40.11 14.63 14.36 4.88 100.00Para poder comprobar esta hipótesis, se realizó el análisis de los pacientes asintomáticos por la gravedad de la enfermedad cardíaca que presentan y se encontró que la mayoría de pacientes están en una etapa 1 conformando al 40.11% de la muestra y el segundo grupo con mayor porcentaje de la población son aquellos que no presentan enfermedad cardíaca (26.02%).
ggplot(raw_data_categorized, aes(x = cp, fill = num_cat)) +
geom_bar(position = "fill") +
geom_hline(yintercept = c(0.193, 0.812), linetype = "dashed",
colour = "grey30", linewidth = 0.4) +
scale_y_continuous(labels = scales::percent) +
scale_fill_manual(values = c(col_verde, col_rojo, col_turquesa)) +
labs(title = "Perfil de enfermedad por dolor torácico",
subtitle = "Líneas punteadas: cortes del perfil marginal (19.3% / 18.8%)",
x = NULL, y = "Porcentaje dentro del síntoma", fill = "Enfermedad Cardíaca")
Finalmente, el gráfico respecto a los síntomas de dolor en el pecho nos
indica que estos dolores pudieron servir de alerta temprana para los
pacientes y poder identificar a tiempo los inicios de enfermedades
cardíacas para prevenirlas o tratarlas y evitar que avanzaran
rápidamente a etapas más severas.
Análisis de correlación
En esta sección se realizó el análisis de correlacion de las variables numéricas claves entre si para identificar relaciones lineales entre ellas. Esto se realiza mediante el método de Pearson usando la función cor().
resumen_correlacion <- raw_data_categorized %>%
select(age, trestbps, chol, thalch, oldpeak) %>%
cor(use = "complete.obs",
method = "pearson")
print(resumen_correlacion)## age trestbps chol thalch oldpeak
## age 1.00000000 0.25097278 0.08259641 -0.36379023 0.27677963
## trestbps 0.25097278 1.00000000 0.06155578 -0.11225903 0.19645606
## chol 0.08259641 0.06155578 1.00000000 -0.05288468 0.03866938
## thalch -0.36379023 -0.11225903 -0.05288468 1.00000000 -0.24329854
## oldpeak 0.27677963 0.19645606 0.03866938 -0.24329854 1.00000000vars <- raw_data_categorized %>% select(age, trestbps, chol, thalch, oldpeak)
cor_matrix <- cor(vars, use = "complete.obs", method = "pearson")
corrplot(cor_matrix,
method = "color",
col = colorRampPalette(c(col_rojo, "white", col_azul))(200),
type = "upper",
tl.col = "black",
tl.srt = 45)
Luego de la correlación se identifica que no existen correlaciones
lineales fuertes entre las variables. Sin embargo, hay una correlación
moderada (-0.36379) entre la edad y la frecuencia cardíaca máxima
alcanzada luego de una prueba de esfuerzo. Esta relación era la más
esperada desde un punto de vista clínico, teniendo en cuenta que una
forma teórica de calcular la frecuencia cardíaca de una persona se hace
mediante la fórmula:
bpm = 220 - edad
Esta relación es una relación negativa, lo cual indica que a mayor edad, menor es la frecuencia cardíaca que puede alcanzar la persona, así mismo se puede ver en la fórmula presentada anteriormente al tener la variable edad restando.
ggplot(raw_data_categorized, aes(x = age, y = thalch)) +
geom_point(alpha = 0.6, color = col_turquesa) +
geom_smooth(method = "lm", color = col_naranja, se = TRUE) +
labs(title = "Relación entre edad y frecuencia cardíaca máxima",
x = "Edad (años)",
y = "Frecuencia cardíaca máxima (bpm)")
Finalmente, en la gráfica anterior se presenta la correlación moderada
mencionada anteriormente entre la frecuencia cardíaca y la edad, siendo
esta de -0.36379.
Análisis probabilístico respecto a la variable objetivo
Por último, se realiza el informe para determinar la probabilidad de algunos casos con el fin de presentar el riesgo de enfermedad para hombres y mujeres, así como el riesgo segun la edad y que estos hallazgos puedan relacionarse con la práctica clínica.
###Probabilidades generales del estudio: A continuación se determinan las probabilidades generales de algunas variables que serán utilizadas más adelante para determinar los riesgos de enfermedad.
total_data <- nrow(raw_data_categorized)
raw_no_enfermedad <- raw_data_categorized %>%
filter(num_cat == "No presenta")
raw_enfermedad <- raw_data_categorized %>%
filter(num_cat == "Si presenta")
raw_no_enfermedad_hombre <- raw_no_enfermedad %>%
filter(sex == "Male")
raw_enfermedad_mujer <- raw_enfermedad %>%
filter(sex == "Female")
raw_enfermedad_40 <- raw_enfermedad %>%
filter(age_cat == "< 40")
raw_no_enfermedad_70 <- raw_no_enfermedad %>%
filter(age_cat == ">= 70")
total_no_enfermedad <- nrow(raw_no_enfermedad)
total_enfermedad <- nrow(raw_enfermedad)
p_no_enfermedad <- total_no_enfermedad/total_data * 100
p_enfermedad <- 100 - p_no_enfermedad
print(p_no_enfermedad)## [1] 52.98913print(p_enfermedad)## [1] 47.01087Estas variables creadas serán las que van a requerirse para poder determinar las probabilidades condicionadas de cuatro eventos que se identificaron en el estudio como atípicas o menos comúnes, la probabilidad de un hombre sano, de una mujer enferma, de que la enfermedad se presente en menores de 40 años y de que mayores de 70 años estén sanos.
###P(Hombre | Sano) Para el primer escenario queremos saber cuál sería la probabilidad de que un hombre sea sano a pesar de que sabes que es propenso a la enfermedad. Para esto usaremos la teoría de probabilidad condicional.
p_hombre_sano <- 100 * nrow(raw_no_enfermedad_hombre)/total_no_enfermedad
print(p_hombre_sano)## [1] 63.33333Luego de realizar el cálculo, se identifica que a pesar de que los hombres sean altamente impactados por la enfermedad, se tiene una probabilidad de 63.33% de que no llegue a tener enfermedad coronaria, es decir que por lo menos 6 de cada 10 personas son hombres sanos en la muestra.Aún así, este es un grupo de riesgo si tenemos en cuenta la relación 4:5 de hombres sanos vs hombres enfermos que se discutió anteriormente. ###P(Mujer | Enferma) Este mismo análisis se realizó para las mujeres pero en este caso enfermas.
p_mujer_enferma <- 100 * nrow(raw_enfermedad_mujer)/total_enfermedad
print(p_mujer_enferma)## [1] 10.40462De esta manera se identifica que efectivamente las mujeres son una población con muy bajo riesgo de enfermedad cardíaca, la probabilidad de que una mujer esté enferma dentro de la muestra es del 10.42%, es decir, 1 de cada 10 personas en el estudio es una mujer enferma. Y por eso mismo al comparar dentro del grupo total de mujeres, se encuentra que solo 20% de ellas aproximadamente están enfermas.
P(<40 años | Enfermo)
p_40_enfermo <- 100 * nrow(raw_enfermedad_40)/total_enfermedad
print(p_40_enfermo)## [1] 4.913295En este escenario identificamos que pueden haber 1 de cada 20 personas en la muestra con menos de 40 años que padezca una enfermedad coronaria. Esto confirma que a tempranas edades es muy poco común tener enfermedad cardíaca pero aún así es importante realizar chequeos rutinarios para prevenir estar dentro del 4.91% de personas jóvenes que padecen este tipo de enfermedades, especialmente cuando el grupo de personas asintomáticas fue el más frecuente en el estudio.
P(>= 70 años | Sano)
p_70_sano <- 100 * nrow(raw_no_enfermedad_70)/total_no_enfermedad
print(p_70_sano)## [1] 1.794872Finalmente, se identificó que la enfermedad cardíaca es demasiado frecuente en personas mayores a 70 años. En este caso solo 1 de cada 100 personas en la muestra era un paciente sano con más de 70 años. Esto indica que a futuro aunque es muy probable sufrir de estas enfermedades, si se mantiene un chequeo rutinario y se siguen las recomendaciones de los doctores, se podría llegar a estar en ese 1% de adultos mayores que no sufren del corazón.
Conclusiones
Luego de haber realizado este estudio se puede concluír que la enfermedad coronaria es una enfermedad bastante frecuente a medida que se envejece, así mismo, son enfermedades que se encuentra mayoritariamente presentes en hombres y pueden llegar a ser enfermedades silenciosas que no generan signos de alerta y pueden pasarse desapercibidas.
Teniendo en cuenta esto, es muy recomendable y especialmente para hombres, el realizar visitas al cardiólogo después de los 40 años de manera periódica. Esto no exime a las mujeres, pues aunque son una población de bajo riesgo, igualmente 1 de cada 10 personas podría ser una mujer con una enfermedad de este tipo, por lo cual también sería bueno que se realicen estos chequeos.
Nota sobre el uso de Inteligencia Artificial (IA):
En el desarrollo de este trabajo se utilizó Microsoft Copilot como apoyo complementario en tres aspectos específicos: (I) asistencia técnica en la programación en R mediante la corrección de errores de sintaxis y explicación de los errores presentados en la consola al crear el código; (II) interpretación clínica básica de los resultados estadísticos, especialmente descripción de los conceptos clínicos, descripción de las variables desde un punto de vista médico e interpretación de algunos valores para determinar la validez médica de los datos, como por ejemplo la justificación para la segunda limpieza de los datos donde el colesterol y la presión arterial en 0 y los valoresnegativos de oldpeak no presentaban validez clínica; y (III) revisión de cumplimientode todos los puntos del documento como fueron indicados en la guía de trabajo.