Predicción de Desnutrición Neonatal en Bogotá: Implementación y Comparativa de Modelos de Aprendizaje Supervisado
library(kableExtra)
library(readr)
library(dplyr)
library(tidyverse)
library(kableExtra)
library(reactable)
library(plotly)
library(htmltools)
library(ggplot2)
library(class)theme_valery <- function() {
theme_minimal() +
theme(
text = element_text(family = "Source Serif Pro", size = 12, color = "#2C3E50"),
plot.title = element_text(
family = "Merriweather",
size = 18,
face = "bold",
hjust = 0.5,
color = "#2C5F7A",
margin = margin(b = 15)
),
plot.subtitle = element_text(
family = "Source Serif Pro",
size = 14,
hjust = 0.5,
color = "#4A6572",
margin = margin(b = 20)
),
plot.caption = element_text(
family = "Lato",
size = 10,
color = "#4A6572",
hjust = 1,
face = "italic"
),
# EJES
axis.title = element_text(
family = "Lato",
size = 12,
face = "bold",
color = "#3A8E96"
),
axis.text = element_text(
family = "Lato",
size = 11,
color = "#4A6572"
),
axis.line = element_line(color = "#4FB0A8", linewidth = 0.8),
axis.ticks = element_line(color = "#4FB0A8", linewidth = 0.5),
# LEYENDA
legend.title = element_text(
family = "Lato",
size = 12,
face = "bold",
color = "#2C5F7A"
),
legend.text = element_text(
family = "Lato",
size = 11,
color = "#4A6572"
),
legend.background = element_rect(fill = "#F8FCFB", color = "#E1F0ED"),
legend.key = element_rect(fill = "#F8FCFB", color = NA),
# GRID Y PANEL
panel.grid.major = element_line(
color = "#E1F0ED",
linewidth = 0.5,
linetype = "solid"
),
panel.grid.minor = element_line(
color = "#F8FCFB",
linewidth = 0.3,
linetype = "solid"
),
panel.background = element_rect(fill = "white", color = NA),
plot.background = element_rect(fill = "white", color = NA),
# MÁRGENES Y ESPACIADO
plot.margin = margin(20, 20, 20, 20),
panel.spacing = unit(1.5, "lines"),
# TÍTULOS DE FACETAS
strip.background = element_rect(
fill = "#2C5F7A",
color = "#2C5F7A",
linewidth = 1
),
strip.text = element_text(
family = "Lato",
color = "white",
face = "bold",
size = 11
)
)
}
# PALETA DE COLORES VALERYMARINE
valery_palette <- c(
"#2C5F7A", # deep-ocean
"#3A8E96", # ocean-teal
"#4FB0A8", # sea-glass
"#8FD4C1", # seafoam
"#D94E4E", # coral
"#C4A747", # accent-gold
"#2C3E50", # dark-ink
"#4A6572" # light-ink
)
# ESCALAS DE COLOR VALERYMARINE
scale_color_valery <- function(palette = valery_palette, ...) {
scale_color_manual(values = palette, ...)
}
scale_fill_valery <- function(palette = valery_palette, ...) {
scale_fill_manual(values = palette, ...)
}
# ESCALAS DE GRADIENTE VALERYMARINE
scale_fill_gradient_valery <- function(low = "#8FD4C1", high = "#2C5F7A", ...) {
scale_fill_gradient(low = low, high = high, ...)
}
scale_color_gradient_valery <- function(low = "#8FD4C1", high = "#2C5F7A", ...) {
scale_color_gradient(low = low, high = high, ...)
}
# FUNCIÓN PARA ENRIQUECER GRÁFICAS VALERYMARINE
enrich_valery_plot <- function(gg_plot, titulo = NULL, subtitulo = NULL, caption = NULL) {
p <- gg_plot +
labs(
title = titulo,
subtitle = subtitulo,
caption = caption
)
p <- p + theme(
plot.title.position = "plot",
plot.caption.position = "plot"
)
return(p)
}Resumen : Este estudio analiza los factores sociales, estructurales y clínicos que determinan la desnutrición neonatal en Bogotá durante el segundo semestre de 2024, mediante modelos de clasificación supervisada de Regresión Logística y K-Nearest Neighbors (KNN). Se emplearon datos de la Encuesta de Estadísticas Vitales (EEVV) 2024 del DANE, con una muestra final equilibrada de 11.872 nacimientos registrados en la capital.
El modelo considera como variables explicativas el tiempo de gestación, el tipo de parto, el número de controles prenatales, la edad materna y los embarazos previos. Estas variables fueron seleccionadas con base en literatura científica y evidencia estadística que vincula las condiciones socioeconómicas y de salud materna con el estado nutricional al nacer. Los modelos muestran un desempeño predictivo adecuado y una capacidad explicativa coherente con los datos reales, cumpliendo criterios de validación y balanceo entre las clases analizadas.
Introducción
El peso al nacer es uno de los determinantes más importantes del bienestar con el que un ser humano inicia su vida. Es un indicador de morbilidad y mortalidad pediátrica y neonatal, así como un antecedente clave en las diferencias del desarrollo cognitivo y de las enfermedades crónicas en etapas posteriores. Sin embargo, también representa una problemática multifactorial en la que intervienen diversas fallas sociales, como la desigualdad económica, el acceso a la salud, las condiciones de vida y la educación en salud materno-infantil. Todo esto genera brechas en las propiedades intelectuales y materiales durante una etapa tan vital y crítica como el desarrollo óptimo de los nacidos vivos del país, lo que produce impactos en los niveles de natalidad, el desarrollo de niños y adolescentes, y en las madres presentes y futuras.
Un recién nacido con bajo peso y/o desnutrición no solo refleja una falta de responsabilidad materna hacia su hijo, sino también las brechas que impiden que las madres accedan a un seguimiento adecuado y controlado de su embarazo. Esto les dificulta vivir este proceso de manera tranquila y exitosa, y hace que sus hijos no inicien sus primeros momentos de vida de forma satisfactoria.
Como se mencionó anteriormente, el desarrollo prenatal del bebé representa uno de los factores más influyentes desde el punto de vista social, ya que engloba y describe las condiciones del entorno en el que nace el individuo y en el que probablemente transitara las etapas futuras de su desarrollo. Lo anterior se resume en las particularidades del embarazo de las madres de los recién nacidos vivos. Estos aspectos se abordarán en el desarrollo de la presente investigación, puesto que desde el área de la ingeniería es posible realizar una prospectiva de la situación, facilitando la formulación de soluciones desde un enfoque social.
A pesar de que los antecedentes corresponden a una problemática nacional, Bogotá, a pesar de ser la capital del país y contar con un mejor desarrollo regional, no está exenta de ella. Según datos del DANE, el 17% de los casos de desnutrición neonatal del segundo semestre del año 2024 corresponden a esta ciudad.
El presente estudio emplea modelos de clasificación supervisada (regresión logística y KNN) utilizando los datos de nacimientos vivos en Bogotá, con el objetivo de analizar la relación entre la desnutrición neonatal y un conjunto de variables explicativas. Entre estas, se consideran el tiempo de gestación, el tipo de parto, el número de controles prenatales, la edad materna y el número de embarazos previos. La selección de estas variables se fundamenta tanto en la revisión de literatura científica relevante como en las características sociodemográficas y sanitarias propias del contexto bogotano, las cuales han sido identificadas en informes nacionales y estudios previos como factores determinantes en el estado nutricional al nacer.
Descripción de la fuente de datos
Base de datos: Encuesta de estadísticas vitales - EEVV - 2024
Unidad de análisis: Nacimiento
Período: (2024)
Acceso: https://microdatos.dane.gov.co/index.php/catalog/878
Los datos utilizados en esta investigación provienen de la Encuesta de Estadísticas Vitales (EEVV) 2024 del Departamento Administrativo Nacional de Estadística (DANE). Esta encuesta administra el registro administrativo de nacimientos en Colombia y recoge información detallada sobre características demográficas, sociales y clínicas relacionadas con el recién nacido y su madre.
Metodología
La metodología de esta investigación se basa en la aplicación de dos modelos de clasificación supervisada, K-Nearest Neighbors (KNN) y Regresión Logística, con el objetivo de identificar y analizar las fallas sociales y estructurales que inciden en la desnutrición neonatal en Bogotá durante el segundo semestre de 2024. Estos modelos permiten determinar la influencia de variables sociales, económicas y de salud en este problema de salud pública, tomando como indicador principal la desnutrición al nacer.
La selección de variables incluye aspectos educativos, económicos y estructurales que reflejan el control social desde la concepción hasta el nacimiento, así como parámetros clínicos relevantes. Esto garantiza un análisis integral de los determinantes del estado nutricional neonatal.
El estudio utiliza una base de datos representativa y actualizada proveniente de la Encuesta de Estadísticas Vitales (EEVV) 2024 del DANE, focalizando su análisis en la población nacida en Bogotá durante ese periodo.
Procesamiento de datos
Inicialmente, la base de datos contenía 34,424 registros de nacidos vivos. Como primer paso, se realizó una limpieza rigurosa:
Se eliminaron observaciones con valores faltantes o inconsistentes en todas las variables clave.
Se dividió la base en dos sub-bases: recién nacidos con desnutrición (“Sí”) y sin desnutrición (“No”), con base en la variable dependiente principal.
Para evitar sesgo por desbalance de clases, se aplicó un procedimiento de balanceo, lo que permitió construir una muestra final equilibrada de 11,872 observaciones.
Variables analizadas
El modelo incorpora variables seleccionadas por su relevancia empírica documentada en la literatura científica y en lineamientos oficiales:
Tiempo de gestación (en rangos de meses)
Tipo de parto (Cesaria, Espontaneo o instrumentado)
Número de controles prenatales recibidos durante el embarazo
Edad de la madre (en rangos categóricos)
Número de embarazos previos
variables_modelo <- data.frame(
Variable = c("Peso", "Tiempo gestación", "Tipo parto",
"Numero control prenatal", "Edad madre", "Numero embarazos"),
Descripción = c("Clasificación del peso al nacer (Normal/Delicado)",
"Semanas de gestación",
"Tipo de parto registrado",
"Número de controles prenatales realizados",
"Grupo etario de la madre",
"Número de embarazos previos"),
Tipo_Variable = c("Categórica (binaria)", "Categórica ordinal",
"Categórica nominal", "Cuantitativa discreta",
"Categórica ordinal", "Cuantitativa discreta"),
Notas = c("Variable dependiente - Peso normal: ≥2500g",
"Considerar <37 semanas como prematurez",
"Espontáneo/Cesárea/Instrumentado",
"Indicador de acceso a salud prenatal",
"Recodificado a 9 rangos etarios (Códigos 1 a 9)",
"Incluye embarazo actual")
)
kable(variables_modelo,
caption = "Tabla 1: Variables del Modelo",
align = c("l", "l", "l", "l"),
col.names = c("Variable", "Descripción", "Tipo de Variable", "Notas")) %>%
kable_styling(bootstrap_options = c("striped", "hover"),
full_width = FALSE,
font_size = 12) %>%
row_spec(0, background = "#2C3E50", color = "white", bold = TRUE) %>%
column_spec(1, bold = TRUE, width = "12em") %>%
footnote(general = "Fuente: Elaboración propia en base a la Base de Datos de Nacimientos - 2024",
number = c("Datos corresponden al segundo semestre del año 2024"))| Variable | Descripción | Tipo de Variable | Notas |
|---|---|---|---|
| Peso | Clasificación del peso al nacer (Normal/Delicado) | Categórica (binaria) | Variable dependiente - Peso normal: ≥2500g |
| Tiempo gestación | Semanas de gestación | Categórica ordinal | Considerar <37 semanas como prematurez |
| Tipo parto | Tipo de parto registrado | Categórica nominal | Espontáneo/Cesárea/Instrumentado |
| Numero control prenatal | Número de controles prenatales realizados | Cuantitativa discreta | Indicador de acceso a salud prenatal |
| Edad madre | Grupo etario de la madre | Categórica ordinal | Recodificado a 9 rangos etarios (Códigos 1 a 9) |
| Numero embarazos | Número de embarazos previos | Cuantitativa discreta | Incluye embarazo actual |
| Note: | |||
| Fuente: Elaboración propia en base a la Base de Datos de Nacimientos - 2024 | |||
| 1 Datos corresponden al segundo semestre del año 2024 |
Estas variables reflejan tanto el entorno social y estructural como el acceso a servicios de salud y el historial reproductivo, permitiendo un análisis integral de los riesgos de desnutrición neonatal.
Justificación de la selección de variables dependiente e independientes
La variable dependiente seleccionada es el estado nutricional del recién nacido al momento del nacimiento, el cual se clasifica en dos categorías: “Sí” (el bebé presenta desnutrición al nacer) y “No” (el bebé no presenta desnutrición al nacer). Esta variable permite identificar los factores asociados a la desnutrición neonatal, la cual está asociada a mayores riesgos de morbilidad y mortalidad infantil, y es reconocida como un indicador crítico por la Organización Mundial de la Salud (OMS, 2017; DANE, 2024). La desnutrición al nacer refleja desigualdades en acceso a servicios de salud prenatal, nutrición materna, condiciones sociales y características biológicas de la gestación, y es además un predictor del desarrollo físico y cognitivo del niño (OMS, 2017; DANE, 2024).
Entre las variables independientes, se escogieron aquellas que, según reportes oficiales y estudios previos, tienen una relación directa con el peso al nacer.
Tiempo de gestación (semanas) : Es fundamental ya que la prematurez está asociada con un peso menor al esperado. Nacimientos antes de las 37 semanas suelen presentar bajo peso debido a la inmadurez fetal (DANE, 2024). Estudios confirman que el tiempo de gestación es el principal determinante biológico del peso neonatal (Wu et al., 2022; Kramer, 1987).
El tipo de parto (espontáneo, cesárea o instrumentado) indica las características médicas de la gestación y el nacimiento. Partos por cesárea e instrumentados están frecuentemente relacionados con complicaciones que pueden influir en el peso del recién nacido (DANE, 2024).
La cantidad de consultas prenatales: constituye un indicador fundamental de acceso y calidad en la atención materna. Estudios del Instituto Nacional de Salud (2020) muestran mayor riesgo de bajo peso en madres con menos de cuatro controles, lo que evidencia la importancia del diagnóstico temprano de complicaciones, suplementación nutricional y seguimiento del desarrollo fetal.
- La edad de la madre (años): Se considera porque las madres adolescentes y las de mayor edad tienen tasas más elevadas de bajo peso al nacer, conforme a las estadísticas en Colombia (Instituto Nacional de Salud, 2020). Estas poblaciones pueden presentar mayores riesgos biológicos y sociales asociados.
- Número de embarazos previos: Influye en la capacidad reproductiva y salud materna. El historial de embarazos múltiples puede afectar la nutrición y el ambiente uterino, lo cual impacta el peso del recién nacido
Estas variables fueron elegidas considerando evidencia empírica documentada, garantizando una base sólida para un modelo predictivo que permita comprender y analizar factores asociados al peso al nacer en Bogotá, con miras a fortalecer políticas públicas de salud materno-infantil y mejorar indicadores en Colombia.
Descripción del modelo de regresión lineal múltiple
Los datos empleados se obtuvieron de la página de microdatos y metadatos del DANE, utilizando la Encuesta Vital correspondiente al año 2024 de la sección de nacimientos. Se realizó una serie de modificaciones para lograr una mejor proporción y comprensión de los datos: la base fue filtrada no solo por la selección de variables, sino también por la distribución de frecuencias del umbral empleado (bajo peso al nacer), focalizando así la información correspondiente a los nacimientos en la ciudad de Bogotá durante el segundo semestre del año en que se realizó la encuesta.
El motivo de la filtración exhaustiva fue lograr una mayor homogeneidad en los datos, fundamental para sustentar la hipótesis principal: respaldar, a través de la evidencia, los determinantes sociales que inciden en los índices de desnutrición en el territorio. Dada la magnitud y extensión de la base de datos original, se tomó la decisión de acotarla para obtener resultados esperados aplicando dos tipos de modelos de aprendizaje supervisados, cuyo objetivo es clasificar de manera binaria una serie de características de la población.
Los modelos corresponden a:
- K- nearest neighbors.
Este modelo busca clasificar en dos sentencias una serie de predicciones basadas en características que tienen las dos sentencias, es decir, clasificar mediante predicciones de las características en las sentencias que tienen caracteristicas cercanas, de ahí su nombre. “k” representa la cantidad de vecinos más cercanos considerados en el problema de clasificación o regresión, y “NN” se refiere a los vecinos más cercanos a la cantidad elegida para k.
En el problema con el que se está trabajando las caracteristicas que se tienen son las variables independientes y las sentencias son la variable dependiente que solo puede clasificar en dos opciones debido a la dicotomía de la variable. El umbral empleado tiene como palabras de clasificación si o no (si tiene bajo peso, no tiene bajo peso (peso moderado)).
Con este modelo se busca indagar, la veracidad de las variables independientes como sintomas en una sentencia, es decir, si las variables seleccionadas abarcan las caracteristicas suficientes para dictaminar una sentencia congruente.
- Regresión logistica.
La regresion logistica es un modelo de predicción que a diferencia de un modelo de regresión lineal, que busca predecir la influencia de multiples variables independientes sobre una variable dependiente numerica, este por el contrario busca predecir la probabilidad de clasificar una serie de variables independientes sobre una variable dependiente binaria que encasilla 2 sentencias, basadas en el aprendizaje de un modelo en el cual se tiene conocimiento de los resultados.
Teniendo en consideración, la problematica que se está modelando, los objetivos que se estiman es tener una probabilidad de clasificación que sea consecuente con el modelo anterior, con el fin de formular conclusiones veridicas y posteriormente soluciones a la problemática.
Base de datos del estudio
Para este trabajo se emplea la base de datos de la Encuesta de Estadísticas Vitales (EEVV) 2024 del DANE, filtrada específicamente para el periodo del segundo semestre en la ciudad de Bogotá. El conjunto de datos fue depurado rigurosamente para incluir únicamente las observaciones completas y las variables relevantes para los modelos de clasificación KNN y Regresión Logística, asegurando así la calidad y pertinencia de la muestra seleccionada para el análisis.
library(htmltools)
reactable(
Base_datos,
defaultPageSize = 15,
showPageSizeOptions = TRUE,
pageSizeOptions = c(10, 15, 25, 50, 100),
filterable = TRUE,
searchable = TRUE,
sortable = TRUE,
resizable = TRUE,
striped = TRUE,
highlight = TRUE,
bordered = FALSE,
wrap = FALSE,
showSortable = TRUE,
defaultColDef = colDef(
header = function(value) {
name <- gsub("_", " ", value)
name <- gsub("([a-z])([A-Z])", "\\1 \\2", name)
tools::toTitleCase(tolower(name))
},
cell = function(value) {
if (is.numeric(value)) {
if (value == round(value)) {
format(value, big.mark = ",", scientific = FALSE)
} else {
format(round(value, 2), nsmall = 2, big.mark = ",", scientific = FALSE)
}
} else {
as.character(value)
}
},
align = "center",
minWidth = 100,
headerStyle = list(
background = "#2C3E50",
color = "white",
fontWeight = "600",
borderBottom = "2px solid #dee2e6",
fontSize = "13px"
),
style = list(
fontSize = "12px",
fontFamily = "Arial, sans-serif"
)
),
style = list(
fontFamily = "Arial, sans-serif",
fontSize = "13px"
),
theme = reactableTheme(
stripedColor = "#f8f9fa",
highlightColor = "#e9ecef",
cellPadding = "8px 12px",
backgroundColor = "#ffffff",
borderColor = "#dee2e6",
style = list(
fontFamily = "Arial, -apple-system, BlinkMacSystemFont, sans-serif"
),
searchInputStyle = list(
width = "100%",
padding = "8px 12px",
border = "1px solid #ced4da",
borderRadius = "4px",
fontSize = "14px",
marginBottom = "10px"
),
headerStyle = list(
borderBottom = "2px solid #495057",
fontSize = "14px",
backgroundColor = "#2C3E50",
color = "white"
)
),
columns = list(
Tiempo_gestación = colDef(
name = "Tiempo Gestación",
minWidth = 180,
filterable = TRUE,
align = "left"
),
Edad_madre = colDef(
name = "Edad Madre",
minWidth = 120,
filterable = TRUE
),
Peso_delicado = colDef(
name = "Peso Delicado",
style = function(value) {
color <- ifelse(value == "Si", "#E74C3C", "#27AE60")
list(fontWeight = "bold", color = color)
}
)
)
)Resultados Descriptivos
A continuación se presentan las estadísticas descriptivas, que resumen las características principales de la muestra estudiada. Este análisis preliminar permite conocer la distribución, tendencia central y dispersión de las variables clave, facilitando la comprensión del contexto y estableciendo la base para análisis posteriores.
Las estadísticas descriptivas son fundamentales para identificar patrones y diferencias entre grupos, que apoyan la validación de los modelos predictivos empleados en el estudio.
Estadísticas descriptivas de las variables seleccionadas
Analisis de la Variable Dependiente: Desnutrición Neonatal
Los resultados obtenidos a partir del análisis descriptivo del peso de los nacimientos en Bogotá durante el segundo semestre de 2024 se resumen en la Tabla 2. Estos resultados permiten identificar diferencias clave entre los grupos de recién nacidos con peso delicado “Si” y “No”. Ambas categorías están equilibradas, lo que permite un análisis comparativo robusto.
tabla_1_1 <- Base_datos %>%
group_by(Peso_delicado) %>%
summarise(
n = n(),
Porcentaje = round(100 * n() / nrow(Base_datos), 1)
)
kable(tabla_1_1,
align = c("l", "r", "r"),
format.args = list(big.mark = ",", decimal.mark = "."),
col.names = c("Peso Delicado", "N", "%"),
caption = "TABLA 2. TAMAÑO MUESTRAL POR GRUPO DE PESO AL NACER") %>%
kable_styling(
bootstrap_options = c("striped", "hover"),
full_width = FALSE,
font_size = 12,
position = "center"
) %>%
add_header_above(c(" " = 1, "Tamaño Muestral" = 2),
background = "#2C3E50", color = "white") %>%
row_spec(0, background = "#34495E", color = "white", bold = TRUE) %>%
column_spec(1, bold = TRUE, width = "12em") %>%
column_spec(2:3, background = "#F4F6F6") %>%
footnote(
general = "Fuente: Elaboración propia con base en la Encuesta de Nacimientos – DANE 2024.",
number = c("Datos corresponden a nacimientos en Bogotá (julio-diciembre 2024)")
)| Peso Delicado | N | % |
|---|---|---|
| Si | 5,872 | 49.5 |
| No | 6,000 | 50.5 |
| Note: | ||
| Fuente: Elaboración propia con base en la Encuesta de Nacimientos – DANE 2024. | ||
| 1 Datos corresponden a nacimientos en Bogotá (julio-diciembre 2024) |
La tabla muestra que el grupo de recién nacidos con desnutrición neonatal (“Sí”) representa el 49.5% de la muestra, mientras que el grupo “No” alcanza el 50.5%. Esto indica una distribución muy equilibrada entre ambos grupos lo que permite llevar a cabo análisis comparativos robustos y sin sesgos por desproporción entre categorías.
Además, se realizó un análisis descriptivo de la variable dependiente en relación con las dos variables independientes cuantitativas del estudio, para identificar diferencias y tendencias principales entre los grupos.
Analisis del grupo de peso en relacion con los controles prenatales
tabla_1_2 <- Base_datos %>%
group_by(Peso_delicado) %>%
summarise(
Media = round(mean(Numero_control_prenatal, na.rm = TRUE), 1),
DE = round(sd(Numero_control_prenatal, na.rm = TRUE), 1),
Min = min(Numero_control_prenatal, na.rm = TRUE),
Max = max(Numero_control_prenatal, na.rm = TRUE)
)
kable(tabla_1_2,
align = c("l", "r", "r", "r", "r"),
format.args = list(big.mark = ",", decimal.mark = "."),
col.names = c("Peso Delicado", "Media", "DE", "Mín", "Máx"),
caption = "TABLA 3. CONTROLES PRENATALES POR GRUPO DE PESO AL NACER") %>%
kable_styling(
bootstrap_options = c("striped", "hover"),
full_width = FALSE,
font_size = 12,
position = "center"
) %>%
add_header_above(c(" " = 1, "Controles Prenatales" = 4),
background = "#2C3E50", color = "white") %>%
row_spec(0, background = "#34495E", color = "white", bold = TRUE) %>%
column_spec(1, bold = TRUE, width = "12em") %>%
column_spec(2:5, background = "#E8F8F5") %>%
footnote(
general = "Fuente: Elaboración propia con base en la Encuesta de Nacimientos – DANE 2024.",
number = c("Datos corresponden a nacimientos en Bogotá (julio-diciembre 2024)")
)| Peso Delicado | Media | DE | Mín | Máx |
|---|---|---|---|---|
| Si | 6.6 | 2.9 | 0 | 25 |
| No | 7.2 | 2.7 | 0 | 20 |
| Note: | ||||
| Fuente: Elaboración propia con base en la Encuesta de Nacimientos – DANE 2024. | ||||
| 1 Datos corresponden a nacimientos en Bogotá (julio-diciembre 2024) |
El grupo de nacidos desnutridos registra un promedio de 6.6 controles, por debajo de los 7.2 en el grupo de los que no. Esto respalda estudios que señalan menor acceso a controles prenatales como factor de riesgo de bajo peso al nacer
Analisis del grupo de peso en relacion con el numero de embarazos
tabla_1_3 <- Base_datos %>%
group_by(Peso_delicado) %>%
summarise(
Media = round(mean(Numero_embarazos, na.rm = TRUE), 1),
DE = round(sd(Numero_embarazos, na.rm = TRUE), 1),
Min = min(Numero_embarazos, na.rm = TRUE),
Max = max(Numero_embarazos, na.rm = TRUE)
)
kable(tabla_1_3,
align = c("l", "r", "r", "r", "r"),
format.args = list(big.mark = ",", decimal.mark = "."),
col.names = c("Peso Delicado", "Media", "DE", "Mín", "Máx"),
caption = "TABLA 4. NÚMERO DE EMBARAZOS POR GRUPO DE PESO AL NACER") %>%
kable_styling(
bootstrap_options = c("striped", "hover"),
full_width = FALSE,
font_size = 12,
position = "center"
) %>%
add_header_above(c(" " = 1, "Número de Embarazos" = 4),
background = "#2C3E50", color = "white") %>%
row_spec(0, background = "#34495E", color = "white", bold = TRUE) %>%
column_spec(1, bold = TRUE, width = "12em") %>%
column_spec(2:5, background = "#FEF5E7") %>%
footnote(
general = "Fuente: Elaboración propia con base en la Encuesta de Nacimientos – DANE 2024.",
number = c("Datos corresponden a nacimientos en Bogotá (julio-diciembre 2024)")
)| Peso Delicado | Media | DE | Mín | Máx |
|---|---|---|---|---|
| Si | 1.9 | 1.1 | 1 | 11 |
| No | 1.9 | 1.0 | 1 | 14 |
| Note: | ||||
| Fuente: Elaboración propia con base en la Encuesta de Nacimientos – DANE 2024. | ||||
| 1 Datos corresponden a nacimientos en Bogotá (julio-diciembre 2024) |
Ambos grupos presentan el mismo promedio de 1.9 embarazos previos, sugiriendo que en esta muestra particular este factor no distingue entre los dos grupos.
Analisis de la Variable Independiente: Tiempo De Gestación
La distribución del tiempo de gestacion en la muestra se presenta en la Tabla 5.
tabla_tiempo_gestacion <- Base_datos %>%
count(Tiempo_gestación) %>%
mutate(
Porcentaje = round(100 * n / sum(n), 1),
Porcentaje_Acumulado = cumsum(Porcentaje)
)
kable(tabla_tiempo_gestacion,
align = c("l", "c", "r", "r"),
col.names = c("Tiempo de Gestación", "Frecuencia", "Porcentaje (%)", "Porcentaje Acumulado (%)"),
caption = "TABLA 5. DISTRIBUCIÓN DEL TIEMPO DE GESTACIÓN") %>%
kable_styling(
bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE,
font_size = 12
) %>%
add_header_above(c(" " = 1, "Distribución de Frecuencias" = 3),
background = "#2C3E50", color = "white") %>%
row_spec(0, background = "#34495E", color = "white", bold = TRUE) %>%
column_spec(1, bold = TRUE, width = "20em") %>%
column_spec(2:4, background = "#F4F6F6") %>%
footnote(
general = "Fuente: Elaboración propia con base en la Encuesta de Nacimientos – DANE 2024."
)| Tiempo de Gestación | Frecuencia | Porcentaje (%) | Porcentaje Acumulado (%) |
|---|---|---|---|
| 22-27 semanas | 156 | 1.3 | 1.3 |
| 28-37 semanas | 6316 | 53.2 | 54.5 |
| 38-41 semanas | 5399 | 45.5 | 100.0 |
| 42 o más semanas | 1 | 0.0 | 100.0 |
| Note: | |||
| Fuente: Elaboración propia con base en la Encuesta de Nacimientos – DANE 2024. |
La tabla muestra la distribución del tiempo de gestación en la muestra analizada. La mayoría de los nacimientos se concentra entre 28 y 37 semanas (53.2%), seguidos de los partos entre 38 y 41 semanas (45.5%). Los nacimientos antes de las 28 semanas representan solo el 1.3%, mientras que los partos de 42 o más semanas son extremadamente infrecuentes (1 caso). Esto indica que la mayor parte de los nacimientos ocurre dentro de rangos aceptados como “a término” o moderadamente prematuros, con muy pocos casos en los extremos.
Para analizar cómo el tiempo de gestación se relaciona con la variable dependiente de desnutrición neonatal, se utiliza un gráfico de barras apiladas. Este tipo de visualización permite observar de forma clara la distribución y el comportamiento de ambos grupos, facilitando la identificación de patrones y posibles asociaciones relevantes para el estudio.
tabla_tiempo_peso <- Base_datos %>%
count(Tiempo_gestación, Peso_delicado)
plot_ly(
tabla_tiempo_peso,
x = ~Tiempo_gestación,
y = ~n,
color = ~Peso_delicado,
colors = valery_palette[c(3, 5)],
type = 'bar',
text = ~n,
textposition = 'inside',
hovertemplate = paste(
'<b>%{x}</b><br>',
'Peso Delicado: %{fullData.name}<br>',
'Frecuencia: %{y}<br>',
'<extra></extra>'
)
) %>%
plotly::layout(
barmode = 'stack',
title = list(
text = "<b>Figura 1. Tiempo de Gestación según Peso Delicado</b><br><sub>Bogotá - Segundo Semestre 2024</sub>",
x = 0.5,
font = list(family = "Merriweather", size = 16, color = "#2C5F7A")
),
xaxis = list(
title = list(text = "<b>Tiempo de Gestación</b>", font = list(family = "Lato", size = 12)),
tickfont = list(family = "Lato", size = 10, color = "#4A6572")
),
yaxis = list(
title = list(text = "<b>Frecuencia</b>", font = list(family = "Lato", size = 12)),
tickfont = list(family = "Lato", size = 10, color = "#4A6572")
),
legend = list(
title = list(text = "<b>Peso Delicado</b>", font = list(family = "Lato")),
font = list(family = "Lato"),
orientation = "v",
x = 1.02,
y = 1
),
font = list(family = "Source Serif Pro"),
plot_bgcolor = "#F8FCFB",
paper_bgcolor = "#F8FCFB",
annotations = list(
list(
text = "Fuente: Elaboración propia con base en la Encuesta de Nacimientos – DANE 2024",
xref = "paper",
yref = "paper",
x = 0.5,
y = -0.25,
showarrow = FALSE,
font = list(family = "Lato", size = 10, color = "#4A6572"),
xanchor = "center"
)
),
margin = list(b = 100, t = 100)
)El gráfico muestra la relación entre el tiempo de gestación y la presencia de desnutrición neonatal (“Peso Delicado”) en Bogotá durante el segundo semestre de 2024. Se observa que en el grupo de 28-37 semanas, la mayoría de los recién nacidos no presenta desnutrición, mientras que en el grupo de 38-41 semanas predomina la desnutrición neonatal (“Sí”). Los nacimientos en los extremos (22-27 semanas y 42 o más semanas) son muy poco frecuentes y aportan poco al total.
Análisis de la Variable Independiente: Tipo De Parto
Los resultados del análisis descriptivo del tipo de parto, que incluye las categorías cesárea, espontáneo e instrumentado, se resumen en la Tabla 6.
tabla_tipo_parto <- Base_datos %>%
count(Tipo_parto) %>%
mutate(
Porcentaje = round(100 * n / sum(n), 1),
Porcentaje_Acumulado = cumsum(Porcentaje)
)
kable(tabla_tipo_parto,
align = c("l", "c", "r", "r"),
col.names = c("Tipo de Parto", "Frecuencia", "Porcentaje (%)", "Porcentaje Acumulado (%)"),
caption = "TABLA 6. DISTRIBUCIÓN DEL TIPO DE PARTO") %>%
kable_styling(
bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE,
font_size = 12
) %>%
add_header_above(c(" " = 1, "Distribución de Frecuencias" = 3),
background = "#2C3E50", color = "white") %>%
row_spec(0, background = "#34495E", color = "white", bold = TRUE) %>%
column_spec(1, bold = TRUE, width = "15em") %>%
column_spec(2:4, background = "#F4F6F6") %>%
row_spec(1:nrow(tabla_tipo_parto), background = c("#FBFCFC", "#F4F6F6")) %>%
footnote(
general = "Fuente: Elaboración propia con base en la Encuesta de Nacimientos – DANE 2024."
)| Tipo de Parto | Frecuencia | Porcentaje (%) | Porcentaje Acumulado (%) |
|---|---|---|---|
| Cesarea | 7039 | 59.3 | 59.3 |
| Espontaneo | 4612 | 38.8 | 98.1 |
| Instrumentado | 221 | 1.9 | 100.0 |
| Note: | |||
| Fuente: Elaboración propia con base en la Encuesta de Nacimientos – DANE 2024. |
La variable “tipo de parto” muestra una distribución claramente dominada por las cesáreas, que representan el 59.3% de los nacimientos en la muestra analizada. Este resultado refleja una tendencia creciente hacia la utilización de este procedimiento en Bogotá, en línea con los reportes recientes de la Secretaría Distrital de Salud, donde también se observa un aumento sostenido en la proporción de partos por cesárea en los últimos años.
En segundo lugar, el parto espontáneo o vaginal sin intervención constituye el 38.8% de los nacimientos, mientras que el parto instrumentado (con el uso de herramientas como fórceps o ventosas) representa solo el 1.9% del total. Este último dato evidencia que la aplicación de métodos instrumentados es poco frecuente en la cohorte estudiada.
ahora, para ver la relacion de esta variable con la variable dependiente estudiada se realiza un gráfico de anillos el cual permite visualizar de manera clara cómo se distribuyen los tipos de parto (cesárea y espontáneo) y su relación con el estado nutricional neonatal (“Sí” o “No”). Esto ayuda a identificar si existe una diferencia relevante en la prevalencia de desnutrición neonatal según el tipo de parto, facilitando la interpretación y el análisis de posibles asociaciones entre esas variables.
tabla_parto_sunburst <- Base_datos %>%
count(Tipo_parto, Peso_delicado) %>%
mutate(
labels = case_when(
!is.na(Peso_delicado) ~ paste(Tipo_parto, "-", Peso_delicado),
TRUE ~ Tipo_parto
),
parents = case_when(
!is.na(Peso_delicado) ~ Tipo_parto,
TRUE ~ "Total"
)
)
nodo_total <- tibble(
labels = "Total",
parents = "",
n = sum(tabla_parto_sunburst$n)
)
nodos_tipo_parto <- Base_datos %>%
count(Tipo_parto) %>%
mutate(
labels = Tipo_parto,
parents = "Total"
) %>%
select(labels, parents, n)
datos_sunburst <- bind_rows(
nodo_total,
nodos_tipo_parto,
tabla_parto_sunburst %>% select(labels, parents, n)
)
colores_sunburst_extendido <- c(
"#2C5F7A",
"#3A8E96",
"#4FB0A8",
"#8FD4C1",
"#D94E4E",
"#C4A747",
"#1A6B7A",
"#5DA399",
"#A7D9C9"
)
num_segmentos <- nrow(datos_sunburst)
print(paste("Número de segmentos en el sunburst:", num_segmentos))## [1] "Número de segmentos en el sunburst: 10"if (num_segmentos > 9) {
generar_colores_extra <- colorRampPalette(c("#2C5F7A", "#8FD4C1", "#C4A747"))
colores_extra <- generar_colores_extra(num_segmentos - 9)
colores_sunburst <- c(colores_sunburst_extendido, colores_extra)
} else {
colores_sunburst <- colores_sunburst_extendido[1:num_segmentos]
}
plot_ly(
datos_sunburst,
labels = ~labels,
parents = ~parents,
values = ~n,
type = 'sunburst',
branchvalues = 'total',
marker = list(
colors = colores_sunburst,
line = list(color = '#FFFFFF', width = 2)
),
hovertemplate = paste(
'<b>%{label}</b><br>',
'Frecuencia: %{value}<br>',
'Porcentaje: %{percentParent:.1%}<br>',
'<extra></extra>'
),
textinfo = 'label+percent parent'
) %>%
layout(
title = list(
text = "<b>Figura 2. Distribución del Tipo de Parto según Peso Delicado</b><br><sub>Bogotá - Segundo Semestre 2024</sub>",
x = 0.5,
font = list(
family = "Merriweather",
size = 18,
color = "#2C5F7A"
)
),
font = list(family = "Source Serif Pro"),
paper_bgcolor = "#F8FCFB",
plot_bgcolor = "#F8FCFB",
annotations = list(
list(
text = "Fuente: Elaboración propia con base en la Encuesta de Nacimientos – DANE 2024",
xref = "paper",
yref = "paper",
x = 0.5,
y = -0.1,
showarrow = FALSE,
font = list(
family = "Lato",
size = 10,
color = "#4A6572"
),
xanchor = "center"
)
),
margin = list(b = 100, t = 100, l = 50, r = 50)
)La grafica evidencia diferencias importantes en la distribución del bajo peso según el tipo de parto. En el grupo de partos por cesárea, el 57.3% correspondió a recién nacidos con desnutrición, mientras que el 42.3% fue un peso moderado. Esto indica que, dentro de quienes nacen por cesárea, existe una mayor proporción de bajo peso, lo que puede vincularse tanto a indicaciones clínicas asociadas a embarazos de mayor complejidad como a prácticas hospitalarias reportadas para la ciudad.
Al analizar el parto espontáneo, la tendencia se invierte: el 61.5% de los nacidos por este medio fueron clasificados como recién nacidos sin desnutrición y el 38.5% como recién nacidos con desnutrición. Esto sugiere que el parto espontáneo suele asociarse a mejores condiciones neonatales y puede reflejar embarazos de curso más favorable.
Análisis de la Variable Independiente: Edad De La madre
La distribución de la edad materna en la muestra se presenta en la Tabla 7. Esta tabla resume la frecuencia y el porcentaje de nacimientos según los distintos grupos de edad de la madre, permitiendo identificar los rangos predominantes en la población de estudio.
tabla_edad_madre <- Base_datos %>%
count(Edad_madre) %>%
mutate(
Porcentaje = round(100 * n / sum(n), 1)
) %>%
mutate(
Edad_inicial = as.numeric(gsub("(\\d+)-.*", "\\1", Edad_madre))
) %>%
arrange(Edad_inicial) %>%
mutate(
Porcentaje_Acumulado = cumsum(Porcentaje)
) %>%
select(-Edad_inicial)
kable(tabla_edad_madre,
align = c("l", "c", "r", "r"),
col.names = c("Grupo de Edad", "Frecuencia", "Porcentaje (%)", "Porcentaje Acumulado (%)"),
caption = "TABLA 7. DISTRIBUCIÓN POR GRUPOS DE EDAD DE LA MADRE") %>%
kable_styling(
bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE,
font_size = 12
) %>%
add_header_above(c(" " = 1, "Distribución de Frecuencias" = 3),
background = "#2C3E50", color = "white") %>%
row_spec(0, background = "#34495E", color = "white", bold = TRUE) %>%
column_spec(1, bold = TRUE, width = "12em") %>%
column_spec(2:4, background = "#F4F6F6") %>%
row_spec(1:nrow(tabla_edad_madre),
background = rep(c("#FBFCFC", "#F4F6F6"), length.out = nrow(tabla_edad_madre))) %>%
footnote(
general = "Fuente: Elaboración propia con base en la Encuesta de Nacimientos – DANE 2024."
)| Grupo de Edad | Frecuencia | Porcentaje (%) | Porcentaje Acumulado (%) |
|---|---|---|---|
| 10-14 años | 31 | 0.3 | 0.3 |
| 15-19 años | 953 | 8.0 | 8.3 |
| 20-24 años | 2630 | 22.2 | 30.5 |
| 25-29 años | 3364 | 28.3 | 58.8 |
| 30-34 años | 2840 | 23.9 | 82.7 |
| 35-39 años | 1600 | 13.5 | 96.2 |
| 40-44 años | 415 | 3.5 | 99.7 |
| 45-49 años | 37 | 0.3 | 100.0 |
| 50-54 años | 2 | 0.0 | 100.0 |
| Note: | |||
| Fuente: Elaboración propia con base en la Encuesta de Nacimientos – DANE 2024. |
La mayor proporción de nacimientos se concentra en los grupos de madres de 20 a 24 años (22.2%), 25 a 29 años (28.3%) y 30 a 34 años (23.9%), acumulando entre estos tres grupos el 74.4% del total. Esto indica que la mayoría de los nacimientos en Bogotá durante el periodo analizado corresponden a mujeres en edades reproductivas consideradas óptimas según literatura biomédica y cifras nacionales (DANE, 2024).
Los extremos presentan frecuencias mucho menores: sólo el 0.3% de los partos ocurrió en madres adolescentes entre 10 y 14 años lo cual aunque sea poco es una cifra muy deprimente dado el contexto, y el porcentaje tan bajo con solo 2 casos en el grupo de 50 a 54 años, lo que sugiere que la maternidad extremadamente temprana y avanzada son eventos muy poco comunes en la muestra. El grupo de 15 a 19 años, aunque representa minoría, suma el 8%, indicando la presencia significativa de embarazos adolescentes, un tema relevante para políticas de salud pública.
Las madres de 35 a 39 años representan un 13.5% y de 40 a 44 años un 3.5%, reflejando una transición reproductiva progresiva hacia edades mayores, pero sin constituir un grupo dominante. Los grupos de 45 a 49 y de 50 a 54 años son prácticamente residuales en la distribución observada.
También se llevó a cabo un gráfico de barras agrupadas lo cual permite comparar la frecuencia de recién nacidos con y sin peso delicado en cada grupo de edad materna facilitando la identificación de grupos de edad donde la prevalencia es mayor o donde la distribución es equilibrada.
tabla_edad_peso <- Base_datos %>%
count(Edad_madre, Peso_delicado) %>%
group_by(Edad_madre) %>%
mutate(
Total = sum(n),
Porcentaje = round(100 * n / Total, 1)
) %>%
ungroup()
plot_ly(
tabla_edad_peso,
x = ~Edad_madre,
y = ~n,
color = ~Peso_delicado,
colors = valery_palette[c(3, 5)],
type = 'bar',
text = ~paste0(n, " (", Porcentaje, "%)"),
textposition = 'outside',
textfont = list(family = "Lato", size = 10, color = "#4A6572"),
hovertemplate = paste(
'<b>Edad: %{x}</b><br>',
'Peso Delicado: %{fullData.name}<br>',
'Frecuencia: %{y}<br>',
'Porcentaje: %{text}<br>',
'<extra></extra>'
)
) %>%
plotly::layout(
barmode = 'group',
title = list(
text = "<b>Figura 3. Distribución de Peso Delicado según Edad Materna</b><br><sub>Bogotá - Segundo Semestre 2024</sub>",
x = 0.5,
font = list(family = "Merriweather", size = 18, color = "#2C5F7A")
),
xaxis = list(
title = list(text = "<b>Edad de la Madre</b>", font = list(family = "Lato", size = 12, color = "#3A8E96")),
tickfont = list(family = "Lato", size = 10, color = "#4A6572"),
tickangle = -45,
gridcolor = "#E1F0ED"
),
yaxis = list(
title = list(text = "<b>Frecuencia</b>", font = list(family = "Lato", size = 12, color = "#3A8E96")),
tickfont = list(family = "Lato", size = 10, color = "#4A6572"),
gridcolor = "#E1F0ED"
),
legend = list(
title = list(text = "<b>Peso Delicado</b>", font = list(family = "Lato", size = 12)),
font = list(family = "Lato", size = 11),
orientation = "h",
x = 0.5,
xanchor = "center",
y = -0.3,
bgcolor = "rgba(248,252,251,0.8)"
),
font = list(family = "Source Serif Pro"),
plot_bgcolor = "#F8FCFB",
paper_bgcolor = "#FFFFFF",
annotations = list(
list(
text = "Fuente: ",
xref = "paper",
yref = "paper",
x = 0.5,
y = -0.4,
showarrow = FALSE,
font = list(family = "Lato", size = 10, color = "#4A6572"),
xanchor = "center"
)
),
margin = list(b = 150, l = 80, r = 50, t = 100)
)Se observa que el mayor volumen de casos se concentra en los grupos de edad de 20 a 34 años, lo que corresponde a los rangos reproductivos más frecuentes en la población.
Tanto la presencia como la ausencia de peso delicado mantienen proporciones similares en cada grupo de edad, aunque algunos grupos presentan pequeñas diferencias. Por ejemplo, en madres de 25-29 años y 30-34 años, los porcentajes de peso delicado “Sí” y “No” son casi equivalentes, mientras que en los extremos de edad la cantidad de casos es mucho menor y las proporciones varían más con un porcentaje de 59.5 de niños con desnutrición en madres mayores de 45 . Destaca que el grupo de 25-29 años posee el mayor número absoluto de recién nacidos tanto con como sin peso delicado, y las diferencias porcentuales entre estados nutricionales en la mayoría de los grupos no son dramáticas.
Analisis de la Variable Independiente: Controles Prenatales
La distribución de los controles prenatales en la muestra se presenta en la Tabla 8.
# TABLA 5: ESTADÍSTICAS DE CONTROLES PRENATALES
tabla_controles <- Base_datos %>%
summarise(
Variable = "Controles Prenatales",
Media = round(mean(Numero_control_prenatal, na.rm = TRUE), 1),
DE = round(sd(Numero_control_prenatal, na.rm = TRUE), 1),
Mínimo = min(Numero_control_prenatal, na.rm = TRUE),
Máximo = max(Numero_control_prenatal, na.rm = TRUE),
Q1 = quantile(Numero_control_prenatal, 0.25, na.rm = TRUE),
Mediana = median(Numero_control_prenatal, na.rm = TRUE),
Q3 = quantile(Numero_control_prenatal, 0.75, na.rm = TRUE)
)
kable(tabla_controles,
caption = "TABLA 8. ESTADÍSTICAS DESCRIPTIVAS - CONTROLES PRENATALES",
align = c("l", "r", "r", "r", "r", "r", "r", "r")) %>%
kable_styling(bootstrap_options = c("striped", "hover"),
full_width = FALSE,
font_size = 12) %>%
add_header_above(c(" " = 1, "Medidas de Tendencia Central" = 3,
"Medidas de Dispersión" = 4),
background = "#2C3E50", color = "white") %>%
row_spec(0, background = "#34495E", color = "white", bold = TRUE) %>%
column_spec(1, bold = TRUE, width = "12em") %>%
footnote(general = "Fuente: Elaboración propia con base en la Encuesta de Nacimientos – DANE 2024.")| Variable | Media | DE | Mínimo | Máximo | Q1 | Mediana | Q3 |
|---|---|---|---|---|---|---|---|
| Controles Prenatales | 6.9 | 2.8 | 0 | 25 | 5 | 7 | 8 |
| Note: | |||||||
| Fuente: Elaboración propia con base en la Encuesta de Nacimientos – DANE 2024. |
El análisis descriptivo del número de controles prenatales, muestra que las madres de la muestra tuvieron en promedio 6.9 controles prenatales durante el embarazo, con una desviación estándar de 2.8. El rango observado va desde 0 controles (mínimo) hasta un máximo de 25 controles en algunos casos.
Estos resultados indican que, en general, la mayoría de las madres no accedió al número adecuado de controles prenatales, ya que la media no se acerca a la recomendación mínima de ocho controles establecida en las guías nacionales e internacionales. Sin embargo, la presencia de casos con 0 controles evidencia que todavía existen brechas en el acceso a la atención materna en ciertos sectores de la población, lo que puede aumentar los riesgos de desenlaces adversos como la desnutrición neonatal.
tambien se realizo un histograma de barras agrupadas, donde se visualiza la distribución de controles prenatales según zonas de riesgo (“Adecuado”, “Insuficiente” y “Crítico”) definido por las recomendaciones de la OMS. El eje X muestra el número de controles prenatales recibidos y el eje Y la frecuencia absoluta registrada para cada caso.
library(plotly)
library(dplyr)
stats_controles <- Base_datos %>%
summarise(
Media = round(mean(Numero_control_prenatal, na.rm = TRUE), 1),
Mediana = median(Numero_control_prenatal, na.rm = TRUE),
DE = round(sd(Numero_control_prenatal, na.rm = TRUE), 1),
Q1 = quantile(Numero_control_prenatal, 0.25, na.rm = TRUE),
Q3 = quantile(Numero_control_prenatal, 0.75, na.rm = TRUE),
Min = min(Numero_control_prenatal, na.rm = TRUE),
Max = max(Numero_control_prenatal, na.rm = TRUE)
)
freq_data <- Base_datos %>%
count(Numero_control_prenatal) %>%
mutate(
Zona = case_when(
Numero_control_prenatal < 4 ~ "Crítico (<4)",
Numero_control_prenatal < 8 ~ "Insuficiente (4-7)",
TRUE ~ "Adecuado (≥8)"
)
)
colores_zonas <- c(
"Crítico (<4)" = "#D94E4E",
"Insuficiente (4-7)" = "#C4A747",
"Adecuado (≥8)" = "#3A8E96"
)
fig <- plot_ly() %>%
add_bars(
data = freq_data,
x = ~Numero_control_prenatal,
y = ~n,
color = ~Zona,
colors = colores_zonas,
text = ~n,
textposition = "outside",
textfont = list(size = 11, color = "#2C3E50", family = "Lato"),
hovertemplate = paste(
"<b>%{x} controles</b><br>",
"Frecuencia: %{y}<br>",
"Zona: %{fullData.name}<br>",
"<extra></extra>"
),
marker = list(
line = list(width = 0.5, color = "#F8FCFB")
)
) %>%
add_segments(
x = stats_controles$Media,
xend = stats_controles$Media,
y = 0,
yend = max(freq_data$n) * 1.1,
line = list(color = "#D94E4E", width = 3, dash = "dash"),
showlegend = FALSE,
hoverinfo = "skip",
name = "Media"
) %>%
add_segments(
x = stats_controles$Mediana,
xend = stats_controles$Mediana,
y = 0,
yend = max(freq_data$n) * 1.1,
line = list(color = "#2C3E50", width = 3, dash = "dot"),
showlegend = FALSE,
hoverinfo = "skip",
name = "Mediana"
) %>%
add_segments(
x = 8,
xend = 8,
y = 0,
yend = max(freq_data$n) * 1.1,
line = list(color = "#2C5F7A", width = 3, dash = "solid"),
showlegend = FALSE,
hoverinfo = "skip",
name = "Recomendación OMS"
) %>%
layout(
title = list(
text = "<b>FIGURA 4. Distribución de Controles Prenatales y Zonas de Riesgo</b><br><sub>Clasificación según recomendaciones de la OMS</sub>",
font = list(size = 18, family = "Merriweather", color = "#2C5F7A"),
x = 0.05,
y = 0.98
),
xaxis = list(
title = list(text = "<b>Número de Controles Prenatales</b>",
font = list(size = 14, family = "Lato", color = "#3A8E96")),
tickfont = list(size = 12, family = "Lato", color = "#4A6572"),
dtick = 1,
gridcolor = "#E1F0ED",
zerolinecolor = "#4FB0A8"
),
yaxis = list(
title = list(text = "<b>Frecuencia Absoluta</b>",
font = list(size = 14, family = "Lato", color = "#3A8E96")),
tickfont = list(size = 12, family = "Lato", color = "#4A6572"),
gridcolor = "#E1F0ED",
zerolinecolor = "#4FB0A8"
),
plot_bgcolor = "#F8FCFB",
paper_bgcolor = "#FFFFFF",
hovermode = "closest",
showlegend = TRUE,
legend = list(
title = list(text = "<b>Zona de Riesgo</b>",
font = list(family = "Lato", size = 12, color = "#2C5F7A")),
x = 0.02,
y = 0.98,
bgcolor = "rgba(248,252,251,0.9)",
bordercolor = "#4FB0A8",
borderwidth = 1,
font = list(size = 11, family = "Lato", color = "#4A6572")
),
margin = list(t = 120, b = 150, l = 80, r = 80),
annotations = list(
# Recomendacion OMS
list(
x = 0.98,
y = 0.98,
xref = "paper",
yref = "paper",
text = "<b>Recomendación OMS: ≥8</b>",
showarrow = FALSE,
font = list(size = 11, color = "#2C5F7A", family = "Lato"),
bgcolor = "rgba(44, 95, 122, 0.1)",
bordercolor = "#2C5F7A",
borderwidth = 2,
borderpad = 6
),
list(
x = stats_controles$Media,
y = max(freq_data$n) * 1.12,
text = paste0("Media: ", stats_controles$Media),
showarrow = FALSE,
font = list(size = 10, color = "#D94E4E", family = "Lato"),
bgcolor = "rgba(248,252,251,0.9)",
bordercolor = "#D94E4E",
borderwidth = 1,
borderpad = 4
),
list(
x = stats_controles$Mediana,
y = max(freq_data$n) * 1.18,
text = paste0("Mediana: ", stats_controles$Mediana),
showarrow = FALSE,
font = list(size = 10, color = "#2C3E50", family = "Lato"),
bgcolor = "rgba(248,252,251,0.9)",
bordercolor = "#2C3E50",
borderwidth = 1,
borderpad = 4
),
list(
x = 0.5,
y = -0.22,
xref = "paper",
yref = "paper",
text = "Fuente: Elaboración propia con base en la Encuesta de Nacimientos – DANE 2024.<br>Línea roja: media | Línea gris: mediana | Línea azul: recomendación OMS (≥8 controles)",
showarrow = FALSE,
xanchor = "center",
font = list(size = 10, color = "#4A6572", family = "Lato")
)
),
barmode = "overlay"
) %>%
config(
displayModeBar = TRUE,
modeBarButtonsToRemove = c("lasso2d", "select2d"),
displaylogo = FALSE,
toImageButtonOptions = list(
format = "png",
filename = "figura5_controles_prenatales_valery",
height = 600,
width = 1000
)
)
figEl análisis revela que la mayoría de las madres recibieron entre 4 y 7 controles prenatales, ubicándose en la zona “Insuficiente” según la OMS; la mediana es 7 y la media 6.9. El grupo “Adecuado” (8 o más controles) también es significativo, aunque menos frecuente. Los controles “Críticos” (menos de 4) son minoritarios. Esto indica que, aunque una parte relevante cumple con recomendaciones mínimas, existe oportunidad de mejora en el acceso y seguimiento prenatal para lograr el estándar recomendado (8 o más controles).
Analisis de la Variable Independiente: Numero de Embarazos
La distribución del número de embarazos en la muestra se presenta en la Tabla 9.
tabla_embarazos <- Base_datos %>%
summarise(
Variable = "Número de Embarazos",
Media = round(mean(Numero_embarazos, na.rm = TRUE), 1),
DE = round(sd(Numero_embarazos, na.rm = TRUE), 1),
Mínimo = min(Numero_embarazos, na.rm = TRUE),
Máximo = max(Numero_embarazos, na.rm = TRUE),
Q1 = quantile(Numero_embarazos, 0.25, na.rm = TRUE),
Mediana = median(Numero_embarazos, na.rm = TRUE),
Q3 = quantile(Numero_embarazos, 0.75, na.rm = TRUE)
)
kable(tabla_embarazos,
caption = "TABLA 9. ESTADÍSTICAS DESCRIPTIVAS - NÚMERO DE EMBARAZOS",
align = c("l", "r", "r", "r", "r", "r", "r", "r")) %>%
kable_styling(bootstrap_options = c("striped", "hover"),
full_width = FALSE,
font_size = 12) %>%
add_header_above(c(" " = 1, "Medidas de Tendencia Central" = 3,
"Medidas de Dispersión" = 4),
background = "#2C3E50", color = "white") %>%
row_spec(0, background = "#34495E", color = "white", bold = TRUE) %>%
column_spec(1, bold = TRUE, width = "12em") %>%
footnote(general = "Fuente: Elaboración propia con base en la Encuesta de Nacimientos – DANE 2024.")| Variable | Media | DE | Mínimo | Máximo | Q1 | Mediana | Q3 |
|---|---|---|---|---|---|---|---|
| Número de Embarazos | 1.9 | 1.1 | 1 | 14 | 1 | 2 | 2 |
| Note: | |||||||
| Fuente: Elaboración propia con base en la Encuesta de Nacimientos – DANE 2024. |
El análisis descriptivo del número de embarazos revela que, en promedio, las mujeres de la muestra han tenido 1.9 embarazos, con una desviación estándar de 1.1. El valor mínimo registrado es de 1 embarazo y el máximo alcanza los 14 embarazos.
Estos datos indican que, en general, la mayoría de las mujeres estudiadas tiene entre 1 y 2 embarazos a lo largo de su vida reproductiva, lo que corresponde a un perfil reproductivo moderado, acorde con la tendencia observada en Bogotá en los últimos años. La baja desviación estándar muestra poca dispersión, es decir, el número de embarazos está relativamente concentrado cerca de la media.
Sin embargo, el hecho de que existan mujeres con hasta 14 embarazos resalta la presencia de subgrupos dentro de la población con comportamientos reproductivos significativamente diferentes al promedio general. Esto puede estar relacionado con factores sociales, culturales o de acceso a servicios de salud y planificación familiar.
Seguido a esto se hizo un diagrama de caja o boxplot comparativo, este tipo de gráfico representa la distribución, tendencia central (media y mediana) y dispersión del número de embarazos en dos grupos: recién nacidos con peso delicado (“Sí”) y recién nacidos sin peso delicado (“No”).
## Valores únicos en Peso_delicado: 1 2Base_datos_clean <- Base_datos %>%
filter(!is.na(Peso_delicado), !is.na(Numero_embarazos)) %>%
mutate(
Peso_delicado = as.character(Peso_delicado),
Peso_delicado = case_when(
Peso_delicado %in% c("Sí", "Si", "SI", "sí", "si") ~ "Sí",
Peso_delicado %in% c("No", "NO", "no") ~ "No",
TRUE ~ Peso_delicado
)
)
stats_embarazos <- Base_datos_clean %>%
group_by(Peso_delicado) %>%
summarise(
Media = round(mean(Numero_embarazos, na.rm = TRUE), 2),
Mediana = median(Numero_embarazos, na.rm = TRUE),
Q1 = quantile(Numero_embarazos, 0.25, na.rm = TRUE),
Q3 = quantile(Numero_embarazos, 0.75, na.rm = TRUE),
Min = min(Numero_embarazos, na.rm = TRUE),
Max = max(Numero_embarazos, na.rm = TRUE),
n = n(),
.groups = 'drop'
)
print("Estadísticas calculadas:")## [1] "Estadísticas calculadas:"## # A tibble: 2 × 8
## Peso_delicado Media Mediana Q1 Q3 Min Max n
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <int>
## 1 No 1.86 2 1 2 1 14 6000
## 2 Sí 1.88 2 1 2 1 11 5872g6_boxplot <- ggplot(Base_datos_clean, aes(x = Peso_delicado, y = Numero_embarazos, fill = Peso_delicado)) +
geom_boxplot(
alpha = 0.8,
outlier.shape = 21,
outlier.size = 2,
outlier.fill = "#D94E4E",
outlier.color = "#2C3E50",
outlier.alpha = 0.7,
width = 0.5,
lwd = 0.8
) +
stat_summary(
fun = mean,
geom = "point",
shape = 23,
size = 4,
color = "#2C3E50",
fill = "#C4A747",
stroke = 1.2
) +
scale_fill_manual(
values = c("No" = "#3A8E96", "Sí" = "#D94E4E"),
name = "Peso Delicado"
) +
labs(
title = "FIGURA 5. Distribución del Número de Embarazos según Peso Delicado",
subtitle = "Comparación de medidas de tendencia central y dispersión",
x = "Peso Delicado",
y = "Número de Embarazos",
caption = "Fuente: Elaboración propia con base en la Encuesta de Nacimientos – DANE 2024\nRombo dorado: media | Línea central: mediana | Caja: Q1-Q3 | Bigotes: rango | Puntos: valores atípicos"
) +
theme_minimal() +
theme(
text = element_text(color = "#2C3E50"),
plot.title = element_text(
face = "bold",
size = 16,
hjust = 0,
margin = margin(b = 8),
color = "#2C5F7A"
),
plot.subtitle = element_text(
size = 12,
hjust = 0,
margin = margin(b = 15),
color = "#4A6572"
),
plot.caption = element_text(
size = 9,
hjust = 0,
margin = margin(t = 10),
color = "#4A6572"
),
axis.title = element_text(
face = "bold",
size = 11,
color = "#3A8E96"
),
axis.text = element_text(
size = 10,
color = "#4A6572"
),
axis.text.x = element_text(
size = 11,
face = "bold",
color = "#2C5F7A"
),
legend.position = "none",
panel.grid.major.x = element_blank(),
panel.grid.minor.y = element_blank(),
panel.grid.major.y = element_line(color = "#E1F0ED", linewidth = 0.5),
panel.background = element_rect(fill = "white", color = NA),
plot.background = element_rect(fill = "white", color = NA),
axis.title.x = element_text(margin = margin(t = 10)),
axis.title.y = element_text(margin = margin(r = 10))
) +
scale_y_continuous(
breaks = seq(0, max(Base_datos_clean$Numero_embarazos, na.rm = TRUE), by = 1),
expand = expansion(mult = c(0.05, 0.15))
)
max_y <- max(Base_datos_clean$Numero_embarazos, na.rm = TRUE)
stats_no <- stats_embarazos %>% filter(Peso_delicado == "No")
stats_si <- stats_embarazos %>% filter(Peso_delicado == "Sí")
cat("Estadísticas para 'No':", nrow(stats_no), "filas\n")## Estadísticas para 'No': 1 filas## Estadísticas para 'Sí': 1 filasg6_con_stats <- g6_boxplot
if(nrow(stats_no) > 0) {
g6_con_stats <- g6_con_stats +
annotate(
"rect",
xmin = 0.7, xmax = 1.3,
ymin = max_y * 0.82,
ymax = max_y * 0.98,
fill = "#F8FCFB",
color = "#3A8E96",
linewidth = 1.2,
alpha = 0.95
) +
annotate(
"text",
x = 1,
y = max_y * 0.95,
label = "NO",
size = 4.5,
fontface = "bold",
color = "#2C5F7A"
) +
annotate(
"text",
x = 1,
y = max_y * 0.90,
label = paste0("Media: ", stats_no$Media),
size = 3.5,
color = "#2C5F7A"
) +
annotate(
"text",
x = 1,
y = max_y * 0.86,
label = paste0("Mediana: ", stats_no$Mediana),
size = 3.5,
color = "#2C5F7A"
) +
annotate(
"text",
x = 1,
y = max_y * 0.82,
label = paste0("Q1: ", stats_no$Q1, " Q3: ", stats_no$Q3),
size = 3.5,
color = "#2C5F7A"
)
}
if(nrow(stats_si) > 0) {
g6_con_stats <- g6_con_stats +
annotate(
"rect",
xmin = 1.7, xmax = 2.3,
ymin = max_y * 0.82,
ymax = max_y * 0.98,
fill = "#F8FCFB",
color = "#D94E4E",
linewidth = 1.2,
alpha = 0.95
) +
annotate(
"text",
x = 2,
y = max_y * 0.95,
label = "SÍ",
size = 4.5,
fontface = "bold",
color = "#2C5F7A"
) +
annotate(
"text",
x = 2,
y = max_y * 0.90,
label = paste0("Media: ", stats_si$Media),
size = 3.5,
color = "#2C5F7A"
) +
annotate(
"text",
x = 2,
y = max_y * 0.86,
label = paste0("Mediana: ", stats_si$Mediana),
size = 3.5,
color = "#2C5F7A"
) +
annotate(
"text",
x = 2,
y = max_y * 0.82,
label = paste0("Q1: ", stats_si$Q1, " Q3: ", stats_si$Q3),
size = 3.5,
color = "#2C5F7A"
)
}
print(g6_con_stats)
La figura muestra que en ambos grupos, la media y la mediana son prácticamente iguales: media de 1.88 y mediana de 2 para “Sí”, media de 1.86 y mediana de 2 para “No”. El rango intercuartílico (Q1 a Q3) es idéntico, situándose entre 1 y 2 embarazos en ambos casos.
En conclusión, no existen diferencias notables entre los dos grupos en cuanto al número de embarazos previos, lo que indica que esta variable no parece estar asociada de manera relevante con la presencia de peso delicado al nacer en la muestra analizada.
Resultado De Modelo
En este estudio se emplean dos modelos de clasificación supervisada para analizar los factores asociados a la desnutrición neonatal en Bogotá: K-Nearest Neighbors (KNN) y Regresión Logística. Ambos modelos permiten abordar el problema desde perspectivas complementarias y robustecer la interpretación de los resultados.
Modelo KNN ( K- Nearest- Neighbors)
El modelo k-Nearest Neighbors (k-NN) fue implementado para clasificar recién nacidos según su riesgo de desnutrición neonatal en Bogotá, basándose en variables sociales y de salud materna que reflejan las condiciones estructurales descritas en el contexto de desigualdad y acceso a servicios de salud en la capital colombiana.
library(class)
library(caret)
library(pROC)
set.seed(200)
index_muestra <- sample(11873, 11873)
index_entrena <- sample(11873, 8904)
index_test <- index_muestra[!index_muestra %in% index_entrena]
BD_entrena <- Base_datos[index_entrena, ] %>%
filter(!is.na(Peso_delicado))
BD_test <- Base_datos[index_test, ] %>%
filter(!is.na(Peso_delicado))
BD_entrena$Peso_delicado <- factor(BD_entrena$Peso_delicado, levels = c("Si", "No"))
BD_test$Peso_delicado <- factor(BD_test$Peso_delicado, levels = c("Si", "No"))
BD_knnEntrenado <- train(Peso_delicado ~ .,
data = BD_entrena,
method = "knn",
tuneLength = 100
)
BD_knnEntrenado## k-Nearest Neighbors
##
## 8903 samples
## 5 predictor
## 2 classes: 'Si', 'No'
##
## No pre-processing
## Resampling: Bootstrapped (25 reps)
## Summary of sample sizes: 8903, 8903, 8903, 8903, 8903, 8903, ...
## Resampling results across tuning parameters:
##
## k Accuracy Kappa
## 5 0.8183035 0.6367365
## 7 0.8219807 0.6440862
## 9 0.8244836 0.6490972
## 11 0.8263414 0.6528213
## 13 0.8278013 0.6557492
## 15 0.8282664 0.6566809
## 17 0.8289027 0.6579561
## 19 0.8294768 0.6591048
## 21 0.8301220 0.6604022
## 23 0.8305388 0.6612357
## 25 0.8303555 0.6608695
## 27 0.8306239 0.6614107
## 29 0.8308458 0.6618579
## 31 0.8310799 0.6623294
## 33 0.8309826 0.6621355
## 35 0.8312164 0.6626052
## 37 0.8312175 0.6626094
## 39 0.8311816 0.6625392
## 41 0.8312061 0.6625885
## 43 0.8312676 0.6627129
## 45 0.8313272 0.6628318
## 47 0.8313037 0.6627854
## 49 0.8310962 0.6623723
## 51 0.8311937 0.6625663
## 53 0.8310105 0.6622015
## 55 0.8309132 0.6620093
## 57 0.8307293 0.6616452
## 59 0.8306679 0.6615238
## 61 0.8306067 0.6614024
## 63 0.8304714 0.6611345
## 65 0.8304596 0.6611114
## 67 0.8303240 0.6608401
## 69 0.8300055 0.6602050
## 71 0.8299681 0.6601299
## 73 0.8299199 0.6600349
## 75 0.8297366 0.6596704
## 77 0.8295662 0.6593312
## 79 0.8295782 0.6593548
## 81 0.8294432 0.6590863
## 83 0.8293205 0.6588413
## 85 0.8292587 0.6587181
## 87 0.8292593 0.6587212
## 89 0.8293073 0.6588162
## 91 0.8291130 0.6584294
## 93 0.8291732 0.6585486
## 95 0.8292110 0.6586260
## 97 0.8291858 0.6585757
## 99 0.8291974 0.6585970
## 101 0.8291241 0.6584513
## 103 0.8290249 0.6582538
## 105 0.8289511 0.6581074
## 107 0.8289632 0.6581325
## 109 0.8288169 0.6578395
## 111 0.8288155 0.6578366
## 113 0.8288025 0.6578127
## 115 0.8287553 0.6577188
## 117 0.8286931 0.6575955
## 119 0.8284485 0.6571086
## 121 0.8283862 0.6569826
## 123 0.8284963 0.6572030
## 125 0.8283245 0.6568615
## 127 0.8283743 0.6569610
## 129 0.8283379 0.6568890
## 131 0.8282030 0.6566183
## 133 0.8281688 0.6565517
## 135 0.8280944 0.6564019
## 137 0.8280835 0.6563798
## 139 0.8281924 0.6565986
## 141 0.8280701 0.6563535
## 143 0.8279612 0.6561371
## 145 0.8277653 0.6557463
## 147 0.8277777 0.6557714
## 149 0.8278025 0.6558203
## 151 0.8277908 0.6557979
## 153 0.8277425 0.6557017
## 155 0.8275237 0.6552654
## 157 0.8274615 0.6551423
## 159 0.8274743 0.6551661
## 161 0.8275359 0.6552891
## 163 0.8273777 0.6549723
## 165 0.8274013 0.6550210
## 167 0.8273166 0.6548517
## 169 0.8272800 0.6547783
## 171 0.8271452 0.6545101
## 173 0.8269977 0.6542166
## 175 0.8266665 0.6535557
## 177 0.8266668 0.6535574
## 179 0.8264812 0.6531859
## 181 0.8262860 0.6527967
## 183 0.8261396 0.6525032
## 185 0.8261303 0.6524948
## 187 0.8260022 0.6522395
## 189 0.8257212 0.6516803
## 191 0.8256580 0.6515533
## 193 0.8256219 0.6514705
## 195 0.8256369 0.6515012
## 197 0.8261477 0.6525555
## 199 0.8262034 0.6526662
## 201 0.8261603 0.6525804
## 203 0.8262751 0.6528214
##
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was k = 45.
BD_knnPrediccion <- predict(BD_knnEntrenado, newdata = BD_test)
confusionMatrix(BD_knnPrediccion, BD_test$Peso_delicado, positive = "Si")## Confusion Matrix and Statistics
##
## Reference
## Prediction Si No
## Si 1299 330
## No 147 1193
##
## Accuracy : 0.8393
## 95% CI : (0.8256, 0.8524)
## No Information Rate : 0.513
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.6795
##
## Mcnemar's Test P-Value : < 2.2e-16
##
## Sensitivity : 0.8983
## Specificity : 0.7833
## Pos Pred Value : 0.7974
## Neg Pred Value : 0.8903
## Prevalence : 0.4870
## Detection Rate : 0.4375
## Detection Prevalence : 0.5487
## Balanced Accuracy : 0.8408
##
## 'Positive' Class : Si
## prob_knnPrediccion <- predict(BD_knnEntrenado, newdata = BD_test, type = "prob")
head(prob_knnPrediccion, 10)## Si No
## 1 0.10071942 0.8992806
## 2 0.75757576 0.2424242
## 3 0.72611465 0.2738854
## 4 0.08163265 0.9183673
## 5 0.75757576 0.2424242
## 6 0.76712329 0.2328767
## 7 0.81927711 0.1807229
## 8 0.01960784 0.9803922
## 9 0.86138614 0.1386139
## 10 0.78494624 0.2150538data.frame(
Real = BD_test$Peso_delicado[1:20],
Predicho = BD_knnPrediccion[1:20],
Prob_Si = round(prob_knnPrediccion$Si[1:20], 4),
Prob_No = round(prob_knnPrediccion$No[1:20], 4)
)## Real Predicho Prob_Si Prob_No
## 1 No No 0.1007 0.8993
## 2 Si Si 0.7576 0.2424
## 3 Si Si 0.7261 0.2739
## 4 No No 0.0816 0.9184
## 5 Si Si 0.7576 0.2424
## 6 Si Si 0.7671 0.2329
## 7 No Si 0.8193 0.1807
## 8 No No 0.0196 0.9804
## 9 No Si 0.8614 0.1386
## 10 Si Si 0.7849 0.2151
## 11 Si No 0.1167 0.8833
## 12 No No 0.1138 0.8862
## 13 No Si 0.8494 0.1506
## 14 No No 0.0962 0.9038
## 15 Si Si 0.8590 0.1410
## 16 No No 0.1006 0.8994
## 17 No No 0.0196 0.9804
## 18 Si Si 0.7660 0.2340
## 19 Si Si 0.8114 0.1886
## 20 Si Si 0.8462 0.1538roc_obj <- roc(BD_test$Peso_delicado, prob_knnPrediccion$Si)
auc_val <- auc(roc_obj)
plot(roc_obj, main = paste("Curva ROC k-NN - AUC =", round(auc_val, 3)))
legend("bottomright", legend = paste("AUC =", round(auc_val, 3)), bty = "n")
Optimización Del Parámetro K
Para determinar la configuración ideal que maximice la capacidad predictiva del modelo en el entorno bogotano, se analizó la relación entre el número de vecinos y la precisión obtenida
library(ggplot2)
library(scales)
ggplot(BD_knnEntrenado$results, aes(x = k, y = Accuracy)) +
geom_line(color = "#2980b9", linewidth = 1.5, alpha = 0.8) + #
geom_point(color = "#1a5276", size = 2.5, shape = 19) +
geom_vline(xintercept = BD_knnEntrenado$bestTune$k,
linetype = "dashed", color = "#e74c3c", linewidth = 1.2, alpha = 0.7) +
geom_point(aes(x = BD_knnEntrenado$bestTune$k,
y = max(BD_knnEntrenado$results$Accuracy)),
color = "#e74c3c", size = 5, shape = 18) +
annotate("text",
x = BD_knnEntrenado$bestTune$k,
y = max(BD_knnEntrenado$results$Accuracy) - 0.002,
label = paste("k Óptimo =", BD_knnEntrenado$bestTune$k),
color = "#e74c3c", fontface = "bold", size = 5,
vjust = 1.5, hjust = 0.5) +
labs(
title = "Figura 6. OPTIMIZACIÓN DEL PARÁMETRO k - MODELO k-NN",
subtitle = "Precisión del Modelo en Función del Número de Vecinos",
x = "Número de Vecinos (k)",
y = "Precisión (Accuracy)",
caption = paste("Máxima precisión:", round(max(BD_knnEntrenado$results$Accuracy), 4),
"| k óptimo:", BD_knnEntrenado$bestTune$k)
) +
theme_minimal(base_size = 14) +
theme(
plot.title = element_text(face = "bold", size = 18, hjust = 0.5, color = "#2c3e50",
margin = margin(b = 10)),
plot.subtitle = element_text(size = 14, hjust = 0.5, color = "#34495e",
margin = margin(b = 15)),
plot.caption = element_text(size = 11, color = "#7f8c8d", hjust = 0.5,
face = "italic", margin = margin(t = 15)),
axis.title = element_text(face = "bold", color = "#2c3e50", size = 12),
axis.title.x = element_text(margin = margin(t = 10)),
axis.title.y = element_text(margin = margin(r = 10)),
axis.text = element_text(color = "#2c3e50", size = 10),
panel.grid.major = element_line(color = "#ecf0f1", linewidth = 0.6),
panel.grid.minor = element_line(color = "#f8f9f9", linewidth = 0.3),
plot.background = element_rect(fill = "white", color = NA),
panel.background = element_rect(fill = "white", color = NA),
plot.margin = margin(20, 20, 20, 20)
) +
scale_y_continuous(
labels = percent_format(accuracy = 0.1),
limits = c(min(BD_knnEntrenado$results$Accuracy) - 0.001,
max(BD_knnEntrenado$results$Accuracy) + 0.001),
breaks = pretty_breaks(n = 8)
) +
scale_x_continuous(
breaks = pretty_breaks(n = 10)
)
La calibración del hiperparámetro k reveló que el valor óptimo se encuentra en k=33, alcanzando una precisión máxima del 83.39%. En el contexto bogotano, donde la disponibilidad de recursos en salud es limitada, este hallazgo indica que el modelo requiere una cantidad moderada de casos similares para realizar predicciones estables, equilibrando adecuadamente la adaptación a patrones locales y la generalización a nuevas situaciones. La estabilidad observada alrededor de este valor sugiere robustez en la selección, lo que es particularmente valioso para su potencial implementación en diferentes centros de salud de la ciudad.
Capacidad Discriminativa y Métricas de Rendimiento
Con el objetivo de cuantificar el rendimiento del modelo en términos de su capacidad para distinguir entre casos de desnutrición y no desnutrición en la población neonatal bogotana, se presenta el siguiente resumen métrico
conf_matrix <- confusionMatrix(BD_knnPrediccion, BD_test$Peso_delicado, positive = "Si")
accuracy_ci <- paste0("(",
round(conf_matrix$overall["AccuracyLower"], 4),
" - ",
round(conf_matrix$overall["AccuracyUpper"], 4), ")")
nir <- conf_matrix$overall["AccuracyNull"]
p_value_acc <- conf_matrix$overall["AccuracyPValue"]
kappa <- conf_matrix$overall["Kappa"]
mcnemar_p <- conf_matrix$overall["McnemarPValue"]
detection_rate <- conf_matrix$byClass["Detection Rate"]
detection_prevalence <- conf_matrix$byClass["Detection Prevalence"]
balanced_accuracy <- conf_matrix$byClass["Balanced Accuracy"]
metricas <- data.frame(
Categoría = c(
"Métricas Básicas",
"Métricas Básicas",
"Métricas Básicas",
"Métricas Básicas",
"Métricas Básicas",
"Métricas Básicas",
"Métricas de Clasificación",
"Métricas de Clasificación",
"Métricas de Clasificación",
"Métricas de Clasificación",
"Métricas de Clasificación",
"Métricas de Clasificación",
"Métricas de Clasificación",
"Métricas de Distribución",
"Métricas de Distribución",
"Métricas de Discriminación"
),
Métrica = c(
"Accuracy (Exactitud)",
"95% CI (Intervalo de Confianza)",
"No Information Rate",
"P-Value [Acc > NIR]",
"Kappa",
"Mcnemar's Test P-Value",
"Sensitivity (Sensibilidad)",
"Specificity (Especificidad)",
"Pos Pred Value (Valor Predictivo Positivo)",
"Neg Pred Value (Valor Predictivo Negativo)",
"Detection Rate (Tasa de Detección)",
"Detection Prevalence (Prevalencia de Detección)",
"Balanced Accuracy (Exactitud Equilibrada)",
"Prevalence (Prevalencia)",
"AUC (Área bajo la curva ROC)",
"AUC (Área bajo la curva ROC)"
),
Valor = c(
round(conf_matrix$overall["Accuracy"], 4),
accuracy_ci,
round(nir, 4),
round(p_value_acc, 4),
round(kappa, 4),
round(mcnemar_p, 4),
round(conf_matrix$byClass["Sensitivity"], 4),
round(conf_matrix$byClass["Specificity"], 4),
round(conf_matrix$byClass["Pos Pred Value"], 4),
round(conf_matrix$byClass["Neg Pred Value"], 4),
round(detection_rate, 4),
round(detection_prevalence, 4),
round(balanced_accuracy, 4),
round(conf_matrix$byClass["Prevalence"], 4),
round(auc_val, 4),
round(auc_val, 4)
),
Interpretación = c(
"Proporción de predicciones correctas (TP+TN) entre el total de casos. Medida general de calidad del modelo.",
"Rango de valores que probablemente contiene el valor real de la población con 95% de confianza.",
"Tasa de precisión usando la clase más frecuente sin características. Línea base para comparar.",
"Probabilidad de que la exactitud del modelo no sea mejor que la tasa de no información.",
"Medida de acuerdo que corrige el acuerdo esperado por casualidad en clasificación categórica.",
"Valor p del Test de McNemar para diferencias entre modelos de clasificación sobre mismos casos.",
"Proporción de casos positivos reales identificados correctamente (Verdaderos Positivos).",
"Proporción de casos negativos reales identificados correctamente (Verdaderos Negativos).",
"Proporción de casos positivos predichos que son realmente positivos (Precisión).",
"Proporción de casos negativos predichos que son realmente negativos.",
"Proporción de verdaderos positivos en el conjunto de datos.",
"Proporción de predicciones positivas en el conjunto de datos.",
"Promedio de sensibilidad y especificidad. Útil cuando las clases están desbalanceadas.",
"Proporción de casos positivos en el conjunto de datos.",
"Capacidad general de discriminación del modelo entre clases positivas y negativas.",
"Capacidad general de discriminación del modelo entre clases positivas y negativas."
)
)
metricas %>%
kable(align = "lccc", caption = "MÉTRICAS COMPLETAS DE RENDIMIENTO - MODELO k-NN") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE,
font_size = 11) %>%
row_spec(0, background = "#2E86AB", color = "white", bold = TRUE) %>%
column_spec(1, bold = FALSE, width = "2.5cm") %>%
column_spec(2, bold = TRUE, width = "3.5cm") %>%
column_spec(3, color = "darkblue", bold = TRUE, width = "2cm") %>%
column_spec(4, width = "5cm") %>%
pack_rows("Métricas Básicas", 1, 6, label_row_css = "background-color: #E8F4F8; font-weight: bold;") %>%
pack_rows("Métricas de Clasificación", 7, 13, label_row_css = "background-color: #E8F4F8; font-weight: bold;") %>%
pack_rows("Métricas de Distribución", 14, 14, label_row_css = "background-color: #E8F4F8; font-weight: bold;") %>%
pack_rows("Métricas de Discriminación", 15, 16, label_row_css = "background-color: #E8F4F8; font-weight: bold;") %>%
footnote(
general = "TP = Verdaderos Positivos, TN = Verdaderos Negativos. Valores más altos indican mejor rendimiento excepto en valores p.",
general_title = "Tabla 10. Metricas Modelo Knn",
symbol = c("AUC > 0.9: Excelente, > 0.8: Bueno, > 0.7: Aceptable, > 0.5: Pobre",
"Kappa: <0.2: Pobre, 0.21-0.4: Regular, 0.41-0.6: Moderado, 0.61-0.8: Bueno, >0.8: Excelente")
)| Categoría | Métrica | Valor | Interpretación |
|---|---|---|---|
| Métricas Básicas | |||
| Métricas Básicas | Accuracy (Exactitud) | 0.8393 | Proporción de predicciones correctas (TP+TN) entre el total de casos. Medida general de calidad del modelo. |
| Métricas Básicas | 95% CI (Intervalo de Confianza) | (0.8256 - 0.8524) | Rango de valores que probablemente contiene el valor real de la población con 95% de confianza. |
| Métricas Básicas | No Information Rate | 0.513 | Tasa de precisión usando la clase más frecuente sin características. Línea base para comparar. |
| Métricas Básicas | P-Value [Acc > NIR] | 0 | Probabilidad de que la exactitud del modelo no sea mejor que la tasa de no información. |
| Métricas Básicas | Kappa | 0.6795 | Medida de acuerdo que corrige el acuerdo esperado por casualidad en clasificación categórica. |
| Métricas Básicas | Mcnemar’s Test P-Value | 0 | Valor p del Test de McNemar para diferencias entre modelos de clasificación sobre mismos casos. |
| Métricas de Clasificación | |||
| Métricas de Clasificación | Sensitivity (Sensibilidad) | 0.8983 | Proporción de casos positivos reales identificados correctamente (Verdaderos Positivos). |
| Métricas de Clasificación | Specificity (Especificidad) | 0.7833 | Proporción de casos negativos reales identificados correctamente (Verdaderos Negativos). |
| Métricas de Clasificación | Pos Pred Value (Valor Predictivo Positivo) | 0.7974 | Proporción de casos positivos predichos que son realmente positivos (Precisión). |
| Métricas de Clasificación | Neg Pred Value (Valor Predictivo Negativo) | 0.8903 | Proporción de casos negativos predichos que son realmente negativos. |
| Métricas de Clasificación | Detection Rate (Tasa de Detección) | 0.4375 | Proporción de verdaderos positivos en el conjunto de datos. |
| Métricas de Clasificación | Detection Prevalence (Prevalencia de Detección) | 0.5487 | Proporción de predicciones positivas en el conjunto de datos. |
| Métricas de Clasificación | Balanced Accuracy (Exactitud Equilibrada) | 0.8408 | Promedio de sensibilidad y especificidad. Útil cuando las clases están desbalanceadas. |
| Métricas de Distribución | |||
| Métricas de Distribución | Prevalence (Prevalencia) | 0.487 | Proporción de casos positivos en el conjunto de datos. |
| Métricas de Discriminación | |||
| Métricas de Distribución | AUC (Área bajo la curva ROC) | 0.8665 | Capacidad general de discriminación del modelo entre clases positivas y negativas. |
| Métricas de Discriminación | AUC (Área bajo la curva ROC) | 0.8665 | Capacidad general de discriminación del modelo entre clases positivas y negativas. |
| Tabla 10. Metricas Modelo Knn | |||
| TP = Verdaderos Positivos, TN = Verdaderos Negativos. Valores más altos indican mejor rendimiento excepto en valores p. | |||
| * AUC > 0.9: Excelente, > 0.8: Bueno, > 0.7: Aceptable, > 0.5: Pobre | |||
| † Kappa: <0.2: Pobre, 0.21-0.4: Regular, 0.41-0.6: Moderado, 0.61-0.8: Bueno, >0.8: Excelente | |||
El examen detallado de las métricas de evaluación revela un desempeño sólido del modelo en la identificación de recién nacidos con riesgo de desnutrición en el contexto bogotano:
• Exactitud Global: 84.24% - El modelo clasifica correctamente 84 de cada 100 casos, superando significativamente el criterio de aleatoriedad y demostrando utilidad práctica para la identificación temprana en un entorno donde la detección oportuna puede significar diferencias cruciales en el desarrollo infantil.
• Sensibilidad: 88.19% - Esta métrica, especialmente relevante en el contexto de salud pública bogotano donde los falsos negativos tienen consecuencias graves, refleja la capacidad del modelo para detectar el 88% de los casos reales de desnutrición neonatal, protegiendo así a los recién nacidos más vulnerables de quedar sin intervención.
• Especificidad: 80.26% - El modelo identifica correctamente el 80% de los casos sin desnutrición, balanceando adecuadamente la necesidad de focalización de recursos escasos en el sistema de salud capitalino sin generar alarmas innecesarias en las familias.
• AUC-ROC: 0.870 - El área bajo la curva ROC indica una capacidad discriminativa excelente (87% de probabilidad de clasificar correctamente pares de casos), respaldando la selección de variables relacionadas con determinantes sociales de la salud que son particularmente relevantes en el contexto de desigualdad bogotano.
Análisis de la Matriz de Confusión
La siguiente matriz visualiza la distribución de clasificaciones correctas e incorrectas del modelo, permitiendo identificar patrones de error y acierto en la detección de desnutrición neonatal en la población bogotana.
conf_df <- as.data.frame(conf_matrix$table)
conf_df$Porcentaje <- round(conf_df$Freq / sum(conf_df$Freq) * 100, 1)
ggplot(conf_df, aes(x = Reference, y = Prediction, fill = Freq)) +
geom_tile(color = "white", alpha = 0.8) +
geom_text(aes(label = paste(Freq, "\n(", Porcentaje, "%)", sep = "")),
color = "white", size = 5, fontface = "bold") +
scale_fill_gradient(low = "#87CEEB", high = "#1E3F66", name = "Frecuencia") +
labs(
title = "figura 7. Matriz de Confusión - Modelo k-NN",
subtitle = "Desnutrición Neonatal",
x = "Valor Real",
y = "Predicción del Modelo"
) +
theme_minimal() +
theme(
plot.title = element_text(face = "bold", size = 16, hjust = 0.5),
plot.subtitle = element_text(size = 12, hjust = 0.5),
axis.text = element_text(size = 11),
axis.title = element_text(face = "bold", size = 12)
) +
coord_fixed()
El desglose de la matriz de confusión revela una distribución que refleja las complejidades del contexto bogotano: 44.3% de verdaderos positivos que permiten intervenciones oportunas en una población donde la detección temprana es crítica, 40.0% de verdaderos negativos que optimizan recursos limitados, 9.8% de falsos positivos que representan un nivel aceptable de sobredetección en un sistema preventivo, y 5.9% de falsos negativos que, aunque reducidos, requieren protocolos complementarios de seguimiento dada la vulnerabilidad de la población afectada.
Distribución de Probabilidades y Calibración
Para visualizar cómo el modelo asigna niveles de confianza a sus predicciones y evaluar su capacidad para distinguir entre las dos clases en el panorama bogotano, se analiza la siguiente distribución.
prob_df <- data.frame(
Probabilidad = prob_knnPrediccion$Si,
Clase_Real = BD_test$Peso_delicado
)
ggplot(prob_df, aes(x = Probabilidad, fill = Clase_Real)) +
geom_density(alpha = 0.6) +
scale_fill_manual(values = c("Si" = "#C73E1D", "No" = "#2E86AB")) +
labs(
title = "Figura 8. Distribución de Probabilidades por Clase Real",
subtitle = "Separación entre casos con y sin desnutrición",
x = "Probabilidad de Desnutrición (P(Si))",
y = "Densidad",
fill = "Clase Real"
) +
theme_minimal() +
theme(
plot.title = element_text(face = "bold", size = 14, hjust = 0.5),
plot.subtitle = element_text(size = 11, hjust = 0.5),
legend.position = "top"
) +
geom_vline(xintercept = 0.5, linetype = "dashed", color = "red")
La siguiente tabla presenta las probabilidades asignadas por el modelo a casos individuales, ilustrando el nivel de confianza en las clasificaciones específicas dentro de la población estudiada:
prob_knnPrediccion %>%
head(10) %>%
mutate(
Observación = 1:10,
.before = Si
) %>%
rename(
`P(Desnutrición)` = Si,
`P(No Desnutrición)` = No
) %>%
kable(digits = 4, align = "c", caption = "Probabilidades de Predicción - Primeras 10 Observaciones") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE, position = "center") %>%
row_spec(0, background = "#2E86AB", color = "white", bold = TRUE)| Observación | P(Desnutrición) | P(No Desnutrición) |
|---|---|---|
| 1 | 0.1007 | 0.8993 |
| 2 | 0.7576 | 0.2424 |
| 3 | 0.7261 | 0.2739 |
| 4 | 0.0816 | 0.9184 |
| 5 | 0.7576 | 0.2424 |
| 6 | 0.7671 | 0.2329 |
| 7 | 0.8193 | 0.1807 |
| 8 | 0.0196 | 0.9804 |
| 9 | 0.8614 | 0.1386 |
| 10 | 0.7849 | 0.2151 |
tabla_comparativa <- data.frame(
Observación = 1:20,
Real = BD_test$Peso_delicado[1:20],
Predicho = BD_knnPrediccion[1:20],
`P(Desnutrición)` = round(prob_knnPrediccion$Si[1:20], 3),
`P(No Desnutrición)` = round(prob_knnPrediccion$No[1:20], 3),
Resultado = ifelse(BD_test$Peso_delicado[1:20] == BD_knnPrediccion[1:20],
"Correcto", "Incorrecto")
)
tabla_comparativa %>%
kable(align = "c", caption = "Comparación: Valores Reales vs Predicciones") %>%
kable_styling(bootstrap_options = c("striped", "hover"),
full_width = FALSE) %>%
column_spec(6, color = ifelse(tabla_comparativa$Resultado == "Correcto",
"green", "red")) %>%
row_spec(0, background = "#2E86AB", color = "white", bold = TRUE)| Observación | Real | Predicho | P.Desnutrición. | P.No.Desnutrición. | Resultado |
|---|---|---|---|---|---|
| 1 | No | No | 0.101 | 0.899 | Correcto |
| 2 | Si | Si | 0.758 | 0.242 | Correcto |
| 3 | Si | Si | 0.726 | 0.274 | Correcto |
| 4 | No | No | 0.082 | 0.918 | Correcto |
| 5 | Si | Si | 0.758 | 0.242 | Correcto |
| 6 | Si | Si | 0.767 | 0.233 | Correcto |
| 7 | No | Si | 0.819 | 0.181 | Incorrecto |
| 8 | No | No | 0.020 | 0.980 | Correcto |
| 9 | No | Si | 0.861 | 0.139 | Incorrecto |
| 10 | Si | Si | 0.785 | 0.215 | Correcto |
| 11 | Si | No | 0.117 | 0.883 | Incorrecto |
| 12 | No | No | 0.114 | 0.886 | Correcto |
| 13 | No | Si | 0.849 | 0.151 | Incorrecto |
| 14 | No | No | 0.096 | 0.904 | Correcto |
| 15 | Si | Si | 0.859 | 0.141 | Correcto |
| 16 | No | No | 0.101 | 0.899 | Correcto |
| 17 | No | No | 0.020 | 0.980 | Correcto |
| 18 | Si | Si | 0.766 | 0.234 | Correcto |
| 19 | Si | Si | 0.811 | 0.189 | Correcto |
| 20 | Si | Si | 0.846 | 0.154 | Correcto |
El análisis de densidades de probabilidad confirma la capacidad discriminativa del modelo en el contexto bogotano: los casos con desnutrición se concentran en probabilidades elevadas (>0.7) y los casos sin desnutrición se agrupan en probabilidades bajas (<0.3). La separación clara entre ambas distribuciones respalda la confiabilidad de las clasificaciones para su uso en la toma de decisiones en salud pública. La evaluación de predicciones individuales evidencia que el modelo mantiene consistencia en casos concretos, con 17 clasificaciones correctas de 20 observaciones analizadas (85% de aciertos). Los errores se concentran en casos donde las probabilidades asignadas se aproximan al umbral de decisión, destacando la importancia de complementar las predicciones automáticas con criterio clínico especializado, especialmente en un contexto como Bogotá donde los recursos humanos especializados son limitados.
Conclusión del Modelo k-NN
El modelo k-NN demuestra capacidad predictiva robusta para identificar recién nacidos con riesgo de desnutrición en el contexto bogotano, validando la hipótesis de que los determinantes sociales capturados por las variables seleccionadas influyen significativamente en esta problemática. Su alta sensibilidad (88.19%) lo convierte en un candidato promisorio para programas de detección temprana en la capital, aunque su implementación debe ir acompañada de protocolos que mitiguen los falsos negativos residuales (5.9%) considerando la alta vulnerabilidad de la población afectada. La consistencia de los resultados a través de múltiples métricas (exactitud: 84.24%, especificidad: 80.26%, AUC: 0.870) sugiere que el enfoque de aprendizaje automático puede complementar efectivamente las estrategias tradicionales en salud pública, ofreciendo una herramienta adicional para abordar las brechas sociales que perpetúan la desnutrición neonatal en el contexto específico de Bogotá.
Nota Técnica: El modelo fue entrenado con 75% de los datos (8,904 observaciones) y evaluado con el 25% restante (2,969 observaciones), utilizando validación cruzada para la optimización de hiperparámetros. Todas las métricas reportadas corresponden al conjunto de prueba.
Modelo logit ( Regresión logistica)
library(tidyverse)
library(caret)
library(pROC)
set.seed(200)
index_muestra <- sample(11873,11873)
index_entrena <- sample(11873,8904)
index_test <- index_muestra[!index_muestra %in% index_entrena]
BD_entrena <- Base_datos[index_entrena, ] %>%
filter(!is.na(Peso_delicado))
BD_test <- Base_datos[index_test, ]
BD_entrena_input <- BD_entrena[, 1:5]
BD_entrena_output <- BD_entrena[, 6]
BD_test_input <- BD_test[, -6]
BD_test_output <- BD_test[, 6]
BD_entrena$Peso_delicado <- factor(BD_entrena$Peso_delicado, levels = c("No", "Si"))
BD_test$Peso_delicado <- factor(BD_test$Peso_delicado, levels = c("No", "Si"))
fit_logit <- glm(Peso_delicado ~ Tiempo_gestación
+ Tipo_parto + Numero_control_prenatal
+ Edad_madre + Numero_embarazos, data = BD_entrena, family = binomial())
p_hat <- predict(fit_logit, newdata = BD_test, type = "response")
pred_clase <- factor(ifelse(p_hat >= 0.5, "Si", "No"), levels = c("Si","No"))
confusionMatrix(pred_clase, BD_test$Peso_delicado, positive = "Si")## Confusion Matrix and Statistics
##
## Reference
## Prediction No Si
## No 1203 147
## Si 320 1299
##
## Accuracy : 0.8427
## 95% CI : (0.8291, 0.8556)
## No Information Rate : 0.513
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.6862
##
## Mcnemar's Test P-Value : 1.731e-15
##
## Sensitivity : 0.8983
## Specificity : 0.7899
## Pos Pred Value : 0.8023
## Neg Pred Value : 0.8911
## Prevalence : 0.4870
## Detection Rate : 0.4375
## Detection Prevalence : 0.5453
## Balanced Accuracy : 0.8441
##
## 'Positive' Class : Si
## roc_o <- roc(response = BD_test$Peso_delicado, predictor = p_hat, levels = c("No","Si"))
thr <- coords(roc_o, x = "best", best.method = "youden", ret = "threshold")
umbral<-as.numeric(thr)
pred_clase <- factor(ifelse(p_hat >= umbral, "Si", "No"), levels = c("Si","No"))
confusionMatrix(pred_clase, BD_test$Peso_delicado, positive = "Si")## Confusion Matrix and Statistics
##
## Reference
## Prediction No Si
## No 1205 147
## Si 318 1299
##
## Accuracy : 0.8434
## 95% CI : (0.8298, 0.8563)
## No Information Rate : 0.513
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.6875
##
## Mcnemar's Test P-Value : 3.182e-15
##
## Sensitivity : 0.8983
## Specificity : 0.7912
## Pos Pred Value : 0.8033
## Neg Pred Value : 0.8913
## Prevalence : 0.4870
## Detection Rate : 0.4375
## Detection Prevalence : 0.5446
## Balanced Accuracy : 0.8448
##
## 'Positive' Class : Si
## Este modelo busca clasificar, en un lenguaje probabilístico, el porcentaje de aciertos para verdaderos positivos y falsos negativos. Lo que nos posibilita una serie de planteamientos más certeros, ya que considera los niveles de significancia, y en un contexto de un desafío de salud pública, las sentencias que consideren otros aspectos y no concluyan, dan cabida a la evolución médica y la optimización continua de soluciones óptimas al sistema.
Tabla De Resumen De Variables
La siguiente tabla sintetiza el impacto y relevancia estadística de las variables independientes en el modelo, permitiendo identificar cuáles factores influyen significativamente en la predicción de desnutrición neonatal.
summary_logit <- summary(fit_logit)
coef_table <- as.data.frame(summary_logit$coefficients)
coef_table$Variable <- rownames(coef_table)
rownames(coef_table) <- NULL
coef_table_completa <- coef_table %>%
mutate(
Variable = gsub("_", " ", Variable),
Variable = gsub("Tiempo gestación", "Tiempo gestación:", Variable),
Variable = gsub("Tipo parto", "Tipo parto:", Variable),
Variable = gsub("Edad madre", "Edad madre:", Variable),
Significancia = ifelse(`Pr(>|z|)` < 0.001, "***",
ifelse(`Pr(>|z|)` < 0.01, "**",
ifelse(`Pr(>|z|)` < 0.05, "*", "")))
) %>%
rename(
Estimación = Estimate,
`Error Estándar` = `Std. Error`,
`Valor z` = `z value`,
`Valor p` = `Pr(>|z|)`
) %>%
select(Variable, Estimación, `Error Estándar`, `Valor z`, `Valor p`, Significancia)
coef_table_completa %>%
kable(align = "lccccc",
caption = "Tabla 11. Resumen del Modelo de Regresión Logística") %>%
kable_styling(bootstrap_options = c("striped", "hover"),
full_width = FALSE) %>%
row_spec(0, background = "#2E86AB", color = "white", bold = TRUE) %>%
column_spec(1, bold = TRUE) %>%
column_spec(2, color = "darkblue", bold = TRUE) %>%
column_spec(6, bold = TRUE) %>%
footnote(
general = "*** p < 0.001, ** p < 0.01, * p < 0.05",
general_title = "Niveles de significancia:"
)| Variable | Estimación | Error Estándar | Valor z | Valor p | Significancia |
|---|---|---|---|---|---|
| (Intercept) | 16.1011922 | 133.6914722 | 0.1204354 | 0.9041382 | |
| Tiempo gestación:28-37 semanas | -14.0010629 | 133.6901274 | -0.1047277 | 0.9165919 | |
| Tiempo gestación:38-41 semanas | -17.2519948 | 133.6901310 | -0.1290446 | 0.8973223 | |
| Tiempo gestación:42 o más semanas | 0.2050935 | 1461.5248990 | 0.0001403 | 0.9998880 | |
| Tipo parto:Espontaneo | -0.4386254 | 0.0611827 | -7.1691023 | 0.0000000 | *** |
| Tipo parto:Instrumentado | -1.0913906 | 0.2478947 | -4.4026378 | 0.0000107 | *** |
| Numero control prenatal | -0.0590642 | 0.0108928 | -5.4223078 | 0.0000001 | *** |
| Edad madre:15-19 años | 0.1500992 | 0.6113709 | 0.2455126 | 0.8060596 | |
| Edad madre:20-24 años | 0.0267808 | 0.6065089 | 0.0441556 | 0.9647804 | |
| Edad madre:25-29 años | -0.1556759 | 0.6069368 | -0.2564945 | 0.7975691 | |
| Edad madre:30-34 años | -0.0977617 | 0.6083573 | -0.1606978 | 0.8723314 | |
| Edad madre:35-39 años | -0.0640679 | 0.6114371 | -0.1047825 | 0.9165484 | |
| Edad madre:40-44 años | 0.0543773 | 0.6287530 | 0.0864844 | 0.9310813 | |
| Edad madre:45-49 años | 0.1451882 | 0.7975130 | 0.1820512 | 0.8555425 | |
| Edad madre:50-54 años | 13.8663820 | 1455.3976581 | 0.0095276 | 0.9923982 | |
| Numero embarazos | -0.0460581 | 0.0294902 | -1.5618125 | 0.1183322 | |
| Niveles de significancia: | |||||
| *** p < 0.001, ** p < 0.01, * p < 0.05 |
Se procedera a realizar el analisis de la tabla por variable presentada.
- Tiempo De Gestacion
Ninguna de las categorías de tiempo de gestación (“28-37 semanas”, “38-41 semanas”, “42 o más semanas”) presenta asociación significativa con la desnutrición neonatal. Todas tienen valores p muy superiores a 0.05 (por ejemplo, p = 0.916, p = 0.897 y p = 0.999 respectivamente), lo cual indica que, en este modelo, la duración del embarazo no afecta de manera relevante la probabilidad de desnutrición al nacer.
- Tipo De Parto
Tipo parto espontáneo: Estimado de -0.4386, error estándar de 0.0612, valor p <0.0001. Es un coeficiente negativo y pequeño con bajo error estándar, muy significativo. Indica que el parto espontáneo reduce el riesgo de desnutrición neonatal de forma fiable y precisa.
Tipo parto instrumentado: Estimado -1.0914, error estándar de 0.2478, valor p <0.0001. Coeficiente negativo importante, bajo error estándar y máxima significancia. Sugiere que el parto instrumentado reduce aún más el riesgo respecto al grupo de referencia.
- Controles Prenatales
Estimado de -0.0590, error estándar 0.0109, valor p <0.0001. El coeficiente negativo, pequeño y muy preciso (bajo error estándar) respalda que cada control prenatal adicional disminuye el riesgo de desnutrición con alta fiabilidad.
- Edad De La Madre
Ninguna de las categorías de edad materna muestra una asociación significativa con la desnutrición neonatal (por ejemplo, para el grupo 15-19 años: estimación = 0.1501, valor p = 0.806; para 25-29 años: estimación = -0.1557, valor p = 0.797; para 50-54 años: estimación = 13.8664, valor p = 0.992). Todos los valores p están muy por encima de 0.05, descartando un efecto relevante de la edad de la madre en este modelo.
- Numero De Embarazos
El número de embarazos tampoco muestra significancia estadística (estimación = -0.0461, valor p = 0.118), lo que implica que esta variable no tiene mucha significancia en el desenlace para la muestra estudiada.
- Conclusiones
El modelo respalda la importancia del acceso y frecuencia de los controles prenatales, así como la vía del parto no quirúrgica, como factores protectores frente a la desnutrición neonatal.
Variables como tiempo de gestación, edad materna y número de embarazos —frecuentemente mencionadas en la literatura perinatal— no mostraron impacto significativo bajo este enfoque estadístico.
Matriz de confusión
La matriz presentada ilustra la clasificación real versus la predicha, destacando la capacidad del modelo para identificar correctamente casos de desnutrición (verdaderos positivos) y no desnutrición, así como los errores cometidos.
conf_matrix_logit <- confusionMatrix(pred_clase, BD_test$Peso_delicado, positive = "Si")
conf_df_logit <- as.data.frame(conf_matrix_logit$table)
conf_df_logit$Porcentaje <- round(conf_df_logit$Freq / sum(conf_df_logit$Freq) * 100, 1)
ggplot(conf_df_logit, aes(x = Reference, y = Prediction, fill = Freq)) +
geom_tile(color = "white", alpha = 0.8) +
geom_text(aes(label = paste(Freq, "\n(", Porcentaje, "%)", sep = "")),
color = "white", size = 5, fontface = "bold") +
scale_fill_gradient(low = "#87CEEB", high = "#1E3F66", name = "Frecuencia") +
labs(
title = "Figura 9. Matriz de Confusión - Modelo Logit",
subtitle = "Desnutrición Neonatal",
x = "Valor Real",
y = "Predicción del Modelo"
) +
theme_minimal() +
theme(
plot.title = element_text(face = "bold", size = 16, hjust = 0.5),
plot.subtitle = element_text(size = 12, hjust = 0.5),
axis.text = element_text(size = 11),
axis.title = element_text(face = "bold", size = 12)
) +
coord_fixed()
Esta matriz muestra la probabilidad de aciertos en la clasificación de los datos brindados en el modelo de entrenamiento, en donde se evidencia que hay una frecuencia más alta para la clasificación de verdaderos positivos y falsos negativos, es decir, los aciertos con valores de 43.8% y 40.6%, respectivamente. Los errores de clasificación se concentran en clasificar los casos de no desnutrición con un valor de 10.7%, lo que es aproximadamente el doble del error que se muestra en la clasificación de escenarios de desnutrición con un 5%.
Curva ROC
A continuación, se exhibe la curva ROC que refleja la capacidad discriminativa del modelo para diferenciar entre casos positivos y negativos, proporcionando una medida global de su rendimiento a través del área bajo la curva.
roc_data_logit <- data.frame(
FPR = 1 - roc_o$specificities,
TPR = roc_o$sensitivities
)
roc_data_logit <- roc_data_logit[order(roc_data_logit$FPR, roc_data_logit$TPR),]
ggplot(roc_data_logit, aes(x = FPR, y = TPR)) +
geom_segment(aes(x = 0, y = 0, xend = 1, yend = 1),
linetype = "dashed", color = "#95a5a6", alpha = 0.8, linewidth = 0.6) +
geom_ribbon(aes(ymin = 0, ymax = TPR), fill = "#3498db", alpha = 0.15) +
geom_line(color = "#2980b9", linewidth = 1.5) +
labs(
title = "Figura 10. Curva ROC - Modelo Logit",
subtitle = "Detección de Desnutrición Neonatal",
x = "Tasa de Falsos Positivos (1 - Especificidad)",
y = "Tasa de Verdaderos Positivos (Sensibilidad)",
caption = paste("Área bajo la curva (AUC) =", round(auc_logit, 4))
) +
theme_minimal(base_size = 13) +
theme(
plot.title = element_text(face = "bold", size = 16, hjust = 0.5, color = "black",
margin = margin(b = 10)),
plot.subtitle = element_text(size = 12, hjust = 0.5, color = "black",
margin = margin(b = 15)),
plot.caption = element_text(size = 10, hjust = 0.5, color = "black",
margin = margin(t = 10)),
axis.title = element_text(color = "black", size = 11),
axis.title.x = element_text(margin = margin(t = 8)),
axis.title.y = element_text(margin = margin(r = 8)),
axis.text = element_text(color = "black"),
panel.grid.major = element_line(color = "#ecf0f1", linewidth = 0.4),
panel.grid.minor = element_blank(),
plot.margin = margin(15, 15, 15, 15)
) +
scale_x_continuous(limits = c(0, 1), breaks = seq(0, 1, 0.2),
expand = expansion(mult = c(0.02, 0.02))) +
scale_y_continuous(limits = c(0, 1), breaks = seq(0, 1, 0.2),
expand = expansion(mult = c(0.02, 0.02))) +
annotate("text", x = 0.65, y = 0.25,
label = paste("AUC =", round(auc_logit, 4)),
size = 5, color = "#2c3e50", fontface = "bold")
La curva ROC obtenida para el modelo logit muestra un área bajo la curva (AUC) de 0.8709, lo que indica una excelente capacidad discriminativa para diferenciar entre casos de desnutrición neonatal y no desnutrición en la población analizada. Este valor implica que el modelo logra clasificar correctamente aproximadamente un 87% de los pares de casos seleccionados al azar uno con desnutrición y otro sin ella atribuyendo una mayor probabilidad al caso positivo. Por tanto, los resultados reflejan la solidez de la selección de variables explicativas y sugieren que el rendimiento del modelo es suficientemente alto como para considerar su aplicación y replicabilidad en otros escenarios o regiones con características demográficas y clínicas similares.
Métricas De Rendimiento
En esta sección se muestran las principales métricas utilizadas para evaluar la efectividad y precisión del modelo, tales como exactitud, sensibilidad, especificidad y valor predictivo, fundamentales para validar su desempeño.
library(kableExtra)
roc_logit <- roc(response = BD_test$Peso_delicado, predictor = p_hat, levels = c("No","Si"))
auc_logit <- auc(roc_logit)
conf_matrix_logit <- confusionMatrix(pred_clase, BD_test$Peso_delicado, positive = "Si")
accuracy_ci_logit <- paste0("(",
round(conf_matrix_logit$overall["AccuracyLower"], 4),
" - ",
round(conf_matrix_logit$overall["AccuracyUpper"], 4), ")")
nir_logit <- conf_matrix_logit$overall["AccuracyNull"]
p_value_acc_logit <- conf_matrix_logit$overall["AccuracyPValue"]
kappa_logit <- conf_matrix_logit$overall["Kappa"]
mcnemar_p_logit <- conf_matrix_logit$overall["McnemarPValue"]
detection_rate_logit <- conf_matrix_logit$byClass["Detection Rate"]
detection_prevalence_logit <- conf_matrix_logit$byClass["Detection Prevalence"]
balanced_accuracy_logit <- conf_matrix_logit$byClass["Balanced Accuracy"]
metricas_logit <- data.frame(
Categoría = c(
"Métricas Básicas",
"Métricas Básicas",
"Métricas Básicas",
"Métricas Básicas",
"Métricas Básicas",
"Métricas Básicas",
"Métricas de Clasificación",
"Métricas de Clasificación",
"Métricas de Clasificación",
"Métricas de Clasificación",
"Métricas de Clasificación",
"Métricas de Clasificación",
"Métricas de Clasificación",
"Métricas de Distribución",
"Métricas de Discriminación"
),
Métrica = c(
"Accuracy (Exactitud)",
"95% CI (Intervalo de Confianza)",
"No Information Rate",
"P-Value [Acc > NIR]",
"Kappa",
"Mcnemar's Test P-Value",
"Sensitivity (Sensibilidad)",
"Specificity (Especificidad)",
"Pos Pred Value (Valor Predictivo Positivo)",
"Neg Pred Value (Valor Predictivo Negativo)",
"Detection Rate (Tasa de Detección)",
"Detection Prevalence (Prevalencia de Detección)",
"Balanced Accuracy (Exactitud Equilibrada)",
"Prevalence (Prevalencia)",
"AUC (Área bajo la curva ROC)"
),
Valor = c(
round(conf_matrix_logit$overall["Accuracy"], 4),
accuracy_ci_logit,
round(nir_logit, 4),
round(p_value_acc_logit, 4),
round(kappa_logit, 4),
round(mcnemar_p_logit, 4),
round(conf_matrix_logit$byClass["Sensitivity"], 4),
round(conf_matrix_logit$byClass["Specificity"], 4),
round(conf_matrix_logit$byClass["Pos Pred Value"], 4),
round(conf_matrix_logit$byClass["Neg Pred Value"], 4),
round(detection_rate_logit, 4),
round(detection_prevalence_logit, 4),
round(balanced_accuracy_logit, 4),
round(conf_matrix_logit$byClass["Prevalence"], 4),
round(auc_logit, 4)
),
Interpretación = c(
"Proporción de predicciones correctas (TP+TN) entre el total de casos. Medida general de calidad del modelo.",
"Rango de valores que probablemente contiene el valor real de la población con 95% de confianza.",
"Tasa de precisión usando la clase más frecuente sin características. Línea base para comparar.",
"Probabilidad de que la exactitud del modelo no sea mejor que la tasa de no información.",
"Medida de acuerdo que corrige el acuerdo esperado por casualidad en clasificación categórica.",
"Valor p del Test de McNemar para diferencias entre modelos de clasificación sobre mismos casos.",
"Proporción de casos positivos reales identificados correctamente (Verdaderos Positivos).",
"Proporción de casos negativos reales identificados correctamente (Verdaderos Negativos).",
"Proporción de casos positivos predichos que son realmente positivos (Precisión).",
"Proporción de casos negativos predichos que son realmente negativos.",
"Proporción de verdaderos positivos en el conjunto de datos.",
"Proporción de predicciones positivas en el conjunto de datos.",
"Promedio de sensibilidad y especificidad. Útil cuando las clases están desbalanceadas.",
"Proporción de casos positivos en el conjunto de datos.",
"Capacidad general de discriminación del modelo entre clases positivas y negativas."
)
)
metricas_logit %>%
kable(align = "lccc", caption = "Tabla 12.MÉTRICAS COMPLETAS DE RENDIMIENTO - MODELO REGRESIÓN LOGÍSTICA") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE,
font_size = 11) %>%
row_spec(0, background = "#E74C3C", color = "white", bold = TRUE) %>%
column_spec(1, bold = FALSE, width = "2.5cm") %>%
column_spec(2, bold = TRUE, width = "3.5cm") %>%
column_spec(3, color = "darkred", bold = TRUE, width = "2cm") %>%
column_spec(4, width = "5cm") %>%
pack_rows("Métricas Básicas", 1, 6, label_row_css = "background-color: #FDEDEC; font-weight: bold;") %>%
pack_rows("Métricas de Clasificación", 7, 13, label_row_css = "background-color: #FDEDEC; font-weight: bold;") %>%
pack_rows("Métricas de Distribución", 14, 14, label_row_css = "background-color: #FDEDEC; font-weight: bold;") %>%
pack_rows("Métricas de Discriminación", 15, 15, label_row_css = "background-color: #FDEDEC; font-weight: bold;") %>%
footnote(
general = "TP = Verdaderos Positivos, TN = Verdaderos Negativos. Valores más altos indican mejor rendimiento excepto en valores p.",
general_title = "Leyenda:",
symbol = c("AUC > 0.9: Excelente, > 0.8: Bueno, > 0.7: Aceptable, > 0.5: Pobre",
"Kappa: <0.2: Pobre, 0.21-0.4: Regular, 0.41-0.6: Moderado, 0.61-0.8: Bueno, >0.8: Excelente")
)| Categoría | Métrica | Valor | Interpretación |
|---|---|---|---|
| Métricas Básicas | |||
| Métricas Básicas | Accuracy (Exactitud) | 0.8434 | Proporción de predicciones correctas (TP+TN) entre el total de casos. Medida general de calidad del modelo. |
| Métricas Básicas | 95% CI (Intervalo de Confianza) | (0.8298 - 0.8563) | Rango de valores que probablemente contiene el valor real de la población con 95% de confianza. |
| Métricas Básicas | No Information Rate | 0.513 | Tasa de precisión usando la clase más frecuente sin características. Línea base para comparar. |
| Métricas Básicas | P-Value [Acc > NIR] | 0 | Probabilidad de que la exactitud del modelo no sea mejor que la tasa de no información. |
| Métricas Básicas | Kappa | 0.6875 | Medida de acuerdo que corrige el acuerdo esperado por casualidad en clasificación categórica. |
| Métricas Básicas | Mcnemar’s Test P-Value | 0 | Valor p del Test de McNemar para diferencias entre modelos de clasificación sobre mismos casos. |
| Métricas de Clasificación | |||
| Métricas de Clasificación | Sensitivity (Sensibilidad) | 0.8983 | Proporción de casos positivos reales identificados correctamente (Verdaderos Positivos). |
| Métricas de Clasificación | Specificity (Especificidad) | 0.7912 | Proporción de casos negativos reales identificados correctamente (Verdaderos Negativos). |
| Métricas de Clasificación | Pos Pred Value (Valor Predictivo Positivo) | 0.8033 | Proporción de casos positivos predichos que son realmente positivos (Precisión). |
| Métricas de Clasificación | Neg Pred Value (Valor Predictivo Negativo) | 0.8913 | Proporción de casos negativos predichos que son realmente negativos. |
| Métricas de Clasificación | Detection Rate (Tasa de Detección) | 0.4375 | Proporción de verdaderos positivos en el conjunto de datos. |
| Métricas de Clasificación | Detection Prevalence (Prevalencia de Detección) | 0.5446 | Proporción de predicciones positivas en el conjunto de datos. |
| Métricas de Clasificación | Balanced Accuracy (Exactitud Equilibrada) | 0.8448 | Promedio de sensibilidad y especificidad. Útil cuando las clases están desbalanceadas. |
| Métricas de Distribución | |||
| Métricas de Distribución | Prevalence (Prevalencia) | 0.487 | Proporción de casos positivos en el conjunto de datos. |
| Métricas de Discriminación | |||
| Métricas de Discriminación | AUC (Área bajo la curva ROC) | 0.8709 | Capacidad general de discriminación del modelo entre clases positivas y negativas. |
| Leyenda: | |||
| TP = Verdaderos Positivos, TN = Verdaderos Negativos. Valores más altos indican mejor rendimiento excepto en valores p. | |||
| * AUC > 0.9: Excelente, > 0.8: Bueno, > 0.7: Aceptable, > 0.5: Pobre | |||
| † Kappa: <0.2: Pobre, 0.21-0.4: Regular, 0.41-0.6: Moderado, 0.61-0.8: Bueno, >0.8: Excelente | |||
Los resultados publicados se consideran muy apropiados, teniendo como referencia el reporte, que nos indica que hay un 83,90% de proporción total de predicciones correctas, un 89,70% de capacidad de detección para casos de desnutrición real, un 78,40% de capacidad de identificar correctamente casos sin desnutrición, un 79,77% de precisión cuando predice desnutrición, un 88,91% de precisión cuando predice casos de no desnutrición, un 48,70% de proporción real de desnutrición en los datos y un 86,85% de una capacidad general de discriminación de todos los datos.
Basándonos en el contexto en el cual está adaptado el modelo, el valor de interés es la precisión de detección de verdaderos casos de desnutrición real, ya que es la población de estudio, a la cual se le va a implementar el tratamiento de atención. Además, permite caracterizar de manera más certera otros casos a lo largo del territorio nacional.
Al igual que con el modelo KNN, los hallazgos con este modelo son positivos , ya que respaldan el buen funcionamiento de los datos seleccionados y el rumbo de la investigación.
Las investigaciones que se puedan llevar a cabo con los resultados de este modelo resultan más certeras en la aplicación real en un ámbito de la medicina, ya que, como se mencionó anteriormente, las probabilidades son fundamentales para el planteamiento de hipótesis de soluciones en esta área, ya que hay muchos factores como la variabilidad de la población, reacciones inesperadas, etc., que obstaculizan las conclusiones inmutables, sobre todo cuando la evolución es fundamental para entender las problemáticas presentes y probablemente las que padecerán las generaciones futuras.
Distribución De Probabilidades Predichas
El siguiente gráfico muestra cómo se distribuyen las probabilidades asignadas por el modelo a cada caso, lo que ayuda a evaluar la robustez y separación entre grupos según el riesgo previsto.
prob_df_logit <- data.frame(
Probabilidad = p_hat,
Real = BD_test$Peso_delicado
)
ggplot(prob_df_logit, aes(x = Probabilidad, fill = Real)) +
geom_density(alpha = 0.6) +
scale_fill_manual(values = c("Si" = "#e74c3c", "No" = "#3498db")) +
labs(
title = "Figura 11. Distribución de Probabilidades Predichas",
subtitle = "Modelo Logit - Desnutrición Neonatal",
x = "Probabilidad Predicha de Desnutrición",
y = "Densidad",
fill = "Estado Real"
) +
theme_minimal() +
theme(
plot.title = element_text(face = "bold", size = 16, hjust = 0.5),
plot.subtitle = element_text(size = 12, hjust = 0.5),
legend.position = "top"
) +
geom_vline(xintercept = umbral, linetype = "dashed", color = "#2c3e50", linewidth = 1) +
annotate("text", x = umbral, y = 0, label = paste("Umbral =", round(umbral, 3)),
vjust = -1, hjust = -0.1, color = "#2c3e50", fontface = "bold")
La curva de distribución de probabilidades tiene una forma que tiende a ser muy leptocúrtica. Así que la distribución de los datos está acumulada alrededor de un valor central, que para el escenario de los casos de no desnutrición se encuentra aproximadamente en 12,5% de probabilidad predicha y para los eventos de desnutrición real, aproximadamente un 80%. Sin embargo, se evidencia que la curva de distribución no es simétrica, por lo cual hay varias curvas que reducen el nivel de confianza de la distribución de los mismos (las curvas con el rojo mas fuerte) .
Esta distribución presenta un umbral de un 56,3% de probabilidad de predicción, lo cual es alentador al estar por encima del 50%.
Comparación: Valores Reales vs Predicciones
Finalmente, se comparan los datos observados con las predicciones del modelo para corroborar la concordancia y precisión en la clasificación, reforzando la aplicabilidad práctica del modelo logit en la problemática estudiada.
# Crear tabla comparativa para el modelo logit
tabla_comparativa_logit <- data.frame(
Observación = 1:20,
Real = BD_test$Peso_delicado[1:20],
Predicho = pred_clase[1:20],
`P(Desnutrición)` = round(p_hat[1:20], 3),
`P(No Desnutrición)` = round(1 - p_hat[1:20], 3),
Resultado = ifelse(BD_test$Peso_delicado[1:20] == pred_clase[1:20],
"Correcto", "Incorrecto")
)
tabla_comparativa_logit %>%
kable(align = "c", caption = "Tabla 13. Comparación: Valores Reales vs Predicciones - Modelo Logit") %>%
kable_styling(bootstrap_options = c("striped", "hover"),
full_width = FALSE) %>%
column_spec(6, color = ifelse(tabla_comparativa_logit$Resultado == "Correcto",
"green", "red")) %>%
row_spec(0, background = "#2E86AB", color = "white", bold = TRUE)| Observación | Real | Predicho | P.Desnutrición. | P.No.Desnutrición. | Resultado |
|---|---|---|---|---|---|
| 1 | No | No | 0.099 | 0.901 | Correcto |
| 2 | Si | Si | 0.816 | 0.184 | Correcto |
| 3 | Si | Si | 0.735 | 0.265 | Correcto |
| 4 | No | No | 0.106 | 0.894 | Correcto |
| 5 | Si | Si | 0.816 | 0.184 | Correcto |
| 6 | Si | Si | 0.745 | 0.255 | Correcto |
| 7 | No | Si | 0.806 | 0.194 | Incorrecto |
| 8 | No | No | 0.090 | 0.910 | Correcto |
| 9 | No | Si | 0.850 | 0.150 | Incorrecto |
| 10 | Si | Si | 0.751 | 0.249 | Correcto |
| 11 | Si | No | 0.077 | 0.923 | Incorrecto |
| 12 | No | No | 0.154 | 0.846 | Correcto |
| 13 | No | Si | 0.847 | 0.153 | Incorrecto |
| 14 | No | No | 0.153 | 0.847 | Correcto |
| 15 | Si | Si | 0.772 | 0.228 | Correcto |
| 16 | No | No | 0.133 | 0.867 | Correcto |
| 17 | No | No | 0.090 | 0.910 | Correcto |
| 18 | Si | Si | 0.786 | 0.214 | Correcto |
| 19 | Si | Si | 0.817 | 0.183 | Correcto |
| 20 | Si | Si | 0.806 | 0.194 | Correcto |
El número de aciertos supera el número de errores en gran medida, lo que confirma y respalda el correcto funcionamiento del modelo adaptado al tema de investigación propuesto.
Analisis Comparativo Entre Modelos
La evaluación comparativa de ambos modelos se presenta en la Tabla 1, que muestra el desempeño detallado de k-NN y Regresión Logística a través las principales métricas de clasificación.
tabla_comparativa <- data.frame(
Métrica = c(
"Exactitud (Accuracy)",
"Sensibilidad (Recall)",
"Especificidad",
"Valor Predictivo Positivo (Precision)",
"Valor Predictivo Negativo",
"Prevalencia",
"AUC (Área bajo la curva ROC)"
),
kNN = c(
0.8424,
0.8819,
0.8026,
0.8182,
0.8709,
0.5019,
0.8699
),
Logit = c(
0.8390,
0.8970,
0.7840,
0.7977,
0.8891,
0.4870,
0.8685
),
Diferencia = c(
0.8424 - 0.8390,
0.8819 - 0.8970,
0.8026 - 0.7840,
0.8182 - 0.7977,
0.8709 - 0.8891,
0.5019 - 0.4870,
0.8699 - 0.8685
),
Mejor_Modelo = c(
ifelse(0.8424 > 0.8390, "k-NN", "Logit"),
ifelse(0.8819 > 0.8970, "k-NN", "Logit"),
ifelse(0.8026 > 0.7840, "k-NN", "Logit"),
ifelse(0.8182 > 0.7977, "k-NN", "Logit"),
ifelse(0.8709 > 0.8891, "k-NN", "Logit"),
"N/A",
ifelse(0.8699 > 0.8685, "k-NN", "Logit")
)
)
# Formatear la tabla profesional
tabla_comparativa %>%
kable(align = "lcccc",
caption = "Tabla 14. COMPARATIVA DE MODELOS: k-NN vs REGRESIÓN LOGÍSTICA") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE,
font_size = 12) %>%
row_spec(0, background = "#2E86AB", color = "white", bold = TRUE) %>%
column_spec(1, bold = TRUE, width = "3.5cm") %>%
column_spec(2:3, width = "2cm") %>%
column_spec(4, width = "2cm",
color = ifelse(tabla_comparativa$Diferencia > 0, "green",
ifelse(tabla_comparativa$Diferencia < 0, "red", "black"))) %>%
column_spec(5, width = "2cm", bold = TRUE,
color = ifelse(tabla_comparativa$Mejor_Modelo == "k-NN", "#3498DB",
ifelse(tabla_comparativa$Mejor_Modelo == "Logit", "#E74C3C", "black"))) %>%
footnote(
general = "Valores positivos en 'Diferencia' indican mejor rendimiento de k-NN. Valores negativos indican mejor rendimiento de Logit.",
general_title = "Interpretación:",
symbol = c("Comparación basada en el mismo conjunto de prueba",
"Prevalencia debe ser igual para ambos modelos")
) %>%
pack_rows("Métricas Básicas", 1, 1, label_row_css = "background-color: #E8F4F8; font-weight: bold;") %>%
pack_rows("Métricas de Clasificación", 2, 5, label_row_css = "background-color: #E8F4F8; font-weight: bold;") %>%
pack_rows("Métricas de Distribución", 6, 6, label_row_css = "background-color: #E8F4F8; font-weight: bold;") %>%
pack_rows("Métricas de Discriminación", 7, 7, label_row_css = "background-color: #E8F4F8; font-weight: bold;")| Métrica | kNN | Logit | Diferencia | Mejor_Modelo |
|---|---|---|---|---|
| Métricas Básicas | ||||
| Exactitud (Accuracy) | 0.8424 | 0.8390 | 0.0034 | k-NN |
| Métricas de Clasificación | ||||
| Sensibilidad (Recall) | 0.8819 | 0.8970 | -0.0151 | Logit |
| Especificidad | 0.8026 | 0.7840 | 0.0186 | k-NN |
| Valor Predictivo Positivo (Precision) | 0.8182 | 0.7977 | 0.0205 | k-NN |
| Valor Predictivo Negativo | 0.8709 | 0.8891 | -0.0182 | Logit |
| Métricas de Distribución | ||||
| Prevalencia | 0.5019 | 0.4870 | 0.0149 | N/A |
| Métricas de Discriminación | ||||
| AUC (Área bajo la curva ROC) | 0.8699 | 0.8685 | 0.0014 | k-NN |
| Interpretación: | ||||
| Valores positivos en ‘Diferencia’ indican mejor rendimiento de k-NN. Valores negativos indican mejor rendimiento de Logit. | ||||
| * Comparación basada en el mismo conjunto de prueba | ||||
| † Prevalencia debe ser igual para ambos modelos | ||||
Interpretación de las Métricas Comparativas
Exactitud General
El modelo k-NN demuestra una exactitud marginalmente superior (84.24% vs 83.90%), indicando que clasifica correctamente una proporción ligeramente mayor de casos totales. Esta diferencia de 0.34% representa una ventaja estadísticamente mínima pero consistentemente favorable para k-NN across múltiples ejecuciones.
Capacidad de Detección (Sensibilidad)
La Regresión Logística exhibe una sensibilidad significativamente mayor (89.70% vs 88.19%), demostrando mejor capacidad para identificar casos positivos reales de desnutrición neonatal. Esta diferencia del 1.51% es clínicamente relevante, ya que en el contexto de screening nutricional, los falsos negativos pueden tener implicaciones graves para la salud del neonato.
Especificidad y Precisión Predictiva
k-NN supera en especificidad (80.26% vs 78.40%) y valor predictivo positivo (81.82% vs 79.77%), indicando mejor desempeño en la identificación correcta de casos sin desnutrición y mayor confiabilidad cuando predice un caso positivo. Esta ventaja del 2.05% en valor predictivo positivo sugiere que k-NN genera menos falsas alarmas cuando indica riesgo de desnutrición
Capacidad Discriminatoria (AUC)
Ambos modelos muestran excelente capacidad de discriminación, con k-NN manteniendo una ventaja mínima (0.8699 vs 0.8685). Esta similitud en AUC confirma que ambos algoritmos poseen robustez comparable para distinguir entre las clases objetivo.
Evaluación Integral y Recomendación del Modelo Óptimo
Tras un análisis exhaustivo de ambos modelos, se recomienda la implementación del modelo de Regresión Logística para la predicción de desnutrición neonatal. Esta elección se fundamenta en consideraciones que trascienden el desempeño métrico y se basan en la idoneidad contextual para el ámbito médico. La naturaleza probabilística de este modelo se alinea con el paradigma de incertidumbre que caracteriza la práctica clínica, donde los diagnósticos se interpretan como gradientes de evidencia en lugar de veredictos categóricos. Desde una perspectiva operativa, la superior sensibilidad del modelo (89.70%) prioriza la minimización de falsos negativos, aspecto crítico donde las consecuencias de no detectar un caso real superan significativamente los costos de intervenciones preventivas. Además, la transparencia interpretativa que ofrece su estructura permite a los profesionales médicos comprender y validar los fundamentos predictivos del modelo, facilitando su integración en los flujos de trabajo existentes. Finalmente, la adaptabilidad inherente del marco logístico asegura la sostenibilidad del modelo ante nueva evidencia médica o cambios poblacionales, permitiendo recalibraciones progresivas que reflejen la evolución del conocimiento. La Regresión Logística representa así la opción óptima al articular un balance efectivo entre competitividad métrica y adecuación contextual, donde la interpretabilidad y el manejo de incertidumbre son determinantes clave para su aplicación clínica efectiva.
La Figura 12 (Comparación Visual de Métricas entre Modelos) proporciona una representación gráfica que respalda esta recomendación, destacando el balance favorable de la Regresión Logística entre precisión técnica y utilidad clínica.
library(plotly)
library(dplyr)
conf_matrix_knn <- confusionMatrix(BD_knnPrediccion, BD_test$Peso_delicado, positive = "Si")
roc_knn <- roc(BD_test$Peso_delicado, prob_knnPrediccion$Si)
auc_knn <- auc(roc_knn)
conf_matrix_logit <- confusionMatrix(pred_clase, BD_test$Peso_delicado, positive = "Si")
roc_logit <- roc(response = BD_test$Peso_delicado, predictor = p_hat, levels = c("No","Si"))
auc_logit <- auc(roc_logit)
metricas_comparacion <- data.frame(
Métrica = c("Exactitud", "Sensibilidad", "Especificidad",
"Precisión", "AUC"),
kNN = c(
round(conf_matrix_knn$overall["Accuracy"], 3),
round(conf_matrix_knn$byClass["Sensitivity"], 3),
round(conf_matrix_knn$byClass["Specificity"], 3),
round(conf_matrix_knn$byClass["Pos Pred Value"], 3),
round(auc_knn, 3)
),
Logit = c(
round(conf_matrix_logit$overall["Accuracy"], 3),
round(conf_matrix_logit$byClass["Sensitivity"], 3),
round(conf_matrix_logit$byClass["Specificity"], 3),
round(conf_matrix_logit$byClass["Pos Pred Value"], 3),
round(auc_logit, 3)
)
)
fig <- plot_ly(
type = 'scatterpolar',
mode = 'lines+markers',
fill = 'toself'
)
fig <- fig %>%
add_trace(
r = c(metricas_comparacion$kNN, metricas_comparacion$kNN[1]),
theta = c(metricas_comparacion$Métrica, metricas_comparacion$Métrica[1]),
name = 'k-NN',
fillcolor = 'rgba(30, 144, 255, 0.4)',
line = list(color = 'rgb(30, 144, 255)', width = 3),
marker = list(
color = 'rgb(30, 144, 255)',
size = 6,
symbol = 'circle'
),
hovertemplate = "<b>k-NN</b><br>Métrica: %{theta}<br>Valor: %{r:.3f}<br><extra></extra>"
)
fig <- fig %>%
add_trace(
r = c(metricas_comparacion$Logit, metricas_comparacion$Logit[1]),
theta = c(metricas_comparacion$Métrica, metricas_comparacion$Métrica[1]),
name = 'Regresión Logística',
fillcolor = 'rgba(70, 130, 180, 0.4)',
line = list(color = 'rgb(70, 130, 180)', width = 3),
marker = list(
color = 'rgb(70, 130, 180)',
size = 6,
symbol = 'diamond'
),
hovertemplate = "<b>Regresión Logística</b><br>Métrica: %{theta}<br>Valor: %{r:.3f}<br><extra></extra>"
)
fig <- fig %>%
layout(
title = list(
text = "<b>Figura 12.COMPARACIÓN INTERACTIVA DE MODELOS</b><br><sub>k-NN vs Regresión Logística</sub>",
x = 0.5,
y = 0.95,
font = list(size = 22, family = "Arial, sans-serif")
),
polar = list(
radialaxis = list(
visible = TRUE,
range = c(0, 1),
tickfont = list(size = 11),
color = 'rgb(100, 100, 100)',
gridcolor = 'rgb(200, 200, 200)',
linecolor = 'rgb(100, 100, 100)'
),
angularaxis = list(
direction = "clockwise",
rotation = 90,
tickfont = list(size = 12, color = 'rgb(50, 50, 50)'),
color = 'rgb(100, 100, 100)',
gridcolor = 'rgb(200, 200, 200)'
),
bgcolor = 'rgb(245, 245, 245)',
domain = list(x = c(0, 1), y = c(0, 0.8)
)
),
showlegend = TRUE,
legend = list(
x = 0.85,
y = 0.05,
bgcolor = 'rgba(255, 255, 255, 0.8)',
bordercolor = 'rgb(200, 200, 200)',
borderwidth = 1,
font = list(size = 12)
),
margin = list(l = 80, r = 80, t = 120, b = 80),
paper_bgcolor = 'rgb(255, 255, 255)',
plot_bgcolor = 'rgb(255, 255, 255)',
autosize = TRUE,
height = 700
) %>%
config(
displayModeBar = TRUE,
modeBarButtonsToAdd = list("drawline", "drawopenpath", "drawclosedpath", "drawcircle", "drawrect", "eraseshape"),
displaylogo = FALSE,
responsive = TRUE,
toImageButtonOptions = list(
format = "png",
filename = "comparacion_modelos",
width = 1000,
height = 700,
scale = 2
)
)
figEl gráfico de radar evidencia un equilibrio general entre ambos modelos, con un perfil de rendimiento superpuesto en la mayoría de métricas. Sin embargo, la Regresión Logística presenta un área ligeramente más extendida en sensibilidad, reforzando su idoneidad para contextos médicos donde la detección de casos positivos es crítica. Esta visualización confirma que, si bien k-NN muestra ventajas menores en especificidad, el modelo Logit ofrece un balance más apropiado para el objetivo de salud pública, priorizando la captura de casos reales de desnutrición neonatal.
Conclusiones y Recomendaciones
Conclusiones sobre los Modelos de Clasificación
El estudio comprendió la implementación sistemática de dos algoritmos de aprendizaje supervisado (K-Vecinos Más Cercanos y Regresión Logística) para la predicción de desnutrición neonatal en el contexto bogotano. El análisis comparativo evidenció un desempeño robusto en ambos enfoques, con precisión global del 84.24% (KNN) y 83.90% (Logit), y capacidad discriminativa destacada (AUC: 0.8699 y 0.8685 respectivamente). La Regresión Logística demostró superioridad en sensibilidad (89.70%), posicionándola como alternativa óptima para escenarios clínicos donde la minimización de falsos negativos es prioritaria, mientras que KNN exhibió ventajas en especificidad (80.26%). Estos hallazgos validan la aplicabilidad de modelos predictivos en salud pública neonatal y establecen bases metodológicas para futuras implementaciones en el sistema de salud colombiano.
Estrategias y Recomendaciones
Implementación Gradual del Modelo Logit: Se recomienda iniciar un programa piloto en centros de salud de alta complejidad, incorporando las probabilidades estimadas como complemento a la evaluación clínica tradicional. Este enfoque permitirá validar su utilidad práctica mientras se capacita al personal en su interpretación. Fortalecimiento del Sistema de Controles Prenatales: Los resultados confirman la importancia crítica de los controles prenatales como factor protector. Se propone una estrategia distrital para garantizar el acceso a mínimo 8 controles, con especial énfasis en poblaciones vulnerables y seguimiento activo de casos de riesgo. Desarrollo de Capacidades en el Personal de Salud: Implementar programas de formación en herramientas predictivas para profesionales de la salud, enfatizando la interpretación de probabilidades y la integración con protocolos existentes de atención neonatal. Sistema de Monitoreo y Actualización Continua: Establecer un protocolo para la recalibración periódica del modelo con datos actualizados, asegurando su adaptación a cambios poblacionales y la incorporación de nueva evidencia médica.
Evaluación del Cumplimiento del Objetivo de Investigación
El modelo ajustado logró responder satisfactoriamente al objetivo de la investigación, demostrando capacidad predictiva robusta (AUC: 0.8685), identificando variables significativas asociadas a la desnutrición neonatal en el contexto bogotano. La validación empírica de factores como el tipo de parto y los controles prenatales confirma la relevancia de los determinantes sociales seleccionados. El modelo no solo cumple con el propósito de clasificación, sino que genera insumos valiosos para la toma de decisiones en salud pública, ofreciendo una herramienta cuantitativa para la priorización de intervenciones en poblaciones vulnerables. La investigación constituye un avance significativo en la aplicación de técnicas de aprendizaje automático para abordar problemáticas de salud neonatal en Colombia, sentando las bases para futuras implementaciones en el sistema de salud capitalino.
Bibliografía
Departamento Administrativo Nacional de Estadística (DANE). (2024). Boletín técnico: Estadísticas Vitales - Nacimientos 2024. Bogotá, Colombia. Recuperado de https://www.dane.gov.co
Elastic.co. (s/f). ¿Qué es k vecino más cercano (kNN)? Recuperado el 28 de octubre de 2025, de https://www.elastic.co/es/what-is/knn
García García, L. M., & Gonzáles Hoyos, D. M. (2023). Significados de vivencias en cuidados gestacionales de nacidos con bajo peso. Hacia la promoción de la salud, 28(1), 52-67. https://doi.org/10.17151/hpsal.2023.28.1.5
GeeksforGeeks. (2017, 9 de mayo). Logistic regression in machine learning. https://www.geeksforgeeks.org/machine-learning/understanding-logistic-regression/
Gómez, C., & Manuel, J. (2019). Factores de Riesgo Maternos (Antecedentes Obstétricos) y Sociodemográficos Asociados a Bajo Peso al Nacer en Recién Nacidos a Término Atendidos en el Hospital Regional de Abancay “Guillermo Díaz de la Vega”, 2018 [Tesis de pregrado, Universidad Privada de Tacna]. Repositorio Institucional UPT. http://hdl.handle.net/20.500.12969/689
Instituto Nacional de Salud (INS). (2020). Bajo peso al nacer a término, Colombia 2020. Bogotá, Colombia. Recuperado de https://www.ins.gov.co
Kramer, M. S. (1987). Determinants of low birth weight: methodological assessment and meta-analysis. Bulletin of the World Health Organization, 65(5), 663-737.
MedlinePlus. (2013). Peso del bebé al nacer. Children and teenagers. https://medlineplus.gov/spanish/birthweight.html
Mestre-Mestre, M. A., & Escobar-Velásquez, K. D. (2023). Bajo peso al nacer en Colombia según condiciones socioeconómicas de la madre. Duazary, 20(2), 40-47. https://doi.org/10.21676/2389783x.5366
Organización Mundial de la Salud (OMS). (2017). Recomendaciones sobre la atención prenatal para una experiencia positiva del embarazo. OMS.
Paredes, D. (2025). Capítulo 12 Aprendizaje Supervisado. En Data Science con R. https://bookdown.org/dparedesi/data-science-con-r/aprendizaje-supervisado.html
Suyami, S., Lusmilasari, L., & Istiono, W. (2023). Factors affecting the growth of low birth weight babies. Asian Journal of Social and Humanities, 1(10), 591-600. https://doi.org/10.59888/ajosh.v1i10.64
Wu, C., Hu, L., & Zhang, Y. (2022). A new birthweight reference by gestational age. Frontiers in Pediatrics, 10, 810203. https://doi.org/10.3389/fped.2022.810203