De los datos a la decisión: una estrategia de tamizaje cardiovascular dirigida por riesgo
Informe ejecutivo para la Junta Directiva — Indicadores de enfermedad cardíaca (CDC BRFSS 2020)
Juan José Silva Camargo · Paula Andrea López Rendón
24 de octubre de 2026
Resumen ejecutivo
Propósito (el norte). Darle a la Junta Directiva de un plan de salud regional de Estados Unidos la evidencia que necesita para rediseñar la forma de invitar a sus afiliados al programa de prevención cardiovascular: reemplazar las invitaciones por un solo criterio (un corte de edad o un único diagnóstico) por un puntaje de riesgo combinado, para que la capacidad limitada de cardiología encuentre la mayor cantidad de casos.
Idea central. Con el mismo número de invitaciones, un puntaje de riesgo combinado encuentra hasta 16 puntos porcentuales más casos de enfermedad cardíaca que cualquier regla de un solo criterio. La Junta debería aprobar un piloto por etapas de 12 meses para confirmarlo con la población del propio plan.
Lo que muestran los datos
- La carga está concentrada. El 8,6 % de los 319.795 adultos estadounidenses encuestados reporta enfermedad coronaria o infarto. Los adultos de 65 años o más son el 35 % de la población, pero concentran el 67 % de todos los casos.
- Las reglas de un solo criterio dejan casos por fuera. Invitar a todos los mayores de 65 encuentra cerca del 67 % de los casos; invitar al mismo número de personas ordenadas por el puntaje combinado encuentra cerca del 83 %.
- El puntaje funciona con 11 preguntas sencillas. Se compararon dos modelos sobre el mismo conjunto de prueba: la regresión logística (AUC de 0,84) superó a un bosque aleatorio más complejo (AUC de 0,78) y es más fácil de explicar, por lo que fue la elegida. Detecta cerca de 8 de cada 10 casos invitando a cerca de 3 de cada 10 adultos: aproximadamente 23 casos por cada 100 invitaciones, frente a 9 al azar.
- Planear con promedios se queda corto. Programar los días de tamizaje para el número promedio de casos deja cupos de cardiología insuficientes en cerca del 35 % de los días; planear con el percentil 95 (13 cupos por cada 100 pacientes) cubre el 95 % de los días.
- Significancia estadística no es relevancia gerencial. Con 320.000 registros, todas las pruebas salen “significativas”; el tamaño del efecto muestra qué diferencias importan realmente.
Decisión que se solicita a la Junta
- Aprobar un piloto de 12 meses en tres etapas de invitaciones basadas en el puntaje, con puntos de control (seguir / ajustar / parar) en los meses 3, 6 y 12. El piloto se detiene en el mes 3 si, con los datos del propio plan, el puntaje no supera a la regla actual por al menos 5 puntos porcentuales de casos encontrados con el mismo número de invitaciones.
- Adoptar una planeación de capacidad por percentiles para los días de tamizaje cardiológico.
Lo que este informe no afirma. Los datos son una encuesta nacional, no los afiliados del plan; el desenlace es enfermedad cardíaca ya diagnosticada, mientras que el tamizaje busca personas no diagnosticadas; y no hay datos de costos, así que el informe habla de eficiencia (casos por invitación), no de ahorro. El piloto está diseñado justamente para cerrar estos vacíos.
Más allá del piloto. El informe cierra con una hoja de ruta para transferir el método (no las cifras) al sistema de EPS de Colombia: los datos que usaría, cómo se mejoraría el desenlace y los errores que se deben esperar.
El tablero interactivo de la Junta que hace seguimiento a estos indicadores acompaña este informe: abrir el tablero de la Junta.
Marco estratégico: el modelo A³
El informe sigue el modelo A³ (Atención → Análisis → Acción): primero capta la atención con un problema gerencial, luego construye la evidencia y cierra con acciones concretas.
Atención: el problema gerencial
La enfermedad coronaria y el infarto están entre las principales causas de muerte en Estados Unidos y entre las condiciones que más recursos consumen: consultas de especialista, hospitalizaciones, cuidados intensivos y procedimientos de cateterismo. Un plan de salud no puede enviar a todos sus afiliados adultos a tamizaje cardiológico al mismo tiempo, así que los programas seleccionan a las personas un criterio a la vez: un corte de edad o un único diagnóstico, como la diabetes. La pregunta gerencial es si combinar los factores de riesgo en un solo puntaje encuentra más casos con la misma capacidad, y cuánta capacidad hay que planear.
Audiencia
La Junta Directiva decide; los gerentes proponen y ejecutan. La principal preocupación de la Junta es un programa que se quede por debajo de sus metas; por eso la propuesta es un piloto por etapas con puntos de control para seguir o parar.
| Audiencia | Qué le importa | Qué debe decidir o hacer |
|---|---|---|
| Junta Directiva del plan de salud regional | Resultados en salud, costos, cumplimiento de metas | Aprobar el piloto por etapas |
| Vicepresidencia de Salud Poblacional y Gestión del Riesgo | Encontrar temprano a los afiliados de alto riesgo | Proponer y ejecutar las invitaciones basadas en el puntaje |
| Vicepresidencia de Operaciones y Planeación de Capacidad | Cupos, personal y camas acordes con la demanda | Programar el personal de los días de tamizaje |
| Dirección Médica | Relevancia clínica, que no se escapen pacientes | Validar los criterios y las rutas de seguimiento |
Norte y objetivos
Objetivo general: usar los datos de enfermedad cardíaca del BRFSS 2020 para evaluar si un puntaje de riesgo combinado debería reemplazar las invitaciones por un solo criterio en un programa de prevención cardiovascular, y dimensionar la capacidad que requiere.
| Capítulo | Objetivo específico (pregunta de la Junta) | Métodos |
|---|---|---|
| 1. Análisis exploratorio de datos | ¿Dónde está la carga? Describir la población y ubicar dónde se concentra la enfermedad cardíaca | Calidad de datos, indicadores descriptivos, gráficos exploratorios |
| 2. Probabilidad y estadística aplicada | ¿Cuánta capacidad necesitamos y qué diferencias son reales? | Probabilidad empírica y condicional, simulación, pruebas de hipótesis, tamaños del efecto |
| 3. Modelos analíticos | ¿Podemos identificar a las personas de alto riesgo con preguntas sencillas? | Dos modelos (regresión logística frente a bosque aleatorio), validación cruzada, diagnósticos, AUC y sensibilidad |
| 4. Narrativa con datos | ¿Qué debe decidir la Junta y cómo se hará seguimiento? ¿El método se puede llevar a otro sistema? | Gráficos anotados, tablero interactivo, recomendaciones ejecutivas, hoja de ruta de transferencia a Colombia |
Indicadores de éxito del programa: el puntaje supera a la regla actual por ≥ 5 puntos porcentuales de casos encontrados con las mismas invitaciones; AUC ≥ 0,75 con los datos del propio plan; sensibilidad ≥ 70 %; ≤ 5 % de días de tamizaje con demanda insatisfecha.
# Hoja de ruta analítica: cómo cada capítulo alimenta la decisión final
DiagrammeR::grViz("
digraph roadmap {
graph [rankdir = LR, fontname = Helvetica]
node [shape = box, style = 'rounded,filled', fillcolor = '#E8EEF7',
fontname = Helvetica, fontsize = 11]
north [label = 'NORTE\\nPuntaje de riesgo combinado en vez de\\ninvitaciones por un solo criterio', fillcolor = '#1F78B4', fontcolor = white]
c1 [label = '1. Exploración\\n¿Dónde está la carga?']
c2 [label = '2. Probabilidad y estadística\\n¿Cuánta capacidad?\\n¿Qué diferencias importan?']
c3 [label = '3. Modelos analíticos\\n¿Quién tiene alto riesgo?']
c4 [label = '4. Narrativa y tablero\\n¿Qué debe decidir la Junta?']
dec [label = 'DECISIÓN DE LA JUNTA\\nPiloto por etapas de 12 meses +\\nplan de capacidad por percentiles', fillcolor = '#FBE3D0']
north -> c1 -> c2 -> c3 -> c4 -> dec
}
")1 Análisis exploratorio de datos
1.1 Los datos
Fuente: Personal Key Indicators of Heart Disease (Kaggle), construida a partir del Sistema de Vigilancia de Factores de Riesgo del Comportamiento (BRFSS) 2020 de los Centros para el Control y la Prevención de Enfermedades (CDC), una encuesta telefónica a adultos de Estados Unidos. Unidad de análisis: una fila = un adulto encuestado.
La base tiene 319.795 adultos y 18 variables. El desenlace es la enfermedad cardíaca: si la persona reporta haber tenido alguna vez enfermedad coronaria o infarto. Los predictores son cuatro variables numéricas y trece categóricas. Los nombres de las columnas y las respuestas vienen en inglés en los datos originales; en las tablas de este informe se muestran en español.
1.1.1 Estructura y calidad de los datos
# Diccionario de variables: nombre en los datos, qué mide, tipo y número de valores distintos
diccionario <- tribble(
~variable, ~descripcion,
"HeartDisease", "Enfermedad coronaria o infarto alguna vez (desenlace)",
"BMI", "Índice de masa corporal (kg/m²)",
"Smoking", "Ha fumado al menos 100 cigarrillos en su vida",
"AlcoholDrinking", "Consumo excesivo de alcohol",
"Stroke", "Ha tenido un accidente cerebrovascular (ACV)",
"PhysicalHealth", "Días de mala salud física en los últimos 30 días",
"MentalHealth", "Días de mala salud mental en los últimos 30 días",
"DiffWalking", "Dificultad seria para caminar o subir escaleras",
"Sex", "Sexo",
"AgeCategory", "Grupo de edad (13 grupos)",
"Race", "Raza o grupo étnico",
"Diabetic", "Diabetes (incluye prediabetes y diabetes gestacional)",
"PhysicalActivity", "Actividad física en los últimos 30 días",
"GenHealth", "Salud general autopercibida (5 niveles)",
"SleepTime", "Horas de sueño en 24 horas",
"Asthma", "Asma",
"KidneyDisease", "Enfermedad renal",
"SkinCancer", "Cáncer de piel"
)
diccionario |>
mutate(
tipo = if_else(map_lgl(variable, \(v) is.numeric(heart[[v]])), "Numérica", "Categórica"),
valores = map_int(variable, \(v) n_distinct(heart[[v]]))
) |>
tabla(col.names = c("Nombre en los datos", "Qué mide", "Tipo", "Valores distintos"),
caption = "Diccionario de variables")| Nombre en los datos | Qué mide | Tipo | Valores distintos |
|---|---|---|---|
| HeartDisease | Enfermedad coronaria o infarto alguna vez (desenlace) | Categórica | 2 |
| BMI | Índice de masa corporal (kg/m²) | Numérica | 3.604 |
| Smoking | Ha fumado al menos 100 cigarrillos en su vida | Categórica | 2 |
| AlcoholDrinking | Consumo excesivo de alcohol | Categórica | 2 |
| Stroke | Ha tenido un accidente cerebrovascular (ACV) | Categórica | 2 |
| PhysicalHealth | Días de mala salud física en los últimos 30 días | Numérica | 31 |
| MentalHealth | Días de mala salud mental en los últimos 30 días | Numérica | 31 |
| DiffWalking | Dificultad seria para caminar o subir escaleras | Categórica | 2 |
| Sex | Sexo | Categórica | 2 |
| AgeCategory | Grupo de edad (13 grupos) | Categórica | 13 |
| Race | Raza o grupo étnico | Categórica | 6 |
| Diabetic | Diabetes (incluye prediabetes y diabetes gestacional) | Categórica | 4 |
| PhysicalActivity | Actividad física en los últimos 30 días | Categórica | 2 |
| GenHealth | Salud general autopercibida (5 niveles) | Categórica | 5 |
| SleepTime | Horas de sueño en 24 horas | Numérica | 24 |
| Asthma | Asma | Categórica | 2 |
| KidneyDisease | Enfermedad renal | Categórica | 2 |
| SkinCancer | Cáncer de piel | Categórica | 2 |
# Control de calidad antes de cualquier análisis: faltantes y filas idénticas
tibble(
indicador = c("Filas (adultos)", "Variables", "Valores faltantes", "Filas idénticas"),
valor = c(nrow(heart), ncol(heart), sum(is.na(heart)), sum(duplicated(heart)))
) |>
tabla(col.names = c("Indicador", "Valor"), caption = "Control de calidad de los datos")| Indicador | Valor |
|---|---|
| Filas (adultos) | 319.795 |
| Variables | 18 |
| Valores faltantes | 0 |
| Filas idénticas | 18.078 |
# Distribución del desenlace: las clases están muy desbalanceadas
heart |>
count(HeartDisease) |>
mutate(HeartDisease = si_no(HeartDisease), porcentaje = n / sum(n) * 100) |>
tabla(digits = 1, col.names = c("Enfermedad cardíaca", "Personas", "%"),
caption = "Distribución del desenlace")| Enfermedad cardíaca | Personas | % |
|---|---|---|
| No | 292.422 | 91,4 |
| Sí | 27.373 | 8,6 |
Interpretación. No hay valores faltantes. Hay 18.078 filas idénticas (5,7 %); como los datos no tienen identificador de persona y la mayoría de preguntas son sí/no, personas distintas pueden dar exactamente las mismas respuestas, así que se conservaron. Las horas de sueño (1 a 24) y el IMC (12 a 94,9) incluyen algunos valores extremos poco plausibles; se conservaron, pero se tienen en cuenta al interpretar. Solo el 8,6 % de los adultos tiene el desenlace: las clases están desbalanceadas, y eso condiciona todas las decisiones posteriores (por ejemplo, por qué no se usa la exactitud para juzgar el modelo).
1.2 Indicadores descriptivos
Situación gerencial: antes de comparar grupos, la gerencia necesita los valores típicos y la variabilidad de los principales indicadores de salud.
# Indicadores del IMC con funciones de R base
tibble(
indicador = c("Media", "Mediana", "Desviación estándar", "Varianza", "Mínimo", "Máximo"),
valor = c(mean(heart$BMI), median(heart$BMI), sd(heart$BMI), var(heart$BMI),
min(heart$BMI), max(heart$BMI))
) |>
tabla(digits = 2, col.names = c("Indicador del IMC", "Valor"),
caption = "Índice de masa corporal (kg/m²)")| Indicador del IMC | Valor |
|---|---|
| Media | 28,33 |
| Mediana | 27,34 |
| Desviación estándar | 6,36 |
| Varianza | 40,40 |
| Mínimo | 12,02 |
| Máximo | 94,85 |
# Resumen de las cuatro variables numéricas
variables_numericas <- c(BMI = "IMC (kg/m²)", PhysicalHealth = "Días de mala salud física",
MentalHealth = "Días de mala salud mental", SleepTime = "Horas de sueño")
heart |>
select(all_of(names(variables_numericas))) |>
pivot_longer(everything(), names_to = "variable", values_to = "valor") |>
group_by(variable) |>
summarise(
minimo = min(valor),
q1 = quantile(valor, 0.25),
mediana = median(valor),
media = mean(valor),
q3 = quantile(valor, 0.75),
maximo = max(valor)
) |>
mutate(variable = unname(variables_numericas[variable])) |>
tabla(digits = 2,
col.names = c("Variable", "Mínimo", "Cuartil 1", "Mediana", "Media", "Cuartil 3", "Máximo"),
caption = "Resumen de las variables numéricas")| Variable | Mínimo | Cuartil 1 | Mediana | Media | Cuartil 3 | Máximo |
|---|---|---|---|---|---|---|
| IMC (kg/m²) | 12,02 | 24,03 | 27,34 | 28,33 | 31,42 | 94,85 |
| Días de mala salud mental | 0,00 | 0,00 | 0,00 | 3,90 | 3,00 | 30,00 |
| Días de mala salud física | 0,00 | 0,00 | 0,00 | 3,37 | 2,00 | 30,00 |
| Horas de sueño | 1,00 | 6,00 | 7,00 | 7,10 | 8,00 | 24,00 |
# Los mismos indicadores, separados según tenga o no enfermedad cardíaca
heart |>
group_by(HeartDisease) |>
summarise(
imc_media = mean(BMI),
imc_mediana = median(BMI),
sueno_media = mean(SleepTime),
dias_fisica = mean(PhysicalHealth),
dias_mental = mean(MentalHealth)
) |>
mutate(HeartDisease = si_no(HeartDisease)) |>
tabla(digits = 2,
col.names = c("Enfermedad cardíaca", "IMC promedio", "IMC mediano", "Horas de sueño",
"Días de mala salud física", "Días de mala salud mental"),
caption = "Indicadores según enfermedad cardíaca (promedios)")| Enfermedad cardíaca | IMC promedio | IMC mediano | Horas de sueño | Días de mala salud física | Días de mala salud mental |
|---|---|---|---|---|---|
| No | 28,22 | 27,26 | 7,09 | 2,96 | 3,83 |
| Sí | 29,40 | 28,34 | 7,14 | 7,81 | 4,64 |
1.2.1 Gráfico exploratorio
# Porcentaje de adultos con enfermedad cardíaca en cada grupo de edad
prevalence_age <- heart |>
group_by(AgeCategory) |>
summarise(prevalence = mean(HeartDisease == "Yes") * 100)
plot_age <- ggplot(prevalence_age,
aes(x = AgeCategory, y = prevalence,
text = paste0("Edad: ", etiqueta_edad(AgeCategory),
"<br>Prevalencia: ", num(prevalence), " %"))) +
geom_col(fill = "#3B528B") +
scale_x_discrete(labels = etiqueta_edad) +
labs(
title = "Adultos con enfermedad cardíaca por grupo de edad",
x = "Grupo de edad (años)",
y = "% con enfermedad cardíaca"
) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
ggplotly(plot_age, tooltip = "text") |> plotly_es()1.2.2 Interpretación
IMC. El IMC promedio es 28,3 kg/m², con una mediana de 27,3, una desviación estándar de 6,4 (varianza 40,4) y un rango de 12,0 a 94,9. Que la media sea mayor que la mediana indica una distribución con asimetría a la derecha, y el adulto promedio ya está en rango de sobrepeso (25–29,9).
Días de mala salud y sueño. En los días de mala salud física y mental la mediana es 0: la mayoría de adultos no reporta ninguno, pero un grupo reporta muchos (hasta 30), lo que sube los promedios (3,4 y 3,9 días). En este tipo de variables la mediana describe mejor a la persona típica que la media. El sueño promedio es de 7,1 horas.
Por grupo. Los adultos con enfermedad cardíaca reportan 7,8 días de mala salud física al mes frente a 3,0 del resto (2,6 veces más) y un IMC promedio mayor (29,4 frente a 28,2). Las diferencias en salud mental (4,6 frente a 3,8 días) y en sueño (7,1 horas en ambos grupos) son pequeñas. El gráfico exploratorio muestra que la prevalencia sube con fuerza con la edad, de 0,6 % a 22,6 %.
Para la gerencia: los días de mala salud física son un indicador sencillo de la carga de enfermedad: las personas con enfermedad cardíaca pierden casi 5 días más al mes, lo que puede traducirse en ausentismo y mayor uso de servicios. Limitación: todos los indicadores son autorreportados.
2 Probabilidad y estadística aplicada
2.1 Probabilidad aplicada
2.1.1 Selección aleatoria y espacio muestral
Situación gerencial: un programa de tamizaje cardiovascular recibe 100 pacientes. Cada uno puede tener o no enfermedad cardíaca (espacio muestral: {sí, no}). Con la probabilidad observada en la encuesta, simulamos cuántos casos llegarían.
# La semilla hace reproducible el azar: quien corra el informe obtiene el mismo resultado
set.seed(2026)
sample_space <- c("Yes", "No")
# Probabilidad observada en los datos: proporción de respuestas "Yes" (sí)
p_heart <- mean(heart$HeartDisease == "Yes")
screening <- sample(
sample_space,
size = 100,
replace = TRUE, # cada paciente es un nuevo sorteo
prob = c(p_heart, 1 - p_heart) # mismo orden que sample_space
)
tibble(
resultado = c("Con enfermedad cardíaca", "Sin enfermedad cardíaca"),
pacientes = c(sum(screening == "Yes"), sum(screening == "No"))
) |>
tabla(col.names = c("Resultado", "Pacientes (de 100)"),
caption = "Tamizaje simulado de 100 pacientes")| Resultado | Pacientes (de 100) |
|---|---|
| Con enfermedad cardíaca | 9 |
| Sin enfermedad cardíaca | 91 |
Muestra de auditoría con los datos reales: para auditar la información sin revisar los 319.795 registros, se seleccionan 1.000 adultos al azar.
set.seed(2026)
# replace = FALSE (valor por defecto): nadie puede ser seleccionado dos veces
selected_rows <- sample(nrow(heart), size = 1000)
audit_sample <- heart |> slice(selected_rows)
# Si ambas proporciones son cercanas, la muestra representa bien a los datos completos
tibble(
conjunto = c("Datos completos (319.795 adultos)", "Muestra aleatoria (1.000 adultos)"),
porcentaje = c(p_heart, mean(audit_sample$HeartDisease == "Yes")) * 100
) |>
tabla(digits = 1, col.names = c("Conjunto", "% con enfermedad cardíaca"),
caption = "Muestra de auditoría frente a los datos completos")| Conjunto | % con enfermedad cardíaca |
|---|---|
| Datos completos (319.795 adultos) | 8,6 |
| Muestra aleatoria (1.000 adultos) | 9,2 |
Interpretación
Tamizaje simulado. Con la probabilidad observada (8,6 %), la simulación de 100 pacientes tamizados produjo 9 casos, cerca de los 8,6 por cada 100 esperados. El número exacto cambia en cada simulación por el azar, así que la capacidad de tamizaje (por ejemplo, los cupos de cardiología) debe planearse con un rango, no con un solo número.
Muestra de auditoría. En la muestra aleatoria de 1.000 adultos, el 9,2 % tiene enfermedad cardíaca, frente al 8,6 % en los datos completos. La pequeña diferencia es variación muestral natural: una muestra aleatoria bien tomada reproduce a la población, lo que le permite a la gerencia auditar o estimar indicadores más rápido y a menor costo.
2.1.2 Probabilidades empíricas y condicionales
Situación gerencial: para priorizar los programas de prevención, la gerencia necesita saber en qué grupos se concentra la enfermedad cardíaca.
# Probabilidad simple: casos / total
freq <- table(heart$HeartDisease)
prob <- prop.table(freq)
tibble(
enfermedad = si_no(names(freq)),
frecuencia = as.vector(freq),
probabilidad = as.vector(prob)
) |>
tabla(digits = 3, col.names = c("Enfermedad cardíaca", "Frecuencia", "Probabilidad empírica"),
caption = "Probabilidad simple")| Enfermedad cardíaca | Frecuencia | Probabilidad empírica |
|---|---|---|
| No | 292.422 | 0,914 |
| Sí | 27.373 | 0,086 |
# margin = 1 calcula el % dentro de cada FILA, es decir, dentro de cada grupo:
# "entre los fumadores, ¿qué % tiene enfermedad cardíaca?"
tab_smoking <- table(heart$Smoking, heart$HeartDisease)
tab_stroke <- table(heart$Stroke, heart$HeartDisease)
tab_age <- table(heart$AgeCategory, heart$HeartDisease)
prob_condicional <- function(tab) {
porcentaje <- prop.table(tab, margin = 1) * 100
tibble(grupo = rownames(tab),
personas = as.vector(rowSums(tab)),
pct_con = as.vector(porcentaje[, "Yes"]))
}
bind_rows(
prob_condicional(tab_smoking) |>
mutate(grupo = if_else(grupo == "Yes", "Fumadores", "No fumadores")),
prob_condicional(tab_stroke) |>
mutate(grupo = if_else(grupo == "Yes", "Con ACV previo", "Sin ACV previo"))
) |>
tabla(digits = 1, col.names = c("Grupo", "Personas", "% con enfermedad cardíaca"),
caption = "Probabilidad condicional según tabaquismo y ACV")| Grupo | Personas | % con enfermedad cardíaca |
|---|---|---|
| No fumadores | 187.887 | 6,0 |
| Fumadores | 131.908 | 12,2 |
| Sin ACV previo | 307.726 | 7,5 |
| Con ACV previo | 12.069 | 36,4 |
prob_condicional(tab_age) |>
mutate(grupo = etiqueta_edad(grupo)) |>
tabla(digits = 1, col.names = c("Grupo de edad", "Personas", "% con enfermedad cardíaca"),
caption = "Probabilidad condicional según grupo de edad")| Grupo de edad | Personas | % con enfermedad cardíaca |
|---|---|---|
| 18-24 | 21.064 | 0,6 |
| 25-29 | 16.955 | 0,8 |
| 30-34 | 18.753 | 1,2 |
| 35-39 | 20.550 | 1,4 |
| 40-44 | 21.006 | 2,3 |
| 45-49 | 21.791 | 3,4 |
| 50-54 | 25.382 | 5,4 |
| 55-59 | 29.757 | 7,4 |
| 60-64 | 33.686 | 9,9 |
| 65-69 | 34.151 | 12,0 |
| 70-74 | 31.065 | 15,6 |
| 75-79 | 21.482 | 18,8 |
| 80 o más | 24.153 | 22,6 |
# Riesgo alto no siempre significa muchos casos: se compara el peso de cada grupo
# en la población y en el total de casos
age_65_plus <- c("65-69", "70-74", "75-79", "80 or older")
cases <- heart |> filter(HeartDisease == "Yes")
tibble(
indicador = c("Población con 65 años o más", "Casos con 65 años o más", "Casos con ACV previo"),
porcentaje = c(mean(heart$AgeCategory %in% age_65_plus),
mean(cases$AgeCategory %in% age_65_plus),
mean(cases$Stroke == "Yes")) * 100
) |>
tabla(digits = 1, col.names = c("Indicador", "%"), caption = "Riesgo frente a volumen de casos")| Indicador | % |
|---|---|
| Población con 65 años o más | 34,7 |
| Casos con 65 años o más | 67,4 |
| Casos con ACV previo | 16,0 |
Interpretación
Probabilidad general. 27.373 de 319.795 adultos reportan enfermedad cardíaca: una probabilidad empírica de 0,086 (8,6 de cada 100).
Probabilidades condicionales. Entre los fumadores, el 12,2 % tiene enfermedad cardíaca, frente al 6,0 % de los no fumadores: el doble (riesgo relativo ≈ 2,0). Entre los adultos con ACV previo, el 36,4 % frente al 7,5 %: casi 5 veces más. Con la edad, la probabilidad sube de 0,6 % (18–24) a 22,6 % (80 o más), y se acelera después de los 50. Como en cada grupo la probabilidad es distinta del 8,6 % general, estos eventos son dependientes: saber si alguien fuma, tuvo un ACV o es mayor cambia su probabilidad de tener enfermedad cardíaca.
Para la gerencia. Con presupuesto para un solo programa, el foco serían los adultos de 65 años o más: son el 34,7 % de la población pero el 67,4 % de todos los casos. Los sobrevivientes de ACV tienen el riesgo más alto (36,4 %), pero aportan solo el 16 % de los casos, así que encajan mejor en una ruta de seguimiento específica ligada a la atención del ACV. Limitación: datos transversales y autorreportados muestran asociación, no causalidad.
2.1.3 Distribuciones discretas: escenarios de capacidad
Situación gerencial: la gerencia debe dimensionar tres servicios: (1) un programa de prevención para adultos de 80 años o más, (2) jornadas de tamizaje de 100 pacientes y (3) camas de urgencias para pacientes con infarto.
set.seed(2026)
# Probabilidad entre los adultos de 80 o más, tomada de la tabla de edad anterior
p_age_80 <- 0.226
# Un número aleatorio entre 0 y 1 cae por debajo de 0,226 en el 22,6 % de los casos:
# así se simula si cada paciente tiene enfermedad cardíaca
random_numbers <- runif(100)
cases_age_80 <- sum(random_numbers < p_age_80)
tibble(
programa = c("Programa general", "Programa para 80 años o más"),
casos = c(sum(screening == "Yes"), cases_age_80)
) |>
tabla(col.names = c("Programa", "Casos por cada 100 inscritos"),
caption = "Casos simulados por programa")| Programa | Casos por cada 100 inscritos |
|---|---|
| Programa general | 9 |
| Programa para 80 años o más | 24 |
set.seed(2026)
# rbinom() repite el tamizaje de 100 pacientes en 1.000 días y cuenta los casos por día
cases_per_day <- rbinom(n = 1000, size = 100, prob = p_heart)
# El percentil 5 y el 95 delimitan el 90 % central de los días: la base para planear cupos
tibble(
indicador = c("Promedio de casos por día", "Mínimo", "Máximo", "Percentil 5", "Percentil 95",
"% de días en que 9 cupos (el promedio) no alcanzan"),
valor = c(mean(cases_per_day), min(cases_per_day), max(cases_per_day),
quantile(cases_per_day, 0.05), quantile(cases_per_day, 0.95),
mean(cases_per_day > 9) * 100)
) |>
tabla(digits = 1, col.names = c("Indicador (1.000 días simulados)", "Valor"),
caption = "Casos por jornada de tamizaje de 100 pacientes")| Indicador (1.000 días simulados) | Valor |
|---|---|
| Promedio de casos por día | 8,5 |
| Mínimo | 1,0 |
| Máximo | 18,0 |
| Percentil 5 | 4,0 |
| Percentil 95 | 13,0 |
| % de días en que 9 cupos (el promedio) no alcanzan | 35,3 |
plot_days <- tibble(cases = cases_per_day) |>
count(cases) |>
ggplot(aes(x = cases, y = n,
text = paste0(cases, " casos en el día: ", n, " días de 1.000"))) +
geom_col(fill = "#3B528B") +
labs(
title = "Casos por día en 1.000 jornadas de tamizaje simuladas",
x = "Pacientes con enfermedad cardíaca (de 100 tamizados)",
y = "Número de días"
) +
theme_minimal()
# ggplotly() vuelve interactivo el gráfico: al pasar el cursor se ven los valores exactos
ggplotly(plot_days, tooltip = "text") |> plotly_es()# SUPUESTO del ejemplo (no viene de los datos): una unidad de urgencias recibe
# en promedio 3 pacientes con infarto al día
lambda_mi <- 3
prob_admissions <- tibble(
admissions = 0:10,
probability = dpois(admissions, lambda = lambda_mi)
)
prob_admissions |>
mutate(probability = probability * 100) |>
tabla(digits = 1, col.names = c("Ingresos por infarto en un día", "Probabilidad (%)"),
caption = "Distribución de Poisson con promedio de 3 ingresos al día")| Ingresos por infarto en un día | Probabilidad (%) |
|---|---|
| 0 | 5,0 |
| 1 | 14,9 |
| 2 | 22,4 |
| 3 | 22,4 |
| 4 | 16,8 |
| 5 | 10,1 |
| 6 | 5,0 |
| 7 | 2,2 |
| 8 | 0,8 |
| 9 | 0,3 |
| 10 | 0,1 |
# ¿Qué tan probable es que 5 camas no alcancen? ¿Y con una sexta cama?
tibble(
escenario = c("5 camas", "6 camas"),
porcentaje = c(1 - sum(dpois(0:5, lambda = lambda_mi)),
1 - sum(dpois(0:6, lambda = lambda_mi))) * 100
) |>
mutate(dias_ano = porcentaje / 100 * 365) |>
tabla(digits = 1, col.names = c("Camas disponibles", "% de días en que no alcanzan",
"Días al año (aprox.)"),
caption = "Riesgo de saturación de camas")| Camas disponibles | % de días en que no alcanzan | Días al año (aprox.) |
|---|---|---|
| 5 camas | 8,4 | 30,6 |
| 6 camas | 3,4 | 12,2 |
plot_admissions <- prob_admissions |>
ggplot(aes(x = admissions, y = probability,
text = paste0(admissions, " ingresos: ", num(probability * 100), " %"))) +
geom_col(fill = "#3B528B") +
scale_y_continuous(labels = coma) +
labs(
title = "Probabilidad de ingresos diarios por infarto (promedio supuesto: 3)",
x = "Pacientes con infarto ingresados en un día",
y = "Probabilidad"
) +
theme_minimal()
ggplotly(plot_admissions, tooltip = "text") |> plotly_es()Interpretación
Programa para adultos de 80 o más
(runif()). Con la probabilidad observada en ese
grupo (22,6 %), 24 de 100 pacientes inscritos tenían enfermedad
cardíaca, frente a 9 en el programa general: casi 3 veces más casos con
la misma inscripción, lo que exige más horas de cardiología, seguimiento
y ayudas diagnósticas por cada 100 pacientes.
Jornadas de tamizaje (rbinom()). En
1.000 días simulados, el promedio fue de 8,5 casos por día, con un rango
de 1 a 18. En 9 de cada 10 días hubo entre 4 y 13 casos. Si solo
se reservaran 9 cupos (el promedio), no alcanzarían en el 35,3 % de los
días; reservar 13 cupos cubre cerca del 95 % de ellos.
Camas de urgencias (dpois()). Bajo el
supuesto de 3 ingresos por infarto al día, la demanda supera 5 camas en
el 8,4 % de los días (unos 31 días al año); una sexta cama lo reduce al
3,4 % (unos 12 días al año). Esto permite discutir con datos si el costo
de una cama adicional se justifica por los días de saturación que
evita.
Limitación: las simulaciones dependen de sus supuestos; el promedio de 3 ingresos por día es supuesto, no observado, y el modelo de Poisson asume llegadas independientes a una tasa constante.
2.1.4 Distribuciones continuas: IMC, tiempos de llegada y duración de la consulta
Situación gerencial: la gerencia necesita (1) estimar la obesidad para dimensionar programas de control de peso, (2) saber con qué frecuencia llegan pacientes con infarto uno tras otro para organizar la sala de hemodinamia y (3) calcular las horas profesionales que requiere una jornada de tamizaje.
# Parámetros reales del IMC
bmi_mean <- mean(heart$BMI)
bmi_sd <- sd(heart$BMI)
set.seed(2026)
# Si el IMC siguiera una distribución normal con estos parámetros...
bmi_simulated <- rnorm(1000, mean = bmi_mean, sd = bmi_sd)
# Comparar IMC simulado y real: ¿coinciden los extremos?
tibble(
indicador = c("Mínimo", "Mediana", "Media", "Máximo"),
simulado = c(min(bmi_simulated), median(bmi_simulated), mean(bmi_simulated), max(bmi_simulated)),
real = c(min(heart$BMI), median(heart$BMI), mean(heart$BMI), max(heart$BMI))
) |>
tabla(digits = 1, col.names = c("Indicador", "IMC simulado (normal)", "IMC real"),
caption = "IMC simulado con la distribución normal frente al real")| Indicador | IMC simulado (normal) | IMC real |
|---|---|---|
| Mínimo | 9,0 | 12,0 |
| Mediana | 28,4 | 27,3 |
| Media | 28,4 | 28,3 |
| Máximo | 50,0 | 94,8 |
# Obesidad: pnorm() da P(IMC < 30), por eso se resta de 1
tibble(
condicion = c("Obesidad (IMC ≥ 30)", "Obesidad severa (IMC ≥ 40)"),
normal = c(1 - pnorm(30, mean = bmi_mean, sd = bmi_sd),
1 - pnorm(40, mean = bmi_mean, sd = bmi_sd)) * 100,
observado = c(mean(heart$BMI >= 30), mean(heart$BMI >= 40)) * 100
) |>
tabla(digits = 1, col.names = c("Condición", "Según el modelo normal (%)", "Observado (%)"),
caption = "Obesidad: modelo normal frente a datos reales")| Condición | Según el modelo normal (%) | Observado (%) |
|---|---|---|
| Obesidad (IMC ≥ 30) | 39,6 | 32,2 |
| Obesidad severa (IMC ≥ 40) | 3,3 | 5,1 |
# Curva normal teórica calculada con dnorm(), superpuesta a los datos reales
normal_curve <- tibble(
bmi = seq(10, 70, by = 0.5),
density = dnorm(bmi, mean = bmi_mean, sd = bmi_sd)
)
ggplot() +
geom_histogram(
data = audit_sample,
aes(x = BMI, y = after_stat(density)),
binwidth = 2, boundary = 0, fill = "#3B528B", alpha = 0.6
) +
geom_line(data = normal_curve, aes(x = bmi, y = density),
color = "#D95F02", linewidth = 1) +
scale_y_continuous(labels = coma) +
labs(
title = "IMC real (muestra de 1.000) frente a la curva normal teórica (naranja)",
x = "Índice de masa corporal (kg/m²)",
y = "Densidad"
) +
theme_minimal()
# Mismo SUPUESTO anterior: 3 infartos al día = 3/24 por hora.
# Si las llegadas siguen un proceso de Poisson, el tiempo entre ellas es exponencial
rate_per_hour <- 3 / 24
set.seed(2026)
interarrival_times <- rexp(1000, rate = rate_per_hour)
# Si la sala de hemodinamia necesita 4 horas para quedar lista otra vez,
# ¿qué tan probable es que llegue otro infarto antes?
tibble(
indicador = c("Tiempo promedio teórico entre llegadas (horas)",
"Tiempo promedio simulado entre llegadas (horas)",
"Probabilidad de que la siguiente llegada ocurra antes de 4 horas (%)"),
valor = c(1 / rate_per_hour, mean(interarrival_times), pexp(4, rate = rate_per_hour) * 100)
) |>
tabla(digits = 1, col.names = c("Indicador", "Valor"),
caption = "Tiempo entre llegadas de pacientes con infarto")| Indicador | Valor |
|---|---|
| Tiempo promedio teórico entre llegadas (horas) | 8,0 |
| Tiempo promedio simulado entre llegadas (horas) | 8,3 |
| Probabilidad de que la siguiente llegada ocurra antes de 4 horas (%) | 39,3 |
exp_curve <- tibble(
hours = seq(0, 40, by = 0.5),
density = dexp(hours, rate = rate_per_hour)
)
ggplot() +
geom_histogram(
data = tibble(hours = interarrival_times),
aes(x = hours, y = after_stat(density)),
binwidth = 2, boundary = 0, fill = "#3B528B", alpha = 0.6
) +
geom_line(data = exp_curve, aes(x = hours, y = density),
color = "#D95F02", linewidth = 1) +
scale_y_continuous(labels = coma) +
labs(
title = "Tiempo entre llegadas de pacientes con infarto (simulado; supuesto: 3 por día)",
x = "Horas entre una llegada y la siguiente",
y = "Densidad"
) +
theme_minimal()
set.seed(2026)
# SUPUESTO: cada consulta de tamizaje dura entre 15 y 25 minutos, cualquier valor
# igual de probable (distribución uniforme continua)
visit_minutes <- runif(100, min = 15, max = 25)
tibble(
indicador = c("Duración promedio de la consulta (minutos)",
"Horas profesionales en una jornada de 100 pacientes",
"Profesionales necesarios con turnos de 8 horas"),
valor = c(mean(visit_minutes), sum(visit_minutes) / 60, ceiling(sum(visit_minutes) / 60 / 8))
) |>
tabla(digits = 1, col.names = c("Indicador", "Valor"),
caption = "Horas profesionales de una jornada de tamizaje")| Indicador | Valor |
|---|---|
| Duración promedio de la consulta (minutos) | 19,8 |
| Horas profesionales en una jornada de 100 pacientes | 33,1 |
| Profesionales necesarios con turnos de 8 horas | 5,0 |
Interpretación
IMC y la distribución normal (rnorm(),
dnorm(), pnorm()). Con la media
(28,3) y la desviación estándar (6,4) reales, el modelo normal predice
39,6 % de obesidad (IMC ≥ 30) cuando lo observado es 32,2 %, y 3,3 % de
obesidad severa (IMC ≥ 40) cuando lo observado es 5,1 %. El modelo
normal sobrestima la obesidad y subestima la obesidad
severa, porque el IMC real tiene asimetría a la derecha: una
cola larga de valores muy altos que una curva simétrica no puede
reproducir. Un programa bariátrico planeado con la curva normal
subestimaría la demanda en cerca de un tercio: las proporciones
deben calcularse con los datos reales, no con un modelo que no se ajusta
a ellos.
Llegadas a la sala de hemodinamia (rexp(),
dexp(), pexp()). Con 3 infartos al
día, el tiempo promedio entre llegadas es de 8 horas; sin embargo, en el
39,3 % de los casos el siguiente paciente llega en menos de 4 horas, el
tiempo supuesto para dejar lista la sala. En cerca de 4 de cada 10
llegadas la sala podría estar ocupada, lo que justifica un equipo de
respaldo o un protocolo de remisión.
Duración de la consulta (runif()). Si
cada consulta dura entre 15 y 25 minutos, una jornada de 100 pacientes
requiere 33,1 horas profesionales. Con turnos de 8 horas se necesitan 5
profesionales (siempre se redondea hacia arriba: una fracción de turno
también hay que cubrirla).
Limitación: las cifras de IMC vienen de los datos; los 3 ingresos diarios, las 4 horas de alistamiento de la sala, la duración de la consulta y los turnos de 8 horas son supuestos del ejercicio.
2.2 Estadística inferencial
Las pruebas de hipótesis siguen la misma lógica del caso del memorando ejecutivo visto en clase: se contrasta una hipótesis nula (H0: “no hay diferencia” o “no hay asociación”) contra una alternativa (H1), y H0 se rechaza cuando el p-valor es menor que α = 0,05.
Advertencia: con 319.795 registros, casi cualquier diferencia, por pequeña que sea, resulta estadísticamente significativa. Por eso se reportan intervalos de confianza y tamaños del efecto (medidas de qué tan grande es una diferencia): muestran si un resultado importa para la gerencia.
2.2.1 Prueba t: IMC según enfermedad cardíaca
# Prueba t de Welch: compara dos medias sin asumir varianzas iguales
# H0: el IMC promedio es igual en ambos grupos; H1: es distinto
t_bmi <- t.test(BMI ~ HeartDisease, data = heart)
# Tamaño del efecto (d de Cohen aproximada): la diferencia en desviaciones estándar;
# por debajo de 0,2 se considera pequeña
d_bmi <- diff(t_bmi$estimate) / sd(heart$BMI)
# R calcula la diferencia como "No - Yes"; se invierte para leerla como "con - sin"
tibble(
indicador = c("IMC promedio sin enfermedad cardíaca", "IMC promedio con enfermedad cardíaca",
"Diferencia (con − sin)", "Intervalo de confianza del 95 % de la diferencia",
"Estadístico t", "Grados de libertad", "p-valor", "Tamaño del efecto (d de Cohen)"),
valor = c(num(t_bmi$estimate[1], 2), num(t_bmi$estimate[2], 2), num(diff(t_bmi$estimate), 2),
paste0(num(-t_bmi$conf.int[2], 2), " a ", num(-t_bmi$conf.int[1], 2)),
num(t_bmi$statistic, 1), num(t_bmi$parameter, 0), p_es(t_bmi$p.value), num(d_bmi, 2))
) |>
tabla(col.names = c("Prueba t de Welch", "Resultado"), caption = "IMC según enfermedad cardíaca")| Prueba t de Welch | Resultado |
|---|---|
| IMC promedio sin enfermedad cardíaca | 28,22 |
| IMC promedio con enfermedad cardíaca | 29,40 |
| Diferencia (con − sin) | 1,18 |
| Intervalo de confianza del 95 % de la diferencia | 1,10 a 1,26 |
| Estadístico t | -28,4 |
| Grados de libertad | 32.295 |
| p-valor | < 0,001 |
| Tamaño del efecto (d de Cohen) | 0,19 |
Interpretación
El IMC promedio es 29,40 en los adultos con enfermedad cardíaca y 28,22 en el resto: una diferencia de 1,18 kg/m² (IC 95 %: 1,10 a 1,26). La prueba t de Welch (t = −28,4; p < 0,001) rechaza H0, pero el tamaño del efecto es pequeño (d ≈ 0,19). Para la gerencia: el exceso de peso está asociado con la enfermedad cardíaca, pero el IMC por sí solo no identifica quién la tiene; debe combinarse con la edad, el tabaquismo y el antecedente de ACV para focalizar programas.
2.2.2 Prueba t para una muestra: horas de sueño
# Mismo razonamiento del memorando (unilateral, cola inferior):
# H0: sueño promedio >= 7 horas (mínimo recomendado para adultos); H1: promedio < 7
t_sleep <- t.test(heart$SleepTime, mu = 7, alternative = "less")
tibble(
indicador = c("Horas de sueño promedio", "Límite superior del intervalo de confianza del 95 %",
"Estadístico t", "p-valor", "% que duerme menos de 7 horas"),
valor = c(num(t_sleep$estimate, 2), num(t_sleep$conf.int[2], 2), num(t_sleep$statistic, 1),
p_es(t_sleep$p.value), pct(mean(heart$SleepTime < 7)))
) |>
tabla(col.names = c("Prueba t para una muestra (H1: promedio < 7 horas)", "Resultado"),
caption = "Horas de sueño")| Prueba t para una muestra (H1: promedio < 7 horas) | Resultado |
|---|---|
| Horas de sueño promedio | 7,10 |
| Límite superior del intervalo de confianza del 95 % | 7,10 |
| Estadístico t | 38,2 |
| p-valor | 1,000 |
| % que duerme menos de 7 horas | 30,3 % |
Interpretación
El sueño promedio es de 7,10 horas (t = 38,2; p = 1; límite superior del 95 %: 7,10 horas), así que H0 no se rechaza: no hay evidencia de que el promedio esté por debajo de 7 horas. Sin embargo, el 30,3 % de los adultos duerme menos de 7 horas. Como en el caso del memorando, una decisión no debe basarse en una lectura simple del promedio: aquí el promedio “cumple”, pero esconde que 3 de cada 10 personas duermen muy poco. El indicador útil para un programa de higiene del sueño es la proporción con sueño insuficiente.
2.2.3 ANOVA: IMC según salud autopercibida
# Ordenar la salud autopercibida de peor a mejor; si no, R la ordena alfabéticamente
heart <- heart |>
mutate(GenHealth = factor(GenHealth,
levels = c("Poor", "Fair", "Good", "Very good", "Excellent")))
# IMC promedio y número de personas por grupo
heart |>
group_by(GenHealth) |>
summarise(imc_media = mean(BMI), personas = n()) |>
mutate(GenHealth = unname(salud_es[as.character(GenHealth)])) |>
tabla(digits = 1, col.names = c("Salud autopercibida", "IMC promedio", "Personas"),
caption = "IMC según salud autopercibida")| Salud autopercibida | IMC promedio | Personas |
|---|---|---|
| Mala | 30,4 | 11.289 |
| Regular | 30,6 | 34.677 |
| Buena | 29,5 | 93.129 |
| Muy buena | 27,8 | 113.858 |
| Excelente | 26,1 | 66.842 |
# H0: el IMC promedio es igual en los 5 grupos; H1: al menos uno es distinto
anova_bmi <- aov(BMI ~ GenHealth, data = heart)
anova_tab <- summary(anova_bmi)[[1]]
# Tamaño del efecto (eta cuadrado): proporción de la variación del IMC explicada por la salud autopercibida
eta2 <- anova_tab[["Sum Sq"]][1] / sum(anova_tab[["Sum Sq"]])
tibble(
fuente = c("Entre grupos (salud autopercibida)", "Dentro de los grupos (residuos)"),
gl = anova_tab[["Df"]],
sc = anova_tab[["Sum Sq"]],
cm = anova_tab[["Mean Sq"]],
f = c(num(anova_tab[["F value"]][1], 1), ""),
p = c(p_es(anova_tab[["Pr(>F)"]][1]), "")
) |>
tabla(digits = 0, col.names = c("Fuente de variación", "Grados de libertad", "Suma de cuadrados",
"Cuadrado medio", "F", "p-valor"),
caption = paste0("Tabla ANOVA (tamaño del efecto: eta cuadrado = ", num(eta2, 3), ")"))| Fuente de variación | Grados de libertad | Suma de cuadrados | Cuadrado medio | F | p-valor |
|---|---|---|---|---|---|
| Entre grupos (salud autopercibida) | 4 | 730.416 | 182.604 | 4.790,7 | < 0,001 |
| Dentro de los grupos (residuos) | 319.790 | 12.189.265 | 38 |
# El ANOVA dice que hay diferencias, pero no entre cuáles grupos:
# Tukey compara todos los pares y ajusta por comparaciones múltiples
tukey <- TukeyHSD(anova_bmi)$GenHealth
tibble(
par = rownames(tukey),
diferencia = tukey[, "diff"],
inferior = tukey[, "lwr"],
superior = tukey[, "upr"],
p = p_es(tukey[, "p adj"])
) |>
mutate(par = par |> str_replace("-", " frente a ") |> str_replace_all(salud_es)) |>
tabla(digits = 2, col.names = c("Comparación", "Diferencia de IMC", "IC 95 % inferior",
"IC 95 % superior", "p-valor ajustado"),
caption = "Comparaciones múltiples de Tukey")| Comparación | Diferencia de IMC | IC 95 % inferior | IC 95 % superior | p-valor ajustado |
|---|---|---|---|---|
| Regular frente a Mala | 0,24 | 0,06 | 0,43 | 0,002 |
| Buena frente a Mala | -0,91 | -1,07 | -0,74 | < 0,001 |
| Muy buena frente a Mala | -2,64 | -2,81 | -2,47 | < 0,001 |
| Excelente frente a Mala | -4,30 | -4,47 | -4,13 | < 0,001 |
| Buena frente a Regular | -1,15 | -1,26 | -1,04 | < 0,001 |
| Muy buena frente a Regular | -2,89 | -2,99 | -2,78 | < 0,001 |
| Excelente frente a Regular | -4,55 | -4,66 | -4,44 | < 0,001 |
| Muy buena frente a Buena | -1,73 | -1,81 | -1,66 | < 0,001 |
| Excelente frente a Buena | -3,40 | -3,48 | -3,31 | < 0,001 |
| Excelente frente a Muy buena | -1,66 | -1,74 | -1,58 | < 0,001 |
Interpretación
El IMC promedio cambia con la salud autopercibida: 30,4 (mala), 30,6 (regular), 29,5 (buena), 27,8 (muy buena) y 26,1 (excelente). El ANOVA (F = 4.790,7; p < 0,001) rechaza H0, y Tukey muestra que todos los pares difieren; la mayor brecha está entre regular y excelente (4,5 kg/m²) y la menor entre mala y regular (0,25 kg/m², sin relevancia práctica). El tamaño del efecto (η² = 0,057) indica que la salud autopercibida explica cerca del 6 % de la variación del IMC. Para la gerencia: la pregunta de salud autopercibida es barata y fácil de hacer, y puede servir como primer filtro para programas de control de peso.
2.2.4 Chi-cuadrado: tabaquismo y enfermedad cardíaca
# H0: el tabaquismo y la enfermedad cardíaca son independientes; H1: están asociados
chi_smoking <- chisq.test(tab_smoking)
# Fuerza de la asociación (V de Cramér): 0 = ninguna, 1 = perfecta
v_cramer <- sqrt(chi_smoking$statistic / sum(tab_smoking))
tibble(
indicador = c("Estadístico chi-cuadrado", "Grados de libertad", "p-valor", "V de Cramér"),
valor = c(num(chi_smoking$statistic, 0), num(chi_smoking$parameter, 0),
p_es(chi_smoking$p.value), num(v_cramer, 2))
) |>
tabla(col.names = c("Prueba chi-cuadrado de independencia", "Resultado"),
caption = "Tabaquismo y enfermedad cardíaca")| Prueba chi-cuadrado de independencia | Resultado |
|---|---|
| Estadístico chi-cuadrado | 3.713 |
| Grados de libertad | 1 |
| p-valor | < 0,001 |
| V de Cramér | 0,11 |
# Casos observados frente a los esperados si ambas variables fueran independientes
tibble(
grupo = c("No fumadores", "Fumadores"),
observados = as.vector(tab_smoking[, "Yes"]),
esperados = as.vector(chi_smoking$expected[, "Yes"])
) |>
tabla(digits = 0, col.names = c("Grupo", "Casos observados", "Casos esperados si fueran independientes"),
caption = "Casos de enfermedad cardíaca: observados frente a esperados")| Grupo | Casos observados | Casos esperados si fueran independientes |
|---|---|---|
| No fumadores | 11.336 | 16.082 |
| Fumadores | 16.037 | 11.291 |
Interpretación
La prueba chi-cuadrado (X² = 3.713; gl = 1; p < 0,001) rechaza la independencia. Si ambas variables fueran independientes esperaríamos cerca de 11.291 fumadores con enfermedad cardíaca; observamos 16.037. La V de Cramér (0,11) indica una asociación estadísticamente débil, aunque los fumadores tienen el doble de probabilidad (12,2 % frente a 6,0 %). Para la gerencia: los programas de cesación del tabaco son pertinentes pero no suficientes: el 41 % de los casos ocurre en no fumadores.
2.2.5 Prueba de proporciones: mujeres y hombres
# H0: la proporción con enfermedad cardíaca es igual en mujeres y hombres
tab_sex <- table(heart$Sex, heart$HeartDisease)
prop_sex <- prop.test(x = tab_sex[, "Yes"], n = rowSums(tab_sex))
# Filas en orden alfabético de los datos: "Female" (mujeres) y "Male" (hombres)
tibble(
sexo = c("Mujeres", "Hombres"),
personas = as.vector(rowSums(tab_sex)),
casos = as.vector(tab_sex[, "Yes"]),
porcentaje = as.vector(tab_sex[, "Yes"] / rowSums(tab_sex)) * 100
) |>
tabla(digits = 1, col.names = c("Sexo", "Personas", "Casos", "% con enfermedad cardíaca"),
caption = "Enfermedad cardíaca según sexo")| Sexo | Personas | Casos | % con enfermedad cardíaca |
|---|---|---|---|
| Mujeres | 167.805 | 11.234 | 6,7 |
| Hombres | 151.990 | 16.139 | 10,6 |
# R calcula "mujeres - hombres"; se invierte para leerlo como "hombres - mujeres"
tibble(
indicador = c("Diferencia (hombres − mujeres), puntos porcentuales",
"Intervalo de confianza del 95 % de la diferencia",
"Estadístico chi-cuadrado", "p-valor"),
valor = c(num((prop_sex$estimate[2] - prop_sex$estimate[1]) * 100, 1),
paste0(num(-prop_sex$conf.int[2] * 100, 1), " a ", num(-prop_sex$conf.int[1] * 100, 1)),
num(prop_sex$statistic, 1), p_es(prop_sex$p.value))
) |>
tabla(col.names = c("Prueba de dos proporciones", "Resultado"),
caption = "Diferencia entre hombres y mujeres")| Prueba de dos proporciones | Resultado |
|---|---|
| Diferencia (hombres − mujeres), puntos porcentuales | 3,9 |
| Intervalo de confianza del 95 % de la diferencia | 3,7 a 4,1 |
| Estadístico chi-cuadrado | 1.568,3 |
| p-valor | < 0,001 |
Interpretación
El 6,7 % de las mujeres (11.234 de 167.805) y el 10,6 % de los hombres (16.139 de 151.990) reportan enfermedad cardíaca (X² = 1.568,3; p < 0,001). Con 95 % de confianza, la proporción en hombres supera a la de mujeres entre 3,7 y 4,1 puntos porcentuales: los hombres tienen cerca de 1,6 veces la probabilidad. Para la gerencia: el tamizaje puede priorizar a los hombres sin descuidar a las mujeres, que aportan el 41 % de los casos. Limitación: no está ajustado por edad ni otros factores.
2.2.6 Gráficos comparativos con ggpubr
ggboxplot(
heart |> mutate(enfermedad = si_no(HeartDisease)),
x = "enfermedad", y = "BMI",
fill = "enfermedad", palette = c("#3B528B", "#D95F02"),
title = "IMC según enfermedad cardíaca",
xlab = "Enfermedad cardíaca",
ylab = "Índice de masa corporal (kg/m²)",
legend = "none"
) +
# Resultado de la prueba t calculada arriba, escrito en español
annotate("text", x = 1.5, y = 92, size = 3.5,
label = paste0("Prueba t de Welch: p ", p_es(t_bmi$p.value),
"; d de Cohen = ", num(d_bmi, 2), " (efecto pequeño)"))
ggboxplot(
heart |> mutate(salud = factor(salud_es[as.character(GenHealth)], levels = salud_es)),
x = "salud", y = "BMI",
fill = "#9ECAE1",
title = "IMC según salud autopercibida",
xlab = "Salud autopercibida",
ylab = "Índice de masa corporal (kg/m²)"
) +
annotate("text", x = 3, y = 92, size = 3.5,
label = paste0("ANOVA: p ", p_es(anova_tab[["Pr(>F)"]][1]),
"; eta cuadrado = ", num(eta2, 3)))
Interpretación
Las cajas del IMC de ambos grupos se superponen casi por completo, aunque la mediana es mayor en quienes tienen enfermedad cardíaca (28,3 frente a 27,3): la prueba es significativa, pero la superposición muestra visualmente que la diferencia es pequeña (significancia estadística no es relevancia práctica). El segundo gráfico muestra un descenso escalonado del IMC desde salud regular o mala hasta excelente, coherente con el ANOVA.
3 Modelos analíticos: ¿quién tiene alto riesgo?
3.1 Problema, objetivos y métricas de éxito
Un plan de salud no puede enviar a todos sus afiliados adultos a cardiología al mismo tiempo; necesita priorizar a quién invitar primero. Los capítulos anteriores mostraron que la enfermedad cardíaca se concentra en adultos mayores, sobrevivientes de ACV, fumadores y hombres. Este capítulo combina todos esos factores en un modelo de clasificación que le asigna a cada persona una probabilidad de enfermedad cardíaca y la clasifica como de riesgo alto o bajo. Se construyen y comparan dos modelos analíticos sobre el mismo conjunto de prueba: una regresión logística (modelo 1, interpretable) y un bosque aleatorio (modelo 2, más flexible). Se elige el que mejor equilibre desempeño y capacidad de explicación.
| Métrica | Qué mide | Meta |
|---|---|---|
| AUC (área bajo la curva ROC) | Capacidad de ordenar a una persona con la enfermedad por encima de una sin ella; 0,5 = azar, 1 = perfecto | ≥ 0,80 en el conjunto de prueba |
| Sensibilidad | De cada 100 personas con enfermedad cardíaca, cuántas marca el modelo como de alto riesgo | ≥ 70 % |
| Diferencia entrenamiento–prueba | Si el modelo “memorizó” los datos (sobreajuste) | Diferencia de AUC ≤ 0,02 |
La exactitud no es una métrica principal: con solo 8,6 % de positivos, un modelo que dijera que nadie tiene la enfermedad acertaría más del 91 % de las veces sin detectar a ningún paciente.
3.2 Selección de variables
| Grupo | Variables incluidas | Justificación |
|---|---|---|
| Demográficas | Edad (AgeCategory), sexo (Sex) |
La prevalencia subió de 0,6 % a 22,6 % con la edad y fue mayor en hombres |
| Hábitos y peso | Tabaquismo, actividad física, IMC | Factores de riesgo modificables, objetivo de los programas de prevención |
| Antecedentes clínicos | ACV, diabetes, enfermedad renal | Condiciones que comparten mecanismos con la enfermedad cardíaca; el ACV mostró el mayor riesgo |
| Estado funcional | Salud autopercibida, dificultad para caminar, días de mala salud física | Resumen la carga de enfermedad y son fáciles de preguntar |
Excluidas: la raza, porque un modelo que asigna recursos no debería usar la raza como criterio (equidad); el consumo excesivo de alcohol, porque en estos datos se asocia con menos enfermedad cardíaca (5,2 % frente a 8,8 %), probablemente porque las personas enfermas dejan de beber, lo que enviaría un mensaje engañoso; asma, cáncer de piel, salud mental y sueño, que tienen un vínculo clínico menos directo. Se prefirió un modelo parsimonioso (pocas variables, fácil de aplicar y explicar).
Hipótesis de trabajo: (1) a mayor edad, mayor probabilidad; (2) el ACV, la diabetes y la enfermedad renal la aumentan; (3) fumar la aumenta y la actividad física la disminuye; (4) una peor salud autopercibida se asocia con mayor probabilidad.
3.3 Modelo conceptual
# Diagrama de las relaciones entre variables y la técnica elegida
DiagrammeR::grViz("
digraph model {
graph [rankdir = LR, fontname = Helvetica]
node [shape = box, style = 'rounded,filled', fillcolor = '#E8EEF7',
fontname = Helvetica, fontsize = 11]
demo [label = 'Demográficas\\nEdad, sexo']
habits [label = 'Hábitos y peso\\nTabaquismo, actividad física, IMC']
clinical [label = 'Antecedentes clínicos\\nACV, diabetes, enfermedad renal']
funct [label = 'Estado funcional\\nSalud autopercibida, dificultad para caminar,\\ndías de mala salud física']
model [label = 'Modelo 1: regresión logística\\n(campeón; entrenamiento: 75 %)', fillcolor = '#3B528B', fontcolor = white]
rf [label = 'Modelo 2: bosque aleatorio\\n(retador)', fillcolor = '#B8C4DE']
prob [label = 'Probabilidad de\\nenfermedad cardíaca']
decision [label = 'Riesgo alto: priorizar tamizaje\\nRiesgo bajo: seguimiento de rutina', fillcolor = '#FBE3D0']
evalu [label = 'Evaluación (prueba: 25 %)\\nAUC y sensibilidad', shape = note]
{demo habits clinical funct} -> model -> prob -> decision
{demo habits clinical funct} -> rf [style = dashed]
rf -> evalu [style = dashed, label = 'comparados en el\\nmismo conjunto de prueba', fontsize = 9]
prob -> evalu [style = dashed]
}
")Técnica (modelo 1): regresión logística, el modelo estándar para un desenlace sí/no (el modelo 2, el bosque aleatorio, se describe donde se ajusta):
log( p / (1 - p) ) = b0 + b1·edad + b2·sexo + b3·tabaquismo + ... + b11·días de mala salud física
p = probabilidad de enfermedad cardíaca
p / (1-p) = oportunidades: enfermos por cada sano (p. ej., p = 0,20 equivale a 1 enfermo por cada 4 sanos)
exp(b) = razón de oportunidades (OR): cuántas veces se multiplican las oportunidades
cuando la variable aumenta una unidad o pasa de "No" a "Sí"3.4 Implementación en RStudio
3.4.1 Preparación de los datos
model_data <- heart |>
# Solo las variables justificadas arriba
select(HeartDisease, AgeCategory, Sex, Smoking, Stroke, Diabetic, KidneyDisease,
DiffWalking, PhysicalActivity, GenHealth, BMI, PhysicalHealth) |>
# Aquí no hay faltantes, pero el paso mantiene el flujo válido para otros datos
drop_na() |>
mutate(
# "No" primero, para que el modelo estime la probabilidad de "Yes"
HeartDisease = factor(HeartDisease, levels = c("No", "Yes")),
# Edad aproximada (inicio del grupo + 2 años; p. ej. "55-59" -> 57) para leer el efecto por año
age = as.numeric(str_sub(AgeCategory, 1, 2)) + 2,
# "Excellent" como referencia: los OR muestran cuánto sube el riesgo a medida que empeora la salud
GenHealth = factor(GenHealth, levels = c("Excellent", "Very good", "Good", "Fair", "Poor"))
) |>
select(-AgeCategory)
# Descripción de las variables seleccionadas: numéricas (resumen) y categóricas (% con la condición)
numericas_es <- c(age = "Edad aproximada (años)", BMI = "IMC (kg/m²)",
PhysicalHealth = "Días de mala salud física")
model_data |>
summarise(across(all_of(names(numericas_es)),
list(media = mean, desv = sd, minimo = min, maximo = max))) |>
pivot_longer(everything(), names_to = c("variable", ".value"), names_pattern = "(.*)_(.*)") |>
mutate(variable = unname(numericas_es[variable])) |>
tabla(digits = 1, col.names = c("Variable numérica", "Media", "Desviación estándar", "Mínimo", "Máximo"),
caption = paste0("Datos del modelo: ", int(nrow(model_data)), " personas, ",
sum(is.na(model_data)), " valores faltantes"))| Variable numérica | Media | Desviación estándar | Mínimo | Máximo |
|---|---|---|---|---|
| Edad aproximada (años) | 54,4 | 18,1 | 20 | 82,0 |
| IMC (kg/m²) | 28,3 | 6,4 | 12 | 94,8 |
| Días de mala salud física | 3,4 | 8,0 | 0 | 30,0 |
categoricas_es <- c(HeartDisease = "Con enfermedad cardíaca (desenlace)", Sex = "Hombres",
Smoking = "Fumadores (alguna vez)", Stroke = "ACV previo", Diabetic = "Diabetes",
KidneyDisease = "Enfermedad renal", DiffWalking = "Dificultad para caminar",
PhysicalActivity = "Físicamente activos")
tibble(
variable = unname(categoricas_es),
porcentaje = map_dbl(names(categoricas_es), \(v) mean(model_data[[v]] %in% c("Yes", "Male")) * 100)
) |>
tabla(digits = 1, col.names = c("Variable categórica", "% de las personas"),
caption = "Variables categóricas del modelo")| Variable categórica | % de las personas |
|---|---|
| Con enfermedad cardíaca (desenlace) | 8,6 |
| Hombres | 47,5 |
| Fumadores (alguna vez) | 41,2 |
| ACV previo | 3,8 |
| Diabetes | 12,8 |
| Enfermedad renal | 3,7 |
| Dificultad para caminar | 13,9 |
| Físicamente activos | 77,5 |
3.4.2 División entrenamiento/prueba
# Semilla: la división aleatoria es reproducible
set.seed(2026)
# Estratificar por HeartDisease mantiene el mismo 8,6 % de casos en ambos conjuntos
data_split <- initial_split(model_data, prop = 0.75, strata = HeartDisease)
train_data <- training(data_split)
test_data <- testing(data_split)
tibble(
conjunto = c("Entrenamiento (75 %)", "Prueba (25 %)"),
personas = c(nrow(train_data), nrow(test_data)),
pct_casos = c(mean(train_data$HeartDisease == "Yes"),
mean(test_data$HeartDisease == "Yes")) * 100
) |>
tabla(digits = 1, col.names = c("Conjunto", "Personas", "% con enfermedad cardíaca"),
caption = "División entrenamiento/prueba")| Conjunto | Personas | % con enfermedad cardíaca |
|---|---|---|
| Entrenamiento (75 %) | 239.846 | 8,5 |
| Prueba (25 %) | 79.949 | 8,8 |
3.4.3 Modelo 1: regresión logística (ajuste)
# Fórmula común para caret y glm: desenlace ~ predictores
model_formula <- HeartDisease ~ age + Sex + Smoking + Stroke + Diabetic +
KidneyDisease + DiffWalking + PhysicalActivity + GenHealth + BMI + PhysicalHealth# Validación cruzada de 5 particiones: los datos de entrenamiento se dividen en 5 partes y
# el modelo se ajusta 5 veces, evaluándose cada vez en la parte que no vio.
# Así se estima el desempeño sin tocar todavía el conjunto de prueba.
cv_control <- caret::trainControl(
method = "cv",
number = 5,
classProbs = TRUE, # necesario para calcular el AUC
summaryFunction = caret::twoClassSummary # reporta el AUC con el nombre "ROC"
)
set.seed(2026)
cv_model <- caret::train(
model_formula,
data = train_data,
method = "glm", # regresión logística
family = "binomial",
trControl = cv_control,
metric = "ROC"
)
# AUC promedio en las 5 particiones y su variabilidad
cv_model$results |>
select(ROC, ROCSD) |>
tabla(digits = 3, col.names = c("AUC promedio en las 5 particiones", "Desviación estándar del AUC"),
caption = "Validación cruzada de la regresión logística")| AUC promedio en las 5 particiones | Desviación estándar del AUC |
|---|---|
| 0,839 | 0,003 |
# El mismo modelo con glm(), la función que caret usa internamente;
# su salida es más fácil de leer y diagnosticar
logit_model <- glm(model_formula, data = train_data, family = binomial)
# Razones de oportunidades (OR) con intervalos de confianza de Wald al 95 %
or_table <- broom::tidy(logit_model) |>
filter(term != "(Intercept)") |>
mutate(
OR = exp(estimate),
CI_low = exp(estimate - 1.96 * std.error),
CI_high = exp(estimate + 1.96 * std.error)
) |>
select(term, OR, CI_low, CI_high, p.value) |>
arrange(desc(OR))
# Vectores con nombre para citar valores dentro del texto
or_vec <- setNames(or_table$OR, or_table$term)
ci_low_vec <- setNames(or_table$CI_low, or_table$term)
ci_high_vec <- setNames(or_table$CI_high, or_table$term)
# Nombres de los términos en español (R los nombra como variable + categoría, en inglés)
terminos_es <- c(
"age" = "Edad (por año)",
"SexMale" = "Sexo masculino",
"SmokingYes" = "Fumador",
"StrokeYes" = "ACV previo",
"DiabeticNo, borderline diabetes" = "Prediabetes",
"DiabeticYes" = "Diabetes",
"DiabeticYes (during pregnancy)" = "Diabetes gestacional",
"KidneyDiseaseYes" = "Enfermedad renal",
"DiffWalkingYes" = "Dificultad para caminar",
"PhysicalActivityYes" = "Actividad física",
"GenHealthVery good" = "Salud muy buena (frente a excelente)",
"GenHealthGood" = "Salud buena (frente a excelente)",
"GenHealthFair" = "Salud regular (frente a excelente)",
"GenHealthPoor" = "Salud mala (frente a excelente)",
"BMI" = "IMC (por punto)",
"PhysicalHealth" = "Días de mala salud física (por día)"
)
traducir_termino <- function(x) coalesce(unname(terminos_es[x]), x)
or_table |>
mutate(term = traducir_termino(term), p.value = p_es(p.value)) |>
tabla(digits = 2,
col.names = c("Factor", "OR", "IC 95 % inferior", "IC 95 % superior", "p-valor"),
caption = "Razones de oportunidades (OR) del modelo, de mayor a menor")| Factor | OR | IC 95 % inferior | IC 95 % superior | p-valor |
|---|---|---|---|---|
| Salud mala (frente a excelente) | 6,66 | 6,08 | 7,30 | < 0,001 |
| Salud regular (frente a excelente) | 4,53 | 4,20 | 4,87 | < 0,001 |
| ACV previo | 2,86 | 2,72 | 3,01 | < 0,001 |
| Salud buena (frente a excelente) | 2,80 | 2,62 | 2,99 | < 0,001 |
| Sexo masculino | 1,97 | 1,90 | 2,03 | < 0,001 |
| Enfermedad renal | 1,77 | 1,68 | 1,88 | < 0,001 |
| Diabetes | 1,60 | 1,54 | 1,66 | < 0,001 |
| Salud muy buena (frente a excelente) | 1,56 | 1,45 | 1,67 | < 0,001 |
| Fumador | 1,45 | 1,40 | 1,49 | < 0,001 |
| Dificultad para caminar | 1,24 | 1,19 | 1,29 | < 0,001 |
| Diabetes gestacional | 1,22 | 0,97 | 1,53 | 0,095 |
| Prediabetes | 1,17 | 1,07 | 1,29 | < 0,001 |
| Edad (por año) | 1,06 | 1,05 | 1,06 | < 0,001 |
| Actividad física | 1,04 | 1,00 | 1,08 | 0,038 |
| IMC (por punto) | 1,01 | 1,01 | 1,01 | < 0,001 |
| Días de mala salud física (por día) | 1,01 | 1,00 | 1,01 | < 0,001 |
Interpretación de los coeficientes
Todas las asociaciones van en la dirección esperada, excepto la actividad física y la diabetes gestacional (pocos casos, sin asociación clara). Manteniendo constantes las demás variables:
- La salud autopercibida es la que más pesa: frente a una salud excelente, las oportunidades de tener enfermedad cardíaca se multiplican por 6,7 con salud mala y por 4,5 con salud regular.
- El ACV previo multiplica las oportunidades por 2,9; ser hombre, por 2,0.
- La enfermedad renal y la diabetes las multiplican por 1,8 y 1,6; fumar y la dificultad para caminar, por 1,4 y 1,2.
- Edad: cada 10 años adicionales multiplican las oportunidades por 1,7.
- El IMC y los días de mala salud física tienen efectos pequeños por unidad (OR de 1,012 por punto de IMC y de 1,007 por día).
- La actividad física deja de asociarse con el riesgo cuando se tienen en cuenta la edad y el estado de salud (OR = 1,04; IC 95 % de 1,00 a 1,08). La brecha vista en el capítulo 2 (13,8 % frente a 7,1 %) se explicaba en gran parte por esas otras variables: las personas mayores y más enfermas hacen menos ejercicio. Esta es la diferencia entre una asociación simple y una ajustada.
3.4.4 Diagnósticos preliminares
En la regresión lineal se verifican la varianza constante (homocedasticidad) y residuos aproximadamente normales. Esos supuestos no aplican a la regresión logística, cuyo desenlace es sí/no. En su lugar se revisan cuatro aspectos: (1) que los predictores no estén demasiado correlacionados entre sí (multicolinealidad), (2) residuos extremos, (3) observaciones influyentes y (4) calibración (que las probabilidades predichas coincidan con las proporciones observadas).
# Factor de inflación de la varianza (VIF): valores mayores que 5 indican multicolinealidad
# problemática. En variables con varios niveles se lee la última columna,
# GVIF^(1/(2*Df)), comparable con la raíz cuadrada de 5 (cerca de 2,2)
vif_model <- car::vif(logit_model)
variables_es <- c(age = "Edad", Sex = "Sexo", Smoking = "Tabaquismo", Stroke = "ACV",
Diabetic = "Diabetes", KidneyDisease = "Enfermedad renal",
DiffWalking = "Dificultad para caminar", PhysicalActivity = "Actividad física",
GenHealth = "Salud autopercibida", BMI = "IMC",
PhysicalHealth = "Días de mala salud física")
tibble(
variable = unname(variables_es[rownames(vif_model)]),
gvif = vif_model[, 1],
gl = vif_model[, 2],
ajustado = vif_model[, 3]
) |>
tabla(digits = 2, col.names = c("Variable", "VIF generalizado", "Grados de libertad",
"VIF ajustado (comparar con 2,2)"),
caption = "Multicolinealidad: factor de inflación de la varianza")| Variable | VIF generalizado | Grados de libertad | VIF ajustado (comparar con 2,2) |
|---|---|---|---|
| Edad | 1,10 | 1 | 1,05 |
| Sexo | 1,05 | 1 | 1,03 |
| Tabaquismo | 1,03 | 1 | 1,02 |
| ACV | 1,03 | 1 | 1,02 |
| Diabetes | 1,14 | 3 | 1,02 |
| Enfermedad renal | 1,05 | 1 | 1,02 |
| Dificultad para caminar | 1,45 | 1 | 1,20 |
| Actividad física | 1,18 | 1 | 1,08 |
| Salud autopercibida | 1,90 | 4 | 1,08 |
| IMC | 1,16 | 1 | 1,08 |
| Días de mala salud física | 1,73 | 1 | 1,31 |
# augment() agrega a cada persona su valor ajustado, su residuo y su influencia
diagnostics <- broom::augment(logit_model)
# La actividad menciona geom_residuals(), que no existe en ggplot2:
# el gráfico de residuos se construye con geom_point()
tibble(
indicador = c("% de personas con residuo estandarizado mayor que 3 (en valor absoluto)",
"Distancia de Cook máxima"),
valor = c(num(mean(abs(diagnostics$.std.resid) > 3) * 100, 2),
num(max(diagnostics$.cooksd), 4))
) |>
tabla(col.names = c("Indicador", "Valor"), caption = "Residuos extremos y observaciones influyentes")| Indicador | Valor |
|---|---|
| % de personas con residuo estandarizado mayor que 3 (en valor absoluto) | 0,11 |
| Distancia de Cook máxima | 0,0009 |
# Se grafica una muestra de 3.000 personas: 240.000 puntos serían ilegibles
set.seed(2026)
plot_resid <- diagnostics |>
slice_sample(n = 3000) |>
mutate(estado = if_else(HeartDisease == "Yes", "Con enfermedad", "Sin enfermedad")) |>
ggplot(aes(x = .fitted, y = .std.resid, color = estado,
text = paste0(estado, "<br>Valor ajustado: ", num(.fitted, 2),
"<br>Residuo: ", num(.std.resid, 2)))) +
geom_point(alpha = 0.4) +
geom_hline(yintercept = 0) +
geom_hline(yintercept = c(-3, 3), linetype = "dashed") +
scale_color_manual(values = c(`Sin enfermedad` = "#3B528B", `Con enfermedad` = "#D95F02")) +
labs(
title = "Residuos estandarizados frente a valores ajustados (muestra de 3.000)",
x = "Valor ajustado (escala logit)",
y = "Residuo de devianza estandarizado",
color = "Enfermedad cardíaca"
) +
theme_minimal()
ggplotly(plot_resid, tooltip = "text") |> plotly_es()# Calibración: las personas del conjunto de prueba se agrupan en 10 deciles de probabilidad
# predicha y se comparan con la proporción real de casos en cada decil
prob_test <- predict(logit_model, newdata = test_data, type = "response")
calibration <- tibble(
observed = test_data$HeartDisease == "Yes",
predicted = prob_test
) |>
mutate(decile = ntile(predicted, 10)) |>
group_by(decile) |>
summarise(mean_predicted = mean(predicted), observed_rate = mean(observed))
plot_calibration <- ggplot(calibration, aes(x = mean_predicted, y = observed_rate)) +
geom_abline(linetype = "dashed", color = "grey50") + # calibración perfecta
geom_line(color = "#3B528B") +
geom_point(aes(text = paste0("Decil ", decile,
"<br>Probabilidad predicha: ", pct(mean_predicted),
"<br>Proporción observada: ", pct(observed_rate))),
color = "#3B528B", size = 3) +
scale_x_continuous(labels = coma) +
scale_y_continuous(labels = coma) +
labs(
title = "Calibración en el conjunto de prueba (por decil de riesgo)",
x = "Probabilidad predicha promedio",
y = "Proporción observada con enfermedad cardíaca"
) +
theme_minimal()
ggplotly(plot_calibration, tooltip = "text") |> plotly_es()Interpretación de los diagnósticos
- Multicolinealidad: ninguna. El mayor VIF ajustado es 1,31, muy por debajo de 2,2, así que cada variable aporta información propia.
- Residuos extremos: solo el 0,11 % de las personas tiene un residuo estandarizado mayor que 3 en valor absoluto. Son personas con enfermedad cardíaca a quienes el modelo les asignó una probabilidad muy baja: casos atípicos (por ejemplo, personas jóvenes sin factores de riesgo) que un tamizaje basado en estas preguntas no detectaría.
- Observaciones influyentes: la distancia de Cook máxima es 0,0009, muy por debajo de 1: ninguna persona por sí sola cambia el modelo.
- Calibración: los puntos siguen la diagonal; en el decil de mayor riesgo el modelo predice 36,9 % y se observa 36,4 %. Las probabilidades pueden usarse como estimaciones de riesgo, no solo para ordenar a las personas.
3.4.5 Modelo 1: evaluación del desempeño
# Umbral de clasificación: la proporción de casos en entrenamiento (cerca de 8,6 %).
# Una persona es de "riesgo alto" si su probabilidad supera la frecuencia promedio.
# Con el 0,5 habitual el modelo casi nunca diría "Yes", porque la enfermedad es poco frecuente.
threshold <- mean(train_data$HeartDisease == "Yes")
prob_train <- predict(logit_model, type = "response")
# Las mismas métricas para cualquier conjunto de datos
evaluate <- function(observed, probability, threshold) {
predicted_class <- factor(if_else(probability >= threshold, "Yes", "No"), levels = c("No", "Yes"))
tibble(
AUC = yardstick::roc_auc_vec(observed, probability, event_level = "second"),
Sensitivity = yardstick::sens_vec(observed, predicted_class, event_level = "second"),
Specificity = yardstick::spec_vec(observed, predicted_class, event_level = "second"),
Accuracy = yardstick::accuracy_vec(observed, predicted_class),
Pct_high_risk = mean(predicted_class == "Yes")
)
}
metrics_train <- evaluate(train_data$HeartDisease, prob_train, threshold)
metrics_test <- evaluate(test_data$HeartDisease, prob_test, threshold)
# Modelo base para comparar: decir que nadie tiene la enfermedad (probabilidad 0 para todos)
metrics_baseline <- evaluate(test_data$HeartDisease, rep(0, nrow(test_data)), 0.5)
# Nombres de columnas en español para las tablas de métricas
metric_names <- c("AUC", "Sensibilidad", "Especificidad", "Exactitud", "Proporción de alto riesgo")
metrics_table <- bind_rows(
metrics_train |> mutate(Set = "Entrenamiento"),
metrics_test |> mutate(Set = "Prueba"),
metrics_baseline |> mutate(Set = "Modelo base (todos 'No'), prueba")
) |>
relocate(Set)
tabla(metrics_table, digits = 3,
col.names = c("Conjunto", metric_names),
caption = "Métricas de desempeño: entrenamiento frente a prueba")| Conjunto | AUC | Sensibilidad | Especificidad | Exactitud | Proporción de alto riesgo |
|---|---|---|---|---|---|
| Entrenamiento | 0,839 | 0,784 | 0,742 | 0,746 | 0,302 |
| Prueba | 0,841 | 0,786 | 0,742 | 0,745 | 0,305 |
| Modelo base (todos ‘No’), prueba | 0,500 | 0,000 | 1,000 | 0,912 | 0,000 |
# Matriz de confusión en el conjunto de prueba: aciertos y errores con el umbral elegido
class_test <- factor(if_else(prob_test >= threshold, "Yes", "No"), levels = c("No", "Yes"))
confusion_test <- table(Predicho = class_test, Observado = test_data$HeartDisease)
tibble(
prediccion = c("Riesgo alto (se invita)", "Riesgo bajo (no se invita)"),
con = c(confusion_test["Yes", "Yes"], confusion_test["No", "Yes"]),
sin = c(confusion_test["Yes", "No"], confusion_test["No", "No"])
) |>
tabla(col.names = c("Clasificación del modelo", "Con enfermedad cardíaca", "Sin enfermedad cardíaca"),
caption = "Matriz de confusión en el conjunto de prueba")| Clasificación del modelo | Con enfermedad cardíaca | Sin enfermedad cardíaca |
|---|---|---|
| Riesgo alto (se invita) | 5.500 | 18.850 |
| Riesgo bajo (no se invita) | 1.500 | 54.099 |
# Rendimiento: proporción de invitados (riesgo alto) que realmente tiene enfermedad cardíaca
yield_targeted <- confusion_test["Yes", "Yes"] / sum(confusion_test["Yes", ])3.4.6 Modelo 2: bosque aleatorio (modelo retador)
Una buena práctica de modelado es comparar el modelo elegido
(campeón) con una alternativa más flexible
(retador). Un bosque aleatorio
(random forest) combina cientos de árboles de decisión, cada
uno construido con un subconjunto aleatorio de personas y de variables,
y promedia sus votos. Puede capturar relaciones no lineales e
interacciones de forma automática, pero es más difícil de explicar. Se
ajusta con caret::train(method = "rf"), como sugiere la
actividad.
# Un bosque aleatorio con 240.000 personas tardaría demasiado en un portátil: se
# entrena con una muestra aleatoria de 20.000 personas del conjunto de entrenamiento y
# se evalúa con el mismo conjunto de prueba completo que la regresión logística
set.seed(2026)
train_rf <- train_data |> slice_sample(n = 20000)
rf_model <- caret::train(
model_formula,
data = train_rf,
method = "rf",
trControl = caret::trainControl(method = "none", classProbs = TRUE),
tuneGrid = data.frame(mtry = 3), # variables que se prueban en cada división
ntree = 300, # número de árboles
nodesize = 25 # mínimo de personas por hoja final: evita memorizar
)
prob_rf <- predict(rf_model, newdata = test_data, type = "prob")[, "Yes"]
metrics_rf <- evaluate(test_data$HeartDisease, prob_rf, threshold)
# ¿En qué variables se apoya más el bosque?
rf_importance <- caret::varImp(rf_model)$importance |>
rownames_to_column("variable") |>
arrange(desc(Overall)) |>
slice_head(n = 8) |>
# Mismos nombres en español que la tabla de OR, sin la aclaración entre paréntesis
mutate(etiqueta = str_remove(traducir_termino(variable), " \\(.*\\)$"))
# Las tres más importantes, para citarlas en el texto
top_rf_vars <- paste(rf_importance$etiqueta[1:3], collapse = ", ")
ggplot(rf_importance, aes(x = Overall, y = reorder(etiqueta, Overall))) +
geom_col(fill = "#1F78B4") +
labs(
title = "Bosque aleatorio: variables más importantes",
x = "Importancia relativa (0-100)", y = NULL
) +
theme_minimal()
3.4.7 Comparación y selección del modelo
# Mismo conjunto de prueba, mismo umbral: una comparación justa
bind_rows(
metrics_test |> mutate(Model = "1. Regresión logística (campeón)"),
metrics_rf |> mutate(Model = "2. Bosque aleatorio (retador)")
) |>
relocate(Model) |>
tabla(digits = 3, col.names = c("Modelo", metric_names),
caption = "Campeón frente a retador en el conjunto de prueba")| Modelo | AUC | Sensibilidad | Especificidad | Exactitud | Proporción de alto riesgo |
|---|---|---|---|---|---|
| 1. Regresión logística (campeón) | 0,841 | 0,786 | 0,742 | 0,745 | 0,305 |
| 2. Bosque aleatorio (retador) | 0,776 | 0,335 | 0,947 | 0,894 | 0,077 |
# Curvas ROC: mientras más cerca de la esquina superior izquierda, mejor ordena el modelo a las personas
roc_data <- bind_rows(
yardstick::roc_curve(tibble(truth = test_data$HeartDisease, p = prob_test), truth, p,
event_level = "second") |> mutate(model = "Regresión logística"),
yardstick::roc_curve(tibble(truth = test_data$HeartDisease, p = prob_rf), truth, p,
event_level = "second") |> mutate(model = "Bosque aleatorio")
) |>
# Miles de umbrales por curva: un punto de cada 40 dibuja la misma línea
# y mantiene liviano el gráfico interactivo
group_by(model) |>
slice(unique(c(seq(1, n(), by = 40), n()))) |>
ungroup() |>
# Orden de la leyenda: primero el campeón
mutate(model = factor(model, levels = c("Regresión logística", "Bosque aleatorio")))
plot_roc <- ggplot(roc_data, aes(x = 1 - specificity, y = sensitivity, color = model, group = model,
text = paste0(model,
"<br>Falsos positivos: ", pct(1 - specificity, 0),
"<br>Sensibilidad: ", pct(sensitivity, 0)))) +
geom_abline(linetype = "dashed", color = "grey60") +
geom_path(linewidth = 1) +
scale_color_brewer(palette = "Set1") +
scale_x_continuous(labels = coma) +
scale_y_continuous(labels = coma) +
labs(
title = "Curvas ROC de ambos modelos en el conjunto de prueba",
x = "Tasa de falsos positivos (1 - especificidad)", y = "Sensibilidad", color = NULL
) +
theme_minimal() +
theme(legend.position = "bottom")
ggplotly(plot_roc, tooltip = "text") |> plotly_es()Interpretación
El retador pierde. La comparación justa es el AUC, porque no depende del umbral: 0,841 para la regresión logística frente a 0,776 para el bosque aleatorio, una brecha de 0,065. En el gráfico ROC la curva logística (roja) queda por encima de la del bosque (azul) en casi todo su recorrido: con la misma proporción de falsos positivos, encuentra más casos.
Por qué la sensibilidad cae a 33,5 % (frente a 78,6 %). La “probabilidad” de un bosque aleatorio es la proporción de árboles que votan “Sí”. Como solo el 8,6 % de las personas tiene enfermedad cardíaca, la mayoría de las hojas finales tienen mayoría de “No” y la mayoría de los árboles votan “No”; por eso las probabilidades del bosque quedan aplastadas hacia cero. Con el mismo umbral de 8,5 %, marca solo al 7,7 % de las personas y deja escapar la mayoría de los casos. Es una debilidad conocida de estos modelos con clases desbalanceadas, no un error del código. El tramo recto de su curva ROC muestra lo mismo: a la mayoría de las personas el bosque les asigna probabilidad cero, así que no puede ordenarlas entre sí. Su exactitud (89,4 %) parece mejor solo porque dice “No” más veces: la misma trampa descrita para el modelo base que dice “No” a todos.
Las variables más importantes del bosque son Edad, IMC, ACV previo (este tipo de importancia tiende a favorecer las variables numéricas, como la edad y el IMC), así que ambos modelos coinciden en los principales factores de riesgo.
Decisión: la regresión logística es el modelo campeón. Ordena mejor a las personas, sus probabilidades están calibradas (sección de diagnósticos) y se puede explicar a la Junta y a los clínicos factor por factor (razones de oportunidades). Para la gerencia: un modelo más complejo no es automáticamente mejor; tiene que ganarse su lugar con resultados.
Limitación (y cómo se construiría un retador más
justo): el bosque se entrenó con una muestra de 20.000
personas, sin ajuste de parámetros y sin corregir el desbalance. Un
muestreo balanceado en cada árbol
(sampsize/strata en
randomForest), los bosques de probabilidad
(ranger) o la potenciación del gradiente probablemente
reducirían la brecha; esa prueba queda en las mejoras propuestas.
3.4.8 Vista 3D del modelo
# Superficie de probabilidad por edad e IMC para un perfil de referencia: hombre, salud
# "buena", físicamente activo, sin ACV, diabetes ni enfermedad renal.
# Se comparan dos superficies: fumador y no fumador.
ages <- seq(20, 82, by = 2)
bmis <- seq(16, 50, by = 1)
surface_prob <- function(smoker) {
grid <- expand_grid(
age = ages, BMI = bmis,
Sex = "Male", Smoking = smoker, Stroke = "No", Diabetic = "No",
KidneyDisease = "No", DiffWalking = "No", PhysicalActivity = "Yes",
GenHealth = "Good", PhysicalHealth = 0
)
prob <- predict(logit_model, newdata = grid, type = "response")
# Filas = IMC y columnas = edad: el formato de matriz que plotly espera para una superficie
matrix(prob, nrow = length(bmis), ncol = length(ages))
}
z_nonsmoker <- surface_prob("No")
z_smoker <- surface_prob("Yes")
# Texto que aparece al pasar el cursor, en español y con la probabilidad en porcentaje
hover_superficie <- function(grupo) {
paste0(grupo, "<br>Edad: %{x} años<br>IMC: %{y} kg/m²<br>Probabilidad: %{z:.1%}<extra></extra>")
}
plot_ly(x = ages, y = bmis) |>
add_surface(z = z_nonsmoker, name = "No fumador", colorscale = "Viridis",
showscale = FALSE, opacity = 0.9, hovertemplate = hover_superficie("No fumador")) |>
add_surface(z = z_smoker, name = "Fumador", colorscale = "Reds",
showscale = FALSE, opacity = 0.7, hovertemplate = hover_superficie("Fumador")) |>
plotly_es() |>
layout(
title = "Probabilidad predicha por edad e IMC: fumador (rojo) frente a no fumador",
scene = list(
xaxis = list(title = "Edad (años)"),
yaxis = list(title = "IMC (kg/m²)"),
zaxis = list(title = "Probabilidad")
)
)# Nube 3D de 2.000 personas del conjunto de prueba: edad, IMC y probabilidad predicha,
# coloreadas según si realmente tienen enfermedad cardíaca
set.seed(2026)
test_sample <- test_data |>
mutate(
probability = prob_test,
estado = if_else(HeartDisease == "Yes", "Con enfermedad cardíaca", "Sin enfermedad cardíaca")
) |>
slice_sample(n = 2000)
plot_ly(
test_sample,
x = ~age, y = ~BMI, z = ~probability,
color = ~estado, colors = c("#D95F02", "#3B528B"),
type = "scatter3d", mode = "markers", marker = list(size = 3),
hovertemplate = "Edad: %{x} años<br>IMC: %{y:.1f} kg/m²<br>Probabilidad: %{z:.1%}"
) |>
plotly_es() |>
layout(
title = "Probabilidad predicha para 2.000 adultos de prueba (naranja = con enfermedad)",
scene = list(
xaxis = list(title = "Edad (años)"),
yaxis = list(title = "IMC (kg/m²)"),
zaxis = list(title = "Probabilidad predicha")
)
)3.4.9 Interpretación de resultados
- Discriminación: el AUC de prueba es 0,841 (validación cruzada: 0,839), por encima de la meta de 0,80: si se toma al azar una pareja formada por una persona con enfermedad cardíaca y otra sin ella, el modelo le da mayor puntaje a la primera en cerca de 8 de cada 10 casos.
- Sin sobreajuste: el AUC de entrenamiento (0,839) y el de prueba (0,841) son prácticamente iguales; el modelo debería funcionar de forma similar con personas nuevas de una población parecida.
- Sensibilidad: con un umbral de 8,5 %, el modelo detecta al 78,6 % de las personas con enfermedad cardíaca (meta ≥ 70 %) marcando como de alto riesgo al 30,5 % de la población. Detecta 5.500 casos y se le escapan 1.500.
- Rendimiento por invitación: el 22,6 % de las personas invitadas tiene enfermedad cardíaca, frente al 8,8 % si las invitaciones fueran al azar: cerca de 2,6 veces más casos por invitación.
- Costo de ese resultado: la especificidad es 74,2 %, así que se invitaría a 18.850 personas sin la enfermedad (falsos positivos).
- Por qué la exactitud engaña: la exactitud del modelo (74,5 %) es menor que la del modelo base que dice “No” a todos (91,2 %), pero el modelo base no detecta a ningún paciente (sensibilidad 0).
- Gráficos 3D: la superficie muestra que la edad es el factor más fuerte; el IMC sube la probabilidad solo un poco; la superficie del fumador queda siempre por encima de la del no fumador, y la brecha se amplía con la edad. En la nube de puntos, las personas con enfermedad cardíaca se concentran en la zona de mayor probabilidad, aunque algunas aparecen abajo: son los casos que el modelo no detecta.
Se cumplen las tres métricas de éxito (AUC ≥ 0,80; sensibilidad ≥ 70 %; diferencia entrenamiento–prueba ≤ 0,02).
3.4.10 Mejoras propuestas
- Ingeniería de variables (interacciones). Siguiendo
la referencia de regresión lineal múltiple revisada en clase (donde el
efecto de fumar cambia con el IMC), probar si fumar pesa más en personas
con diabetes o si el efecto de la edad difiere por sexo
(
Smoking:Diabetic,age:Sex). - Datos adicionales. Agregar variables clínicas clave que aquí no existen (presión arterial, colesterol, antecedentes familiares, medicamentos) y reentrenar con los datos de reclamaciones e historia clínica electrónica del propio plan antes de usarlo para asignar recursos.
- Un retador más justo. Reentrenar el bosque
aleatorio con más datos, corrigiendo el desbalance de clases (muestreo
balanceado por árbol) y ajustando
mtry, o probar la potenciación del gradiente; adoptarlo solo si supera el AUC de la regresión logística por un margen que justifique la pérdida de interpretabilidad. - Umbral basado en costos. Si la capacidad de cardiología es limitada, subir el umbral para invitar a menos personas, aceptando una menor sensibilidad; la decisión debe sopesar el costo de un caso no detectado frente al de un falso positivo.
4 Narrativa con datos: de la evidencia a la decisión
Este capítulo convierte la evidencia en una narrativa para la Junta,
siguiendo el modelo A³ y los principios de la gramática
de los gráficos: la geometría adecuada para cada mensaje, jerarquía
visual con theme_minimal() y
scale_fill_brewer(), anotaciones explícitas con
annotate() y etiquetas legibles con
ggrepel::geom_text_repel(). Cada gráfico responde tres
preguntas: ¿Qué muestra? ¿Por qué importa? ¿Qué
hacer?
Los gráficos exploratorios de los capítulos 1 a 3 se hicieron para encontrar patrones; los gráficos siguientes están diseñados para explicarlos a quienes toman las decisiones.
4.1 Atención: la carga está concentrada
# Prevalencia y casos por grupo de edad, resaltando el grupo prioritario (65 o más)
age_burden <- heart |>
group_by(AgeCategory) |>
summarise(
prevalence = mean(HeartDisease == "Yes") * 100,
cases = sum(HeartDisease == "Yes")
) |>
mutate(age_band = factor(if_else(AgeCategory %in% age_65_plus, "65 años o más", "Menores de 65"),
levels = c("Menores de 65", "65 años o más")))
share_cases_65 <- sum(age_burden$cases[age_burden$age_band == "65 años o más"]) / sum(age_burden$cases)
share_pop_65 <- mean(heart$AgeCategory %in% age_65_plus)
ggplot(age_burden, aes(x = AgeCategory, y = prevalence, fill = age_band)) +
geom_col(width = 0.75) +
# Color suave para el resto y fuerte para el grupo prioritario (jerarquía visual)
scale_fill_brewer(palette = "Paired") +
scale_x_discrete(labels = etiqueta_edad) +
annotate("text", x = "80 or older", y = max(age_burden$prevalence) + 1.5,
label = pct(max(age_burden$prevalence) / 100), fontface = "bold") +
annotate("text", x = 1, y = 20, hjust = 0, size = 4,
label = paste0("Los adultos de 65 o más son el ", pct(share_pop_65, 0), " de la población\n",
"pero el ", pct(share_cases_65, 0), " de todos los casos de enfermedad cardíaca")) +
labs(
title = "La enfermedad cardíaca se concentra después de los 65 años",
subtitle = "Porcentaje de adultos que reporta enfermedad coronaria o infarto, por grupo de edad",
x = "Grupo de edad (años)", y = "Prevalencia (%)", fill = NULL,
caption = "Fuente: CDC BRFSS 2020 (versión depurada de Kaggle), n = 319.795 adultos"
) +
theme_minimal(base_size = 12) +
theme(legend.position = "top",
panel.grid.major.x = element_blank(),
axis.text.x = element_text(angle = 45, hjust = 1))
Qué muestra. La prevalencia sube de 0,6 % entre los 18 y 24 años a 22,6 % en los de 80 o más. Los adultos de 65 o más son el 35 % de la población, pero concentran el 67 % de todos los casos.
Por qué importa. Las invitaciones que ignoran la edad gastan la mayor parte de la capacidad donde la enfermedad es poco frecuente; dos de cada tres casos están en un grupo fácil de identificar.
Qué hacer. La edad es un criterio fuerte, pero deja por fuera de la lista a uno de cada tres casos. Los siguientes gráficos muestran cómo combinar factores de riesgo encuentra más de ellos con el mismo número de invitaciones.
4.2 Análisis 1: riesgo frente a volumen
# Para cada grupo de riesgo: probabilidad dentro del grupo (riesgo), proporción de todos
# los casos (volumen) y proporción de la población (tamaño de la burbuja)
risk_profile <- function(label, in_group) {
tibble(
group = label,
risk = mean(heart$HeartDisease[in_group] == "Yes") * 100,
share_of_cases = sum(in_group & heart$HeartDisease == "Yes") /
sum(heart$HeartDisease == "Yes") * 100,
share_of_population = mean(in_group) * 100
)
}
risk_volume <- bind_rows(
risk_profile("65 años o más", heart$AgeCategory %in% age_65_plus),
risk_profile("ACV previo", heart$Stroke == "Yes"),
risk_profile("Enfermedad renal", heart$KidneyDisease == "Yes"),
risk_profile("Diabetes", heart$Diabetic == "Yes"),
risk_profile("Fumador (alguna vez)", heart$Smoking == "Yes"),
risk_profile("Hombres", heart$Sex == "Male"),
risk_profile("Dificultad para caminar", heart$DiffWalking == "Yes"),
risk_profile("Salud regular o mala", heart$GenHealth %in% c("Fair", "Poor")),
risk_profile("Físicamente inactivos", heart$PhysicalActivity == "No"),
risk_profile("Obesidad (IMC 30+)", heart$BMI >= 30)
) |>
# Papel estratégico de cada grupo para el diseño del programa
mutate(role = case_when(
share_of_cases >= 50 ~ "Impulsor de volumen (> mitad de los casos)",
risk >= 20 ~ "Nicho de alto riesgo (riesgo >= 20 %)",
TRUE ~ "Factor contribuyente"
))
overall_prevalence <- p_heart * 100
ggplot(risk_volume, aes(x = risk, y = share_of_cases)) +
geom_hline(yintercept = 50, linetype = "dashed", color = "grey60") +
geom_vline(xintercept = overall_prevalence, linetype = "dashed", color = "grey60") +
geom_point(aes(size = share_of_population, fill = role),
shape = 21, color = "grey30", alpha = 0.85) +
ggrepel::geom_text_repel(aes(label = group), size = 3.6, seed = 2026, box.padding = 0.9,
point.padding = 0.6, min.segment.length = 0, max.overlaps = Inf) +
scale_fill_brewer(palette = "Set2") +
scale_size_area(max_size = 16, guide = "none") +
guides(fill = guide_legend(nrow = 1, override.aes = list(size = 5))) +
annotate("text", x = overall_prevalence + 0.4, y = 75, hjust = 0, size = 3.3, color = "grey40",
label = paste0("Riesgo promedio: ", pct(p_heart))) +
annotate("text", x = max(risk_volume$risk), y = 53, hjust = 1, size = 3.3, color = "grey40",
label = "Por encima de esta línea: grupos con más de la mitad de todos los casos") +
labs(
title = "Los mayores de 65 concentran el volumen; el ACV y la enfermedad renal, el riesgo",
subtitle = "Riesgo dentro de cada grupo frente a su proporción de todos los casos\n(tamaño de la burbuja = proporción de la población)",
x = "Riesgo: % con enfermedad cardíaca dentro del grupo",
y = "Volumen: % de todos los casos de enfermedad cardíaca",
fill = "Papel estratégico",
caption = "Los grupos se superponen (una persona puede pertenecer a varios). Fuente: CDC BRFSS 2020"
) +
theme_minimal(base_size = 12) +
theme(legend.position = "bottom", plot.title = element_text(size = 13))
Qué muestra. Los grupos se dividen en dos tipos estratégicos. Los impulsores de volumen (65 años o más, hombres, fumadores) contienen la mayoría de los casos; los nichos de alto riesgo (ACV previo 36,4 %, enfermedad renal 29,3 %, salud regular o mala, dificultad para caminar, diabetes) tienen entre 2,5 y 4 veces el riesgo promedio, pero son grupos pequeños.
Por qué importa. Un solo programa no puede atender a ambos: un programa poblacional llega al volumen, mientras que los nichos necesitan búsqueda activa y seguimiento clínico.
Qué hacer. Combinar una invitación focalizada para el grupo de alto volumen con alertas automáticas para las condiciones de nicho (ACV, enfermedad renal) dentro de las rutas de atención existentes.
4.3 Análisis 2: el puntaje combinado supera a toda regla de un solo criterio
# Curva de captura: las personas se ordenan de mayor a menor riesgo predicho y se sigue
# la proporción acumulada de casos encontrados a medida que se invita a más personas
case_test <- test_data$HeartDisease == "Yes"
capture_full <- tibble(prob = prob_test, case = case_test) |>
arrange(desc(prob)) |>
mutate(
pct_invited = row_number() / n() * 100,
pct_detected = cumsum(case) / sum(case) * 100
)
# Un punto cada 80 personas: la misma curva, un gráfico más liviano
capture <- capture_full |> filter(row_number() %% 80 == 0)
# Reglas de un solo criterio que un programa podría usar hoy, evaluadas en el mismo conjunto de prueba
prior_diagnosis <- test_data$Stroke == "Yes" | test_data$Diabetic == "Yes" |
test_data$KidneyDisease == "Yes"
rules <- tibble(
rule = c("Edad 65+", "Diagnóstico previo\n(ACV, diabetes o renal)", "Edad 65+ o diagnóstico previo"),
flag = list(test_data$age >= 65, prior_diagnosis, test_data$age >= 65 | prior_diagnosis)
) |>
mutate(
pct_invited = map_dbl(flag, \(f) mean(f) * 100),
pct_detected = map_dbl(flag, \(f) sum(f & case_test) / sum(case_test) * 100),
# Casos que el puntaje encontraría invitando exactamente al mismo número de personas
score_detected = map_dbl(pct_invited, \(p) capture_full$pct_detected[ceiling(p / 100 * nrow(capture_full))]),
gain_points = score_detected - pct_detected
) |>
select(-flag)
op_invited <- metrics_test$Pct_high_risk * 100
op_detected <- metrics_test$Sensitivity * 100
# Texto en español para las etiquetas emergentes del gráfico interactivo
capture <- capture |>
mutate(texto = paste0("Puntaje<br>Invitados: ", num(pct_invited, 0), " %",
"<br>Casos encontrados: ", num(pct_detected, 0), " %"))
rules <- rules |>
mutate(texto = paste0(str_replace_all(rule, "\n", " "),
"<br>Invitados: ", num(pct_invited, 0), " %",
"<br>Casos que encuentra la regla: ", num(pct_detected, 0), " %",
"<br>Casos que encontraría el puntaje: ", num(score_detected, 0), " %"))
# Base común del gráfico estático y del interactivo
plot_capture <- ggplot(capture, aes(x = pct_invited, y = pct_detected)) +
geom_abline(slope = 1, intercept = 0, linetype = "dashed", color = "grey50") +
geom_line(aes(text = texto, group = 1), color = "#1F78B4", linewidth = 1.2) +
geom_segment(data = rules, aes(x = pct_invited, xend = pct_invited,
y = pct_detected, yend = score_detected),
color = "#FF7F00", linetype = "dotted") +
geom_point(data = rules, aes(x = pct_invited, y = pct_detected, text = texto),
shape = 21, fill = "#FF7F00", color = "grey20", size = 4) +
annotate("point", x = op_invited, y = op_detected, size = 4, color = "#E31A1C") +
annotate("text", x = 80, y = 66, size = 3.4, color = "grey40", label = "Invitaciones al azar") +
scale_x_continuous(limits = c(0, 100)) +
scale_y_continuous(limits = c(0, 100)) +
labs(
x = "% de la población invitada",
y = "% de casos de enfermedad cardíaca encontrados"
) +
theme_minimal(base_size = 12)
# Versión estática: títulos completos, nota del punto propuesto y etiquetas sin superposición
plot_capture +
annotate("text", x = op_invited + 3, y = op_detected - 8, hjust = 0, size = 3.6,
label = paste0("Propuesta: el ", num(op_invited, 0), " % con mayor puntaje\n",
"encuentra el ", num(op_detected, 0), " % de los casos")) +
ggrepel::geom_text_repel(data = rules, aes(x = pct_invited, y = pct_detected, label = rule),
size = 3.3, seed = 2026, nudge_y = -12, box.padding = 0.6,
min.segment.length = 0) +
labs(
title = "El puntaje combinado encuentra más casos que cualquier regla de un solo criterio",
subtitle = paste0("Azul: casos que encuentra el puntaje a medida que se invita a más afiliados.\n",
"Naranja: reglas de un solo criterio (punteado = casos que dejan de encontrar)."),
caption = "Regresión logística con 11 predictores; conjunto de prueba (25 % de los datos)"
) +
theme(plot.title = element_text(size = 13), plot.subtitle = element_text(size = 10))
rules |>
mutate(rule = str_replace_all(rule, "\n", " ")) |>
select(-texto) |>
tabla(
digits = 1,
col.names = c("Regla de invitación", "% invitado", "% de casos encontrados (regla)",
"% de casos encontrados (puntaje, mismas invitaciones)", "Ganancia (puntos porcentuales)"),
caption = "Reglas de un solo criterio frente al puntaje combinado con el mismo número de invitaciones"
)| Regla de invitación | % invitado | % de casos encontrados (regla) | % de casos encontrados (puntaje, mismas invitaciones) | Ganancia (puntos porcentuales) |
|---|---|---|---|---|
| Edad 65+ | 34,9 | 67,0 | 83,2 | 16,3 |
| Diagnóstico previo (ACV, diabetes o renal) | 17,6 | 47,3 | 58,8 | 11,5 |
| Edad 65+ o diagnóstico previo | 42,6 | 82,2 | 89,0 | 6,8 |
Versión interactiva. La Junta puede preferir un nivel de capacidad distinto del propuesto. El gráfico interactivo (etiquetas emergentes, zoom y desplazamiento) permite que cada gerente lea cuántos casos encontraría el puntaje para cualquier proporción de invitaciones y lo compare con cada regla, sin tener que pedírselo al analista.
# Título corto: en la versión interactiva los subtítulos largos se recortan
ggplotly(plot_capture + labs(title = "Puntaje (azul) frente a reglas de un solo criterio (naranja)"),
tooltip = "text") |>
plotly_es()Qué muestra. Todas las reglas de un solo criterio (naranja) quedan por debajo de la curva del puntaje: con el mismo número de invitaciones, el puntaje encuentra entre 7 y 16 puntos porcentuales más casos. Invitar a todos los mayores de 65 encuentra el 67 % de los casos; el puntaje, invitando al mismo número de personas, encuentra el 83 %. En el punto de operación propuesto, el 30 % con mayor puntaje reúne el 79 % de los casos: 23 casos por cada 100 invitaciones, frente a 9 al azar.
Por qué importa. Los programas ya usan factores de riesgo, pero de uno en uno. Combinarlos es lo que marca la diferencia: la misma capacidad de cardiología llega a más de las personas que la necesitan.
Qué hacer. Construir la lista de invitados a partir del puntaje y dejar que la capacidad disponible decida hasta dónde de la lista llega el programa.
4.4 Acción: planear la capacidad con percentiles, no con promedios
# Casos por jornada de tamizaje, resaltando los días que 9 cupos (el promedio) no cubrirían
days <- tibble(cases = cases_per_day) |>
count(cases) |>
mutate(plan = factor(
if_else(cases > 9, "Déficit si se planea con el promedio (9 cupos)", "Cubierto con 9 cupos"),
levels = c("Déficit si se planea con el promedio (9 cupos)", "Cubierto con 9 cupos")
))
p95_slots <- unname(quantile(cases_per_day, 0.95))
ggplot(days, aes(x = cases, y = n, fill = plan)) +
geom_col() +
geom_vline(xintercept = p95_slots + 0.5, linetype = "dashed") +
annotate("text", x = p95_slots + 0.8, y = max(days$n) * 0.85, hjust = 0, size = 3.8,
label = paste0("Planear ", p95_slots, " cupos:\ncubre el 95 % de los días")) +
scale_fill_brewer(palette = "Set1") +
labs(
title = paste0("Planear con el promedio deja cortos el ", pct(mean(cases_per_day > 9), 0),
" de los días de tamizaje"),
subtitle = "Casos de enfermedad cardíaca por jornada de tamizaje de 100 pacientes (1.000 días simulados)",
x = "Casos por jornada de tamizaje", y = "Número de días", fill = NULL,
caption = "Simulación con rbinom(); probabilidad de enfermedad cardíaca = 8,6 %"
) +
theme_minimal(base_size = 12) +
theme(legend.position = "top")
Qué muestra. Con 9 cupos por día (el promedio), la demanda supera la capacidad en el 35 % de los días; con 13 cupos, en cerca del 5 %.
Por qué importa. La demanda insatisfecha en las jornadas de tamizaje significa pacientes que se devuelven sin valoración, costos de reprogramación y pérdida de confianza en el programa.
Qué hacer. Programar cada jornada de tamizaje de 100 pacientes con 13 valoraciones de cardiología y hacer seguimiento a la proporción de días con demanda insatisfecha.
4.5 Recomendaciones ejecutivas
Recomendación 1 — Un piloto de 12 meses en tres etapas de invitaciones basadas en el puntaje. Propuesto por la Vicepresidencia de Salud Poblacional; la Junta decide en cada punto de control.
| Etapa | Meses | Qué ocurre | Punto de control de la Junta (seguir / ajustar / parar) |
|---|---|---|---|
| 0. Validación | 1–3 | Reestimar y recalibrar el puntaje con los datos de reclamaciones e historia clínica electrónica del plan (cumpliendo HIPAA); medir la línea base de la regla actual (invitaciones, asistencia, casos encontrados) | Mes 3: continuar solo si, con los datos del plan, el puntaje supera a la regla actual por ≥ 5 puntos porcentuales de casos encontrados con las mismas invitaciones y el AUC es ≥ 0,75 |
| 1. Piloto | 4–9 | Una región: invitar a los afiliados según el puntaje; alertas automáticas para pacientes con ACV y enfermedad renal; cupos planeados con el percentil 95 | Mes 6: revisión intermedia de asistencia, casos encontrados y días con demanda insatisfecha |
| 2. Evaluación | 10–12 | Comparar con la línea base; estimar el costo por caso encontrado | Mes 12: escalar, ajustar o parar |
Recomendación 2 — Planeación de la capacidad por percentiles. Propuesta por la Vicepresidencia de Operaciones: programar cada jornada de tamizaje de 100 afiliados con 13 valoraciones de cardiología (percentil 95) en lugar del promedio, empezando por la región del piloto.
Metas realistas. Las metas están deliberadamente por debajo de lo que logró el modelo en estos datos, porque los modelos suelen perder desempeño en una población nueva y porque el tamizaje busca personas no diagnosticadas, que son más difíciles de encontrar:
| Indicador | En estos datos | Meta del piloto |
|---|---|---|
| Ganancia sobre la regla actual (casos encontrados, mismas invitaciones) | 7–16 puntos | ≥ 5 puntos |
| AUC con los datos del propio plan | 0,84 | ≥ 0,75 |
| Sensibilidad (casos dentro de la lista de alto riesgo) | 79 % | ≥ 70 % |
| Asistencia a la consulta de tamizaje | No medida | Se fija con la línea base del mes 3 |
| Días de tamizaje con demanda insatisfecha | 35 % si se planea con el promedio | ≤ 5 % |
Estos indicadores se siguen en el tablero de la Junta: https://rpubs.com/JuanSilva11/1470162
4.6 Limitaciones y cómo las aborda el piloto
| Limitación | Consecuencia | Cómo la aborda el piloto |
|---|---|---|
| Encuesta nacional (BRFSS 2020), no los afiliados del plan; sin ponderadores muestrales | Las cifras describen a los encuestados, no a la población del plan | La etapa 0 reestima el puntaje con los datos del plan |
| El desenlace es enfermedad cardíaca ya diagnosticada; el tamizaje busca personas no diagnosticadas | El rendimiento real será menor que en estos datos | Metas conservadoras, medidas frente a la regla actual |
| Datos transversales y autorreportados | Asociaciones, no causas | El puntaje se usa para priorizar, no para explicar causas |
| Sin datos de costos | No se puede afirmar ahorro | El informe habla de eficiencia (casos por invitación); el costo por caso se mide en la etapa 2 |
| Los escenarios de capacidad dependen de supuestos | Las cifras son ilustrativas | Se reemplazan con datos reales de asistencia e ingresos durante el piloto |
4.7 Más allá del piloto: transferir el método a Colombia
Por qué esta sección. Lo que la Junta está adquiriendo no es una cifra de una encuesta estadounidense; es un método: construir un puntaje de riesgo, compararlo con la regla actual con el mismo número de invitaciones, planear la capacidad con percentiles y decidir en puntos de control. Un método que solo funciona con una base de datos es débil. Esta sección pone a prueba si puede llevarse a un sistema muy distinto, el colombiano. El método se transfiere; las cifras no. Cada número de este informe tendría que estimarse de nuevo con datos colombianos.
Qué cambia en el sistema colombiano.
| Componente | Estados Unidos (este informe) | Colombia (transferencia) |
|---|---|---|
| Quién invita | Plan de salud regional | EPS (aseguradora), a través de su red de IPS (prestadores) |
| Población | Afiliados del plan | Afiliados de los regímenes contributivo y subsidiado, con condiciones de acceso muy distintas |
| Fuente principal de datos | Encuesta autorreportada (BRFSS) | RIPS (registros individuales de prestación de servicios, hoy ligados a la factura electrónica, Resolución 2275 de 2023), historia clínica electrónica y el registro de la Cuenta de Alto Costo de hipertensión, diabetes y enfermedad renal crónica |
| Cómo se registran los factores de riesgo | Respuestas sí/no | Códigos diagnósticos CIE-10: ACV I60–I69, diabetes E10–E14, enfermedad renal crónica N18, hipertensión I10–I15; desenlace: enfermedad isquémica del corazón I20–I25 |
| Dónde encaja el tamizaje | Programa de prevención del plan | La ruta de promoción y mantenimiento de la salud (RIAS, Resolución 3280 de 2018) y los programas de riesgo cardiovascular de las EPS |
| Protección de datos | HIPAA | Ley 1581 de 2012 (protección de datos personales) |
Hoja de ruta de transferencia (propuesta; no hace parte de la decisión de 12 meses en Estados Unidos).
- Mapear las variables. Traducir las 11 preguntas de la encuesta a los registros colombianos. La edad, el sexo, el ACV, la diabetes y la enfermedad renal pueden tomarse de los códigos de los RIPS. El IMC y el tabaquismo solo están en la historia clínica, a menudo incompletos. La salud autopercibida y la dificultad para caminar, dos de los predictores más fuertes, no se registran de forma rutinaria y requerirían un cuestionario corto en la consulta de promoción y mantenimiento.
- Redefinir el desenlace y mejorar este informe. En lugar de “ya diagnosticado” (la principal limitación aquí), predecir un diagnóstico nuevo de enfermedad isquémica del corazón u hospitalización en los siguientes 12 meses entre afiliados que hoy no lo tienen. Los datos de prestación de servicios lo permiten; una encuesta de un solo momento no.
- Reestimar y validar de forma retrospectiva. Entrenar los mismos dos modelos (regresión logística y bosque aleatorio) con datos históricos de una EPS y compararlos con su regla actual de selección con el mismo número de invitaciones, como en el Análisis 2.
- Pilotear dentro de la ruta existente en un departamento, con la misma lógica de seguir / ajustar / parar, antes de escalar.
¿Cuánto cambiaría el rendimiento? La prevalencia de enfermedad cardíaca diagnosticada en la población de una EPS colombiana no se conoce a partir de este informe y probablemente es menor que 8,6 % (población más joven, más subdiagnóstico). El siguiente bloque muestra, solo como escenarios, el rendimiento por cada 100 invitaciones si el puntaje mantuviera la sensibilidad y la especificidad medidas aquí:
# El rendimiento (valor predictivo positivo) depende de la prevalencia, no solo del modelo:
# VPP = sens * p / (sens * p + (1 - esp) * (1 - p)).
# SUPUESTO: el puntaje conserva la sensibilidad y especificidad de este informe,
# lo cual es optimista; las prevalencias son ilustrativas, no estimaciones colombianas
sens_score <- metrics_test$Sensitivity
spec_score <- metrics_test$Specificity
colombia_scenarios <- tibble(prevalence = c(0.02, 0.04, 0.06, mean(test_data$HeartDisease == "Yes"))) |>
mutate(
yield_score = sens_score * prevalence /
(sens_score * prevalence + (1 - spec_score) * (1 - prevalence)),
yield_random = prevalence,
lift = yield_score / yield_random,
Scenario = if_else(row_number() == n(), "Estos datos (EE. UU.)", "Escenario colombiano")
) |>
relocate(Scenario)
colombia_scenarios |>
mutate(
prevalence = pct(prevalence),
yield_score = num(100 * yield_score),
yield_random = num(100 * yield_random),
lift = paste0(num(lift), " veces")
) |>
tabla(
col.names = c("Escenario", "Prevalencia", "Casos por 100 invitaciones (puntaje)",
"Casos por 100 invitaciones (azar)", "Multiplicador frente al azar"),
caption = "Rendimiento ilustrativo del puntaje con prevalencias más bajas"
)| Escenario | Prevalencia | Casos por 100 invitaciones (puntaje) | Casos por 100 invitaciones (azar) | Multiplicador frente al azar |
|---|---|---|---|---|
| Escenario colombiano | 2,0 % | 5,8 | 2,0 | 2,9 veces |
| Escenario colombiano | 4,0 % | 11,2 | 4,0 | 2,8 veces |
| Escenario colombiano | 6,0 % | 16,3 | 6,0 | 2,7 veces |
| Estos datos (EE. UU.) | 8,8 % | 22,6 | 8,8 | 2,6 veces |
Qué nos dice. Con una prevalencia de 2 %, el puntaje encontraría apenas unos 5,8 casos por cada 100 invitaciones, muchos menos que aquí, pero todavía cerca de 2,9 veces lo que encontrarían las invitaciones al azar. Para la gerencia: en Colombia las metas absolutas deben fijarse más bajas; el argumento a favor del puntaje es la ganancia relativa sobre la regla actual, no el rendimiento de Estados Unidos.
Errores y limitaciones que se deben esperar.
| Riesgo | Por qué importa | Mitigación |
|---|---|---|
| Códigos diagnósticos registrados para facturar, no para investigar | Códigos faltantes o vagos (códigos de síntomas en vez de diagnósticos) debilitan el puntaje | Auditar una muestra de registros contra la historia clínica antes de entrenar |
| Subdiagnóstico y acceso desigual (zonas rurales, régimen subsidiado) | El modelo aprende quién recibe diagnóstico, no quién está enfermo, y puede ubicar más abajo a los grupos con menos acceso | Evaluar la sensibilidad por separado según régimen y región; no implementar si algún grupo queda claramente peor atendido |
| IMC, tabaquismo y salud autopercibida ausentes en los datos administrativos | Los predictores más fuertes no estarían disponibles | Dos versiones: un puntaje solo con registros y otro con registros más cuestionario; quedarse con el que supere a la regla actual |
| Afiliados que se trasladan de EPS | Historia incompleta para parte de la población | Exigir un tiempo mínimo de afiliación en los datos de entrenamiento |
| Estructura de edad más joven | Una regla solo por edad cubre a menos personas, y la calibración con datos de EE. UU. sería incorrecta | Recalibrar con datos locales; nunca reutilizar los coeficientes de EE. UU. |
| Protección de datos y consentimiento | Usar datos de salud para invitar personas requiere una base legal y una finalidad clara | Revisión jurídica bajo la Ley 1581 de 2012 antes de la etapa 0 |
Las referencias normativas anteriores deben confirmarse con el equipo jurídico de la EPS; se citan como punto de partida, no como asesoría legal.
Referencias
- Centers for Disease Control and Prevention (CDC). Behavioral Risk Factor Surveillance System (BRFSS), 2020 Survey Data and Documentation. https://www.cdc.gov/brfss/annual_data/annual_2020.html
- Personal Key Indicators of Heart Disease [conjunto de datos]. Kaggle. https://www.kaggle.com/datasets/kamilpytlak/personal-key-indicators-of-heart-disease
- García Díaz, C. M. (2025). Probabilidad y estadística aplicada; Modelos de analítica de datos; Storytelling con RStudio [material del curso]. Fundación Universitaria de Ciencias de la Salud (FUCS).
- García Sabaté, D. Regresión lineal múltiple: predicción de gastos médicos. RPubs. https://rpubs.com/DavidGS/rlm
- Martínez Bautista, H. Explorando medicaldata en R. RPubs. https://rpubs.com/Humberto_Mtz_Bta/1229095
- Data4HR. Visualización de datos con ggplot2. RPubs. https://rpubs.com/Data4HR/visualizacion-humanos-reales
- James, G., Witten, D., Hastie, T. y Tibshirani, R. (2021). An Introduction to Statistical Learning with Applications in R (2.ª ed.), cap. 4. Springer.
- Nussbaumer Knaflic, C. (2019). Storytelling con datos: ejemplos prácticos. Anaya Multimedia.
- Breiman, L. (2001). Random forests. Machine Learning, 45(1), 5–32.
- Congreso de la República de Colombia. Ley 1581 de 2012, por la cual se dictan disposiciones generales para la protección de datos personales.
- Ministerio de Salud y Protección Social de Colombia. Resolución 3280 de 2018 (Rutas Integrales de Atención en Salud: promoción y mantenimiento de la salud). https://normograma.supersalud.gov.co/compilacion/docs/resolucion_minsaludps_3280_2018.htm
- Ministerio de Salud y Protección Social de Colombia. Resolución 2275 de 2023 (Registro Individual de Prestación de Servicios de Salud, RIPS, como soporte de la factura electrónica). https://www.saludcapital.gov.co/DPYS/Normatividad/Resoluciones/Res_2275-2023.pdf