Contexto y objetivos

Reto de gestión

Una EPS o una red de IPS necesita priorizar a quién invitar primero a un programa de tamizaje y prevención cardiovascular, porque no tiene capacidad para valorar por cardiología a toda su población al mismo tiempo. En el análisis anterior (probabilidad y estadística) se encontró que la enfermedad cardíaca afecta al 8,6 % de los encuestados y que se concentra en personas mayores, con antecedente de ACV, fumadoras y de sexo masculino. El siguiente paso es combinar todos esos factores en un modelo de clasificación que asigne a cada persona una probabilidad de tener enfermedad cardíaca y la clasifique como de riesgo alto o bajo.

Metas de negocio

  • Identificar a la mayoría de las personas con enfermedad cardíaca concentrando la búsqueda en una fracción de la población.
  • Contar con una herramienta sencilla, basada en preguntas que se pueden hacer en una consulta o por teléfono, y cuyas reglas se puedan explicar a médicos y directivos.

Métricas de éxito

Métrica Qué mide Meta
AUC (área bajo la curva ROC) Capacidad del modelo para asignar más riesgo a quien tiene la enfermedad que a quien no; 0,5 = azar, 1 = perfecto ≥ 0,80 en el conjunto de prueba
Sensibilidad De cada 100 personas con enfermedad cardíaca, cuántas clasifica el modelo como de riesgo alto ≥ 70 %
Diferencia entre entrenamiento y prueba Si el modelo “memorizó” los datos (sobreajuste) AUC con una diferencia ≤ 0,02

La exactitud (porcentaje de aciertos) no se usa como métrica principal: como solo el 8,6 % tiene la enfermedad, un modelo que dijera que nadie la tiene acertaría en más del 91 % de los casos sin detectar a ningún paciente.

Selección de variables

Variables candidatas y justificación

Grupo Variables incluidas Justificación
Demográficas Edad (AgeCategory), sexo (Sex) La probabilidad pasó de 0,6 % a 22,6 % con la edad y fue mayor en hombres (10,6 % frente a 6,7 %)
Hábitos y peso Tabaquismo (Smoking), actividad física (PhysicalActivity), IMC (BMI) Factores de riesgo modificables, sobre los que actúan los programas de prevención
Antecedentes clínicos ACV (Stroke), diabetes (Diabetic), enfermedad renal (KidneyDisease) Enfermedades que comparten mecanismos con la enfermedad cardíaca; el ACV mostró el riesgo más alto (36,4 %)
Estado funcional Salud percibida (GenHealth), dificultad para caminar (DiffWalking), días de mala salud física (PhysicalHealth) Resumen la carga de enfermedad y se obtienen con preguntas sencillas

Variables excluidas:

  • Raza (Race): un modelo que decide a quién se le asignan recursos no debe usar la raza como criterio, por razones de equidad.
  • Consumo excesivo de alcohol (AlcoholDrinking): en esta base se asocia con menos enfermedad cardíaca (5,2 % frente a 8,8 %), probablemente porque muchas personas enfermas dejan de beber. Incluirlo daría un mensaje equivocado.
  • Asma, cáncer de piel, salud mental y horas de sueño: tienen una relación clínica menos directa con la enfermedad cardíaca. Se priorizó un modelo parsimonioso (con pocas variables, fácil de aplicar y explicar).

Hipótesis de trabajo

  1. A mayor edad, mayor probabilidad de enfermedad cardíaca.
  2. El antecedente de ACV, la diabetes y la enfermedad renal aumentan la probabilidad.
  3. El tabaquismo aumenta la probabilidad y la actividad física la disminuye.
  4. Una peor salud percibida se asocia con mayor probabilidad.

Esquema conceptual del modelo

# Diagrama de relaciones entre las variables y la técnica elegida
DiagrammeR::grViz("
digraph modelo {
  graph [rankdir = LR, fontname = Helvetica]
  node  [shape = box, style = 'rounded,filled', fillcolor = '#E8EEF7',
         fontname = Helvetica, fontsize = 11]

  demo     [label = 'Demográficas\\nEdad, sexo']
  habitos  [label = 'Hábitos y peso\\nTabaquismo, actividad física, IMC']
  clinicos [label = 'Antecedentes clínicos\\nACV, diabetes, enfermedad renal']
  funcion  [label = 'Estado funcional\\nSalud percibida, dificultad para caminar,\\ndías de mala salud física']

  modelo   [label = 'Regresión logística\\n(entrenamiento: 75 %)', fillcolor = '#3B528B', fontcolor = white]
  prob     [label = 'Probabilidad de\\nenfermedad cardíaca']
  decision [label = 'Riesgo alto: priorizar tamizaje\\nRiesgo bajo: seguimiento habitual', fillcolor = '#FBE3D0']
  evalua   [label = 'Evaluación (prueba: 25 %)\\nAUC y sensibilidad', shape = note]

  {demo habitos clinicos funcion} -> modelo -> prob -> decision
  prob -> evalua [style = dashed]
}
")

Técnica elegida: regresión logística. Es el modelo estándar para un resultado de dos categorías (sí/no). Calcula la probabilidad de enfermedad cardíaca a partir de una suma ponderada de las variables:

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)  = "odds" o chances (por ejemplo, p = 0,20 equivale a chances de 1 a 4)
exp(b)     = razón de odds (OR): cuántas veces se multiplican las chances
             cuando la variable aumenta en una unidad o pasa de "No" a "Sí"

Pseudocódigo del flujo:

1. Seleccionar variables y limpiar los datos
2. Dividir: 75 % entrenamiento / 25 % prueba (estratificado por HeartDisease)
3. Ajustar la regresión logística con validación cruzada de 5 pliegues
4. Diagnosticar: multicolinealidad, residuos, observaciones influyentes y calibración
5. Evaluar en prueba: AUC, sensibilidad, especificidad
6. Clasificar: riesgo alto si la probabilidad >= umbral
7. Proponer mejoras

Implementación en RStudio

Exploración y selección de variables

# Estructura de la base completa: 18 variables candidatas
glimpse(corazon)
## Rows: 319,795
## Columns: 18
## $ HeartDisease     <chr> "No", "No", "No", "No", "No", "Yes", "No", "No", "No"…
## $ BMI              <dbl> 16.60, 20.34, 26.58, 24.21, 23.71, 28.87, 21.63, 31.6…
## $ Smoking          <chr> "Yes", "No", "Yes", "No", "No", "Yes", "No", "Yes", "…
## $ AlcoholDrinking  <chr> "No", "No", "No", "No", "No", "No", "No", "No", "No",…
## $ Stroke           <chr> "No", "Yes", "No", "No", "No", "No", "No", "No", "No"…
## $ PhysicalHealth   <dbl> 3, 0, 20, 0, 28, 6, 15, 5, 0, 0, 30, 0, 0, 7, 0, 1, 5…
## $ MentalHealth     <dbl> 30, 0, 30, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 30, 0, 2,…
## $ DiffWalking      <chr> "No", "No", "No", "No", "Yes", "Yes", "No", "Yes", "N…
## $ Sex              <chr> "Female", "Female", "Male", "Female", "Female", "Fema…
## $ AgeCategory      <chr> "55-59", "80 or older", "65-69", "75-79", "40-44", "7…
## $ Race             <chr> "White", "White", "White", "White", "White", "Black",…
## $ Diabetic         <chr> "Yes", "No", "Yes", "No", "No", "No", "No", "Yes", "N…
## $ PhysicalActivity <chr> "Yes", "Yes", "Yes", "No", "Yes", "No", "Yes", "No", …
## $ GenHealth        <chr> "Very good", "Very good", "Fair", "Good", "Very good"…
## $ SleepTime        <dbl> 5, 7, 8, 6, 8, 12, 4, 9, 5, 10, 15, 5, 8, 7, 5, 6, 10…
## $ Asthma           <chr> "Yes", "No", "Yes", "No", "No", "No", "Yes", "Yes", "…
## $ KidneyDisease    <chr> "No", "No", "No", "No", "No", "No", "No", "No", "Yes"…
## $ SkinCancer       <chr> "Yes", "No", "No", "Yes", "No", "No", "Yes", "No", "N…
datos_modelo <- corazon |>
  # Solo las variables justificadas en la sección anterior
  select(HeartDisease, AgeCategory, Sex, Smoking, Stroke, Diabetic, KidneyDisease,
         DiffWalking, PhysicalActivity, GenHealth, BMI, PhysicalHealth) |>
  # La base no tiene faltantes, pero se deja el paso para que el flujo sirva con otros datos
  drop_na() |>
  mutate(
    # "No" primero: así el modelo estima la probabilidad de "Yes"
    HeartDisease = factor(HeartDisease, levels = c("No", "Yes")),
    # Edad aproximada (inicio del grupo + 2 años; ej. "55-59" -> 57) para leer el efecto por año
    edad = as.numeric(str_sub(AgeCategory, 1, 2)) + 2,
    # "Excellent" como referencia: los OR indican cuánto aumenta el riesgo al empeorar la salud
    GenHealth = factor(GenHealth, levels = c("Excellent", "Very good", "Good", "Fair", "Poor"))
  ) |>
  select(-AgeCategory)

# Descripción de las variables seleccionadas: tipo, faltantes, distribución
skimr::skim(datos_modelo)
Data summary
Name datos_modelo
Number of rows 319795
Number of columns 12
_______________________
Column type frequency:
character 7
factor 2
numeric 3
________________________
Group variables None

Variable type: character

skim_variable n_missing complete_rate min max empty n_unique whitespace
Sex 0 1 4 6 0 2 0
Smoking 0 1 2 3 0 2 0
Stroke 0 1 2 3 0 2 0
Diabetic 0 1 2 23 0 4 0
KidneyDisease 0 1 2 3 0 2 0
DiffWalking 0 1 2 3 0 2 0
PhysicalActivity 0 1 2 3 0 2 0

Variable type: factor

skim_variable n_missing complete_rate ordered n_unique top_counts
HeartDisease 0 1 FALSE 2 No: 292422, Yes: 27373
GenHealth 0 1 FALSE 5 Ver: 113858, Goo: 93129, Exc: 66842, Fai: 34677

Variable type: numeric

skim_variable n_missing complete_rate mean sd p0 p25 p50 p75 p100 hist
BMI 0 1 28.33 6.36 12.02 24.03 27.34 31.42 94.85 ▇▅▁▁▁
PhysicalHealth 0 1 3.37 7.95 0.00 0.00 0.00 2.00 30.00 ▇▁▁▁▁
edad 0 1 54.44 18.07 20.00 42.00 57.00 67.00 82.00 ▆▅▇▇▇

División en entrenamiento y prueba

# Semilla: la división al azar es reproducible
set.seed(2026)

# Estratificar por HeartDisease garantiza el mismo 8,6 % de casos en ambos conjuntos
division <- initial_split(datos_modelo, prop = 0.75, strata = HeartDisease)
entrenamiento <- training(division)
prueba        <- testing(division)

# Verificación: tamaño y proporción de casos en cada conjunto
tibble(
  conjunto  = c("Entrenamiento", "Prueba"),
  personas  = c(nrow(entrenamiento), nrow(prueba)),
  pct_casos = c(mean(entrenamiento$HeartDisease == "Yes"),
                mean(prueba$HeartDisease == "Yes")) * 100
)
## # A tibble: 2 × 3
##   conjunto      personas pct_casos
##   <chr>            <int>     <dbl>
## 1 Entrenamiento   239846      8.49
## 2 Prueba           79949      8.76

Ajuste del modelo

# Fórmula común para caret y glm: resultado ~ variables explicativas
formula_modelo <- HeartDisease ~ edad + Sex + Smoking + Stroke + Diabetic +
  KidneyDisease + DiffWalking + PhysicalActivity + GenHealth + BMI + PhysicalHealth
# Validación cruzada de 5 pliegues: el entrenamiento se divide en 5 partes y el
# modelo se ajusta 5 veces, evaluando cada vez en la parte que no vio.
# Así se estima el desempeño sin tocar todavía el conjunto de prueba.
control_cv <- 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)
modelo_cv <- caret::train(
  formula_modelo,
  data = entrenamiento,
  method = "glm",            # regresión logística
  family = "binomial",
  trControl = control_cv,
  metric = "ROC"
)

# AUC promedio de los 5 pliegues y su variación
modelo_cv$results |> select(ROC, ROCSD)
##         ROC       ROCSD
## 1 0.8386642 0.002821095
# El mismo modelo con glm(), la función que caret usa por dentro.
# Se ajusta directamente porque su salida es más fácil de leer y diagnosticar.
modelo_glm <- glm(formula_modelo, data = entrenamiento, family = binomial)

# Razones de odds (OR) con intervalo de confianza del 95 % (método de Wald)
tabla_or <- broom::tidy(modelo_glm) |>
  filter(term != "(Intercept)") |>
  mutate(
    OR     = exp(estimate),
    IC_inf = exp(estimate - 1.96 * std.error),
    IC_sup = exp(estimate + 1.96 * std.error)
  ) |>
  select(term, OR, IC_inf, IC_sup, p.value) |>
  arrange(desc(OR))

knitr::kable(tabla_or, digits = 3,
             caption = "Razones de odds del modelo (ordenadas de mayor a menor)")
Razones de odds del modelo (ordenadas de mayor a menor)
term OR IC_inf IC_sup p.value
GenHealthPoor 6.660 6.078 7.297 0.000
GenHealthFair 4.525 4.205 4.871 0.000
StrokeYes 2.863 2.721 3.013 0.000
GenHealthGood 2.797 2.617 2.989 0.000
SexMale 1.967 1.904 2.033 0.000
KidneyDiseaseYes 1.774 1.679 1.875 0.000
DiabeticYes 1.596 1.537 1.657 0.000
GenHealthVery good 1.557 1.454 1.667 0.000
SmokingYes 1.446 1.400 1.493 0.000
DiffWalkingYes 1.235 1.186 1.287 0.000
DiabeticYes (during pregnancy) 1.218 0.966 1.534 0.095
DiabeticNo, borderline diabetes 1.171 1.066 1.286 0.001
edad 1.055 1.054 1.057 0.000
PhysicalActivityYes 1.039 1.002 1.078 0.038
BMI 1.012 1.009 1.014 0.000
PhysicalHealth 1.007 1.005 1.009 0.000 
# Vectores con nombre para citar los valores dentro del texto
or_vec     <- setNames(tabla_or$OR, tabla_or$term)
ic_inf_vec <- setNames(tabla_or$IC_inf, tabla_or$term)
ic_sup_vec <- setNames(tabla_or$IC_sup, tabla_or$term)

Interpretación de los coeficientes

Todas las asociaciones van en la dirección esperada, salvo la actividad física y la diabetes gestacional (esta última, con muy pocos casos, no muestra una asociación clara). Manteniendo constantes las demás variables:

  • Salud percibida: es el factor con mayor peso. Frente a quienes reportan salud excelente, las chances de enfermedad cardíaca se multiplican por 6,7 con salud mala y por 4,5 con salud regular.
  • ACV: el antecedente de ACV multiplica las chances por 2,9.
  • Sexo: ser hombre las multiplica por 2,0.
  • Enfermedad renal y diabetes: las multiplican por 1,8 y 1,6, respectivamente.
  • Tabaquismo y dificultad para caminar: las multiplican por 1,4 y 1,2, respectivamente.
  • Edad: cada 10 años adicionales multiplican las chances por 1,7.
  • IMC y 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).
  • Actividad física: una vez se tienen en cuenta la edad y el estado de salud, deja de asociarse con el riesgo (OR = 1,04; IC 95 %: 1,00 a 1,08). La diferencia que se observó en el análisis anterior (13,8 % frente a 7,1 %) se explicaba en buena parte por esas otras variables: las personas mayores y con peor salud hacen menos ejercicio. Esta es la diferencia entre una asociación simple y una asociación ajustada.

Diagnóstico preliminar de supuestos

En la regresión lineal se revisa que los residuos tengan varianza constante (homocedasticidad) y forma aproximadamente normal. Esos supuestos no aplican a la regresión logística, cuyo resultado es sí/no. En su lugar se revisan cuatro aspectos: (1) que las variables explicativas no estén demasiado correlacionadas entre sí (multicolinealidad), (2) los residuos extremos, (3) las observaciones con demasiado peso en el modelo (influyentes) y (4) que las probabilidades predichas coincidan con lo observado (calibración).

# Factor de inflación de la varianza (VIF): valores mayores de 5 indican
# multicolinealidad problemática. Para variables con varias categorías se lee
# la última columna, GVIF^(1/(2*Df)), comparable con la raíz de 5 (≈ 2,2).
vif_modelo <- car::vif(modelo_glm)
vif_modelo
##                      GVIF Df GVIF^(1/(2*Df))
## edad             1.099392  1        1.048519
## Sex              1.052128  1        1.025733
## Smoking          1.032113  1        1.015930
## Stroke           1.033226  1        1.016477
## Diabetic         1.139387  3        1.021987
## KidneyDisease    1.048568  1        1.023996
## DiffWalking      1.445711  1        1.202377
## PhysicalActivity 1.175277  1        1.084102
## GenHealth        1.895001  4        1.083181
## BMI              1.162888  1        1.078373
## PhysicalHealth   1.725014  1        1.313398
# augment() agrega a cada persona su valor ajustado, su residuo y su influencia
diagnostico <- broom::augment(modelo_glm)

# La actividad menciona geom_residuals(), que no existe en ggplot2:
# el gráfico de residuos se construye con geom_point()

c(pct_residuos_extremos = mean(abs(diagnostico$.std.resid) > 3) * 100,
  cook_maximo           = max(diagnostico$.cooksd))
## pct_residuos_extremos           cook_maximo 
##           0.108402892           0.000872242
# Se grafica una muestra de 3.000 personas: con 240.000 puntos el gráfico no se leería
set.seed(2026)
grafico_residuos <- diagnostico |>
  slice_sample(n = 3000) |>
  ggplot(aes(x = .fitted, y = .std.resid, color = HeartDisease)) +
  geom_point(alpha = 0.4) +
  geom_hline(yintercept = 0) +
  geom_hline(yintercept = c(-3, 3), linetype = "dashed") +
  scale_color_manual(values = c(No = "#3B528B", Yes = "#D95F02")) +
  labs(
    title = "Residuos estandarizados frente a valores ajustados (muestra de 3.000)",
    x = "Valor ajustado (escala logit)",
    y = "Residuo estandarizado de devianza",
    color = "Enfermedad cardíaca"
  ) +
  theme_minimal()

ggplotly(grafico_residuos)
# Calibración: se agrupan las personas de prueba en 10 grupos (deciles) según su
# probabilidad predicha y se compara con la proporción real de casos en cada grupo
prob_prueba <- predict(modelo_glm, newdata = prueba, type = "response")

calibracion <- tibble(
  observado = prueba$HeartDisease == "Yes",
  predicho  = prob_prueba
) |>
  mutate(decil = ntile(predicho, 10)) |>
  group_by(decil) |>
  summarise(prob_media = mean(predicho), prop_observada = mean(observado))

grafico_calibracion <- ggplot(calibracion, aes(x = prob_media, y = prop_observada)) +
  geom_abline(linetype = "dashed", color = "grey50") +   # calibración perfecta
  geom_line(color = "#3B528B") +
  geom_point(color = "#3B528B", size = 3) +
  labs(
    title = "Calibración en el conjunto de prueba (por deciles de riesgo)",
    x = "Probabilidad promedio predicha",
    y = "Proporción observada con enfermedad cardíaca"
  ) +
  theme_minimal()

ggplotly(grafico_calibracion)

Interpretación del diagnóstico

  • Multicolinealidad: no hay problemas. El mayor valor ajustado del VIF es 1,31, muy por debajo del límite 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 de 3 en valor absoluto. En el gráfico, esos residuos corresponden a personas con enfermedad cardíaca a las que el modelo les asignó una probabilidad muy baja: casos atípicos (por ejemplo, personas jóvenes y sin factores de riesgo) que un tamizaje basado en estas preguntas no detectaría.
  • Observaciones influyentes: la distancia de Cook máxima es 9e-04, muy inferior a 1. Ninguna persona cambia por sí sola los resultados del modelo.
  • Calibración: los puntos siguen de cerca la línea diagonal, es decir, las probabilidades predichas coinciden con las proporciones observadas. Por ejemplo, en el decil de mayor riesgo el modelo predice en promedio 36,9 % y se observa 36,4 %. Las probabilidades se pueden usar como estimaciones de riesgo, no solo para ordenar a las personas.

Evaluación del desempeño

# Umbral de clasificación: la proporción de casos en entrenamiento (≈ 8,6 %).
# Una persona es de "riesgo alto" si su probabilidad supera la frecuencia promedio.
# Con 0,5, el umbral habitual, el modelo casi nunca diría "Sí", porque la enfermedad es poco frecuente.
umbral <- mean(entrenamiento$HeartDisease == "Yes")

prob_entrenamiento <- predict(modelo_glm, type = "response")

# Función para calcular las mismas métricas en cualquier conjunto
evaluar <- function(observado, probabilidad, umbral) {
  clase <- factor(if_else(probabilidad >= umbral, "Yes", "No"), levels = c("No", "Yes"))
  tibble(
    AUC           = yardstick::roc_auc_vec(observado, probabilidad, event_level = "second"),
    Sensibilidad  = yardstick::sens_vec(observado, clase, event_level = "second"),
    Especificidad = yardstick::spec_vec(observado, clase, event_level = "second"),
    Exactitud     = yardstick::accuracy_vec(observado, clase),
    Pct_alto_riesgo = mean(clase == "Yes")
  )
}

metricas_entrenamiento <- evaluar(entrenamiento$HeartDisease, prob_entrenamiento, umbral)
metricas_prueba        <- evaluar(prueba$HeartDisease, prob_prueba, umbral)
# Modelo base de comparación: decir que nadie tiene la enfermedad (probabilidad 0 para todos)
metricas_base          <- evaluar(prueba$HeartDisease, rep(0, nrow(prueba)), 0.5)

tabla_metricas <- bind_rows(
  metricas_entrenamiento |> mutate(Conjunto = "Entrenamiento"),
  metricas_prueba        |> mutate(Conjunto = "Prueba"),
  metricas_base          |> mutate(Conjunto = "Modelo base (todos 'No'), prueba")
) |>
  relocate(Conjunto)

knitr::kable(tabla_metricas, digits = 3,
             caption = "Métricas de desempeño: entrenamiento frente a prueba")
Métricas de desempeño: entrenamiento frente a prueba
Conjunto AUC Sensibilidad Especificidad Exactitud Pct_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 prueba: aciertos y errores del modelo con el umbral elegido
clase_prueba <- factor(if_else(prob_prueba >= umbral, "Yes", "No"), levels = c("No", "Yes"))
matriz_prueba <- table(Predicho = clase_prueba, Observado = prueba$HeartDisease)
matriz_prueba
##         Observado
## Predicho    No   Yes
##      No  54099  1500
##      Yes 18850  5500

Visualización 3D del modelo

# Superficie de probabilidad según 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.
edades <- seq(20, 82, by = 2)
imcs   <- seq(16, 50, by = 1)

probabilidad_superficie <- function(fuma) {
  rejilla <- expand_grid(
    edad = edades, BMI = imcs,
    Sex = "Male", Smoking = fuma, Stroke = "No", Diabetic = "No",
    KidneyDisease = "No", DiffWalking = "No", PhysicalActivity = "Yes",
    GenHealth = "Good", PhysicalHealth = 0
  )
  prob <- predict(modelo_glm, newdata = rejilla, type = "response")
  # Filas = IMC y columnas = edad: el formato de matriz que plotly espera para una superficie
  matrix(prob, nrow = length(imcs), ncol = length(edades))
}

z_no_fuma <- probabilidad_superficie("No")
z_fuma    <- probabilidad_superficie("Yes")

plot_ly(x = edades, y = imcs) |>
  add_surface(z = z_no_fuma, name = "No fumador", colorscale = "Viridis",
              showscale = FALSE, opacity = 0.9) |>
  add_surface(z = z_fuma, name = "Fumador", colorscale = "Reds",
              showscale = FALSE, opacity = 0.7) |>
  layout(
    title = "Probabilidad predicha según 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 la enfermedad
set.seed(2026)
muestra_prueba <- prueba |>
  mutate(probabilidad = prob_prueba) |>
  slice_sample(n = 2000)

plot_ly(
  muestra_prueba,
  x = ~edad, y = ~BMI, z = ~probabilidad,
  color = ~HeartDisease, colors = c("#3B528B", "#D95F02"),
  type = "scatter3d", mode = "markers", marker = list(size = 3)
) |>
  layout(
    title = "Probabilidad predicha en 2.000 personas de prueba (naranja = con enfermedad cardíaca)",
    scene = list(
      xaxis = list(title = "Edad (años)"),
      yaxis = list(title = "IMC (kg/m²)"),
      zaxis = list(title = "Probabilidad predicha")
    )
  )

Interpretación de resultados

Análisis de las métricas de desempeño

  • Capacidad de discriminación: el AUC en el conjunto de prueba es 0,841, por encima de la meta de 0,80. En la validación cruzada fue de 0,839. Si se toma al azar una persona con enfermedad cardíaca y otra sin ella, el modelo le asigna más riesgo a la primera en cerca de 8 de cada 10 casos.
  • Sobreajuste: el AUC en entrenamiento (0,839) y en prueba (0,841) es prácticamente igual. El modelo no memorizó los datos y debería funcionar de forma similar con personas nuevas de una población parecida.
  • Sensibilidad: con el umbral de 8,5 %, el modelo detecta el 78,6 % de las personas con enfermedad cardíaca, por encima de la meta de 70 %. Para lograrlo marca como de riesgo alto al 30,5 % de la población.
  • Uso en un programa: si se invitara a tamizaje solo al grupo de riesgo alto, el programa encontraría cerca de 8 de cada 10 casos revisando a menos de un tercio de la población. En la matriz de confusión de prueba, el modelo detecta 5.500 casos y deja sin detectar 1.500.
  • Costo de ese resultado: la especificidad es 74,2 %, así que 18.850 personas sin la enfermedad serían citadas (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 %). Sin embargo, el modelo base no detecta a ningún paciente (sensibilidad 0). Por eso la exactitud no sirve como métrica cuando la enfermedad es poco frecuente.
  • Lectura de los gráficos 3D: la superficie muestra que la edad es la variable que más eleva la probabilidad. El IMC la aumenta poco (la superficie sube suavemente a lo largo de ese eje). La superficie del fumador está siempre por encima de la del no fumador, y la distancia entre ambas crece con la edad. En la nube de puntos, las personas con enfermedad (naranja) se concentran en las zonas de mayor probabilidad, aunque algunas aparecen abajo: son los casos que el modelo no detecta.

Métricas de éxito: se cumplen las tres metas definidas (AUC ≥ 0,80; sensibilidad ≥ 70 %; diferencia entre entrenamiento y prueba ≤ 0,02).

Acciones de mejora propuestas

  1. Ingeniería de variables (interacciones). Siguiendo la idea del ejemplo de regresión lineal múltiple revisado, donde el efecto del tabaquismo cambia según el IMC, se puede probar si el tabaquismo pesa más en personas con diabetes o si el efecto de la edad es distinto en hombres y mujeres. Basta con agregar términos como Smoking:Diabetic o edad:Sex a la fórmula y comparar el AUC.
  2. Recolección de datos adicionales. El modelo no incluye variables clínicas clave para el riesgo cardiovascular, como presión arterial, colesterol, antecedentes familiares o medicamentos. Para aplicarlo en Colombia habría que reentrenarlo con datos de la propia población (historias clínicas o registros de atención) y verificar que mantiene su desempeño.
  3. Selección de otro algoritmo. Comparar la regresión logística con un bosque aleatorio (caret::train(method = "rf")) en una muestra de los datos, para ver si captura relaciones más complejas y mejora el AUC, sin perder de vista que la regresión logística es más fácil de explicar.
  4. Ajuste del umbral según costos. El umbral de 8,6 % prioriza no dejar casos sin detectar. Si la capacidad de cardiología es limitada, se puede subir el umbral para citar a menos personas, aceptando una sensibilidad menor. La decisión debe tomarse con el costo de cada falso negativo y de cada falso positivo.

Limitaciones

Los datos provienen de una encuesta transversal y autorreportada, realizada en EE. UU. en 2020 y sin pesos de muestreo. El modelo identifica a personas que ya reportan enfermedad cardíaca, no predice quién la desarrollará en el futuro, y sus coeficientes muestran asociaciones, no causas. Antes de usarlo para asignar recursos debe validarse con datos de la población objetivo.

Referencias