Análisis de parto por cesárea de mujeres en Colombia
Luis Fernando Gomez - 2180090-3751
Wilson Jair Gonzalez - 2124832-3751
Andrés Felipe Ordóñez - 2182084-3751
Carlos Daniel Quilindo - 2240722-3751
2025-10-29
Introducción.
En Colombia, desde el año 2015 hasta la actualidad, se ha evidenciado un aumento progresivo en las tasas de partos por cesárea, una tendencia que ha despertado preocupación en el ámbito médico y de salud pública. Según Zuleta (2023), este incremento ha sido particularmente notorio en mujeres mayores de edad, quienes presentan una mayor propensión a este tipo de intervención obstétrica.
La médicina ha descubirto que las mujeres con edad materna avanzada (mayores de 35 años) conforman un grupo con mayor riesgo de parto por cesárea, debido a factores tanto biológicos como clínicos. En efecto, un estudio realizado en Colombia entre 2011 y 2015 determinó que el 49,8 % de las mujeres mayores de 35 años tuvieron parto por cesárea durante ese periodo (Ospina, 2016).
No obstante, aunque la edad materna es un factor ampliamente reconocido, otros determinantes como el peso y la talla del recién nacido, la edad gestacional o el número de embarazos también podrían influir en la probabilidad de una cesárea. Sin embargo, la relación entre estas variables no siempre resulta evidente y puede variar según las condiciones sociodemográficas y clínicas de la población.
Por ello, surge la siguiente problemática:
¿Qué factores influyen de manera significativa en la probabilidad de que un parto sea por cesárea en Colombia?
Y, en particular, ¿cómo inciden variables como el peso del recién nacido, el tiempo de gestación, la talla al nacer y el número de embarazos sobre esta probabilidad?
Para responder a estos interrogantes, se emplea un modelo de regresión logística binaria que toma como variable dependiente Y_CESAREA (donde 1 representa parto por cesárea y 0 parto natural), con el fin de identificar los factores que aumentan o disminuyen la probabilidad de cesárea en una muestra de nacimientos del año 2017.
Variables
Variable dependiente binaria:
Y_CESAREA: Se escojio la variable 1 si es parto por cesarea, 0 si no es parto por cesarea.
Se busca evaluar los factores asociados al aumento del riesgo de cesárea en mujeres de edad avanzada, específicamente en los grupos etarios comprendidos entre 35 y 54 años, considerando además variables relevantes del recién nacido como peso, talla, número de embarazos previos y tiempo de gestación.
Variables independientes:
PESO_NAC: Peso del nacido en kilogramos
- 1 = Menos de 1000
- 2 = 1000 - 1499
- 3 = 1500 - 1999
- 4 = 2000 - 2499
- 5 = 2500 - 2999
- 6 = 3000 - 3499
- 7 = 3500 - 3999
- 8 = 4000 y más
- 9 = Sin información
T_GES: Tiempo de gestación del nacido vivo (en
semanas)
- 1 = Menos de 22
- 2 = De 22 a 27
- 3 = De 28 a 37
- 4 = De 38 a 41
- 5 = De 42 y más
- 6 = Ignorado
- 9 = Sin información
N_EMB: Número de embarazos incluyendo el actual (1–99)
TALLA_NAC: Talla del nacido
- 1 = Menos de 20
- 2 = 20–29
- 3 = 30–39
- 4 = 40–49
- 5 = 50–59
- 6 = 60 y más
- 9 = Sin información
GRUPO_EDAD: Rango de edad de la madre (en
años)
- 6 = 35–39 años
- 7 = 40–44 años
- 8 = 45–49 años
- 9 = 50–54 años
Codigo librerias, variables
library(readr)
nac2017 <- read_csv("Datos/nac2017.csv")
names(nac2017)## [1] "COD_DPTO" "COD_MUNIC" "AREANAC" "SIT_PARTO"
## [5] "OTRO_SIT" "SEXO" "PESO_NAC" "TALLA_NAC"
## [9] "ANO" "MES" "ATEN_PAR" "T_GES"
## [13] "T_GES_AGRU_CIE" "NUMCONSUL" "TIPO_PARTO" "MUL_PARTO"
## [17] "APGAR1" "APGAR2" "IDHEMOCLAS" "IDFACTORRH"
## [21] "IDPERTET" "EDAD_MADRE" "EST_CIVM" "NIV_EDUM"
## [25] "ULTCURMAD" "CODPRES" "CODPTORE" "CODMUNRE"
## [29] "AREA_RES" "N_HIJOSV" "FECHA_NACM" "N_EMB"
## [33] "SEG_SOCIAL" "IDCLASADMI" "EDAD_PADRE" "NIV_EDUP"
## [37] "ULTCURPAD" "PROFESION"Medias
Aqui comparamos las medias de nuestras variables cuando hay o no cesarea
library(tidyverse)
DF <- nac2017 %>%
mutate(
Y_CESAREA = case_when(
TIPO_PARTO == 2 ~ 1,
TIPO_PARTO %in% c(1, 3) ~ 0,
TRUE ~ NA_real_) )
BN1 <- DF %>%
select(Y_CESAREA, PESO_NAC, EDAD_MADRE, T_GES, N_EMB, TALLA_NAC) %>%
filter(EDAD_MADRE %in% c(6, 7, 8, 9))
BN <- BN1 %>%
filter(
!is.na(Y_CESAREA),
!is.na(PESO_NAC),
!is.na(EDAD_MADRE),
!is.na(T_GES),
!is.na(N_EMB),
!is.na(TALLA_NAC)
) %>%
group_by(EDAD_MADRE) %>%
slice_head(n = 1000) %>%
ungroup() %>%
mutate(
GRUPO_EDAD = case_when(
EDAD_MADRE == 6 ~ "35-39 años",
EDAD_MADRE == 7 ~ "40-44 años",
EDAD_MADRE == 8 ~ "45-49 años",
EDAD_MADRE == 9 ~ "50-54 años",
TRUE ~ "Otro" ) )
BN## # A tibble: 3,146 × 7
## Y_CESAREA PESO_NAC EDAD_MADRE T_GES N_EMB TALLA_NAC GRUPO_EDAD
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <chr>
## 1 0 5 6 4 2 4 35-39 años
## 2 1 6 6 4 4 5 35-39 años
## 3 0 7 6 4 3 5 35-39 años
## 4 0 6 6 4 3 5 35-39 años
## 5 0 5 6 3 3 4 35-39 años
## 6 1 6 6 4 2 5 35-39 años
## 7 1 7 6 4 2 4 35-39 años
## 8 1 2 6 3 2 3 35-39 años
## 9 1 3 6 3 3 4 35-39 años
## 10 1 7 6 4 3 5 35-39 años
## # ℹ 3,136 more rowssummary(BN)## Y_CESAREA PESO_NAC EDAD_MADRE T_GES
## Min. :0.0000 Min. :1.000 Min. :6.000 Min. :1.000
## 1st Qu.:0.0000 1st Qu.:5.000 1st Qu.:6.000 1st Qu.:3.000
## Median :1.0000 Median :6.000 Median :7.000 Median :4.000
## Mean :0.5645 Mean :5.651 Mean :7.093 Mean :3.756
## 3rd Qu.:1.0000 3rd Qu.:6.000 3rd Qu.:8.000 3rd Qu.:4.000
## Max. :1.0000 Max. :9.000 Max. :9.000 Max. :9.000
## N_EMB TALLA_NAC GRUPO_EDAD
## Min. : 1.000 Min. :2.000 Length:3146
## 1st Qu.: 2.000 1st Qu.:4.000 Class :character
## Median : 3.000 Median :5.000 Mode :character
## Mean : 3.693 Mean :4.563
## 3rd Qu.: 5.000 3rd Qu.:5.000
## Max. :17.000 Max. :9.000Base de datos filtrada
Aqui encontramos la base totalmente filtrada para su facil comprención.
BN_resumen <- BN %>%
group_by(GRUPO_EDAD, Y_CESAREA) %>%
summarise(
n = n(),
N_EMB_prom = mean(N_EMB, na.rm = TRUE),
T_GES_prom = mean(T_GES, na.rm = TRUE),
PESO_NAC_prom = mean(PESO_NAC, na.rm = TRUE),
TALLA_prom = mean(TALLA_NAC, na.rm = TRUE),
.groups = "drop"
) %>%
mutate(
Tipo_Parto = if_else(Y_CESAREA == 1, "Cesárea", "Natural")
) %>%
arrange(GRUPO_EDAD, Y_CESAREA)
BN_resumen## # A tibble: 8 × 8
## GRUPO_EDAD Y_CESAREA n N_EMB_prom T_GES_prom PESO_NAC_prom TALLA_prom
## <chr> <dbl> <int> <dbl> <dbl> <dbl> <dbl>
## 1 35-39 años 0 461 3.37 3.82 5.76 4.63
## 2 35-39 años 1 539 2.64 3.71 5.67 4.55
## 3 40-44 años 0 431 4.63 3.80 5.78 4.59
## 4 40-44 años 1 569 3.24 3.71 5.53 4.50
## 5 45-49 años 0 405 5.58 3.93 5.89 4.72
## 6 45-49 años 1 595 3.66 3.62 5.29 4.39
## 7 50-54 años 0 73 2.88 3.86 6.12 4.95
## 8 50-54 años 1 73 2.15 3.81 6.14 4.81
## # ℹ 1 more variable: Tipo_Parto <chr>Modelos que se utilizaran:
En este estudio se implementarán dos modelos de clasificación supervisada:
K-Vecinos Más Cercanos (KNN):
Este modelo clasifica una observación nueva según la categoría predominante entre sus k vecinos más cercanos en el conjunto de entrenamiento. Se basa en la similitud entre los datos y es útil para detectar patrones sin asumir una forma específica en la relación entre variables.
Modelo Logit (Regresión Logística):
Es un modelo estadístico que estima la probabilidad de que ocurra un evento binario (en este caso, parto por cesárea o no) a partir de variables explicativas. Permite interpretar la influencia de cada variable en la probabilidad del resultado.
Resultados
descriptivos:
Antes de proceder con la aplicación de los modelos de clasificasión, se realizó un análisis descriptivo de las variables incluidas en la base de datos con el fin de caracterizar el comportamiento general de las mujeres que tienen partos por cesarea
Modelo logit
modelo_logit <- glm(Y_CESAREA ~ PESO_NAC + T_GES + N_EMB + TALLA_NAC + GRUPO_EDAD,
data = BN, family = binomial(link = "logit"))
summary(modelo_logit)##
## Call:
## glm(formula = Y_CESAREA ~ PESO_NAC + T_GES + N_EMB + TALLA_NAC +
## GRUPO_EDAD, family = binomial(link = "logit"), data = BN)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 3.89251 0.38930 9.999 < 2e-16 ***
## PESO_NAC 0.01175 0.04512 0.260 0.794487
## T_GES -0.56298 0.09658 -5.829 5.56e-09 ***
## N_EMB -0.24385 0.01753 -13.912 < 2e-16 ***
## TALLA_NAC -0.20862 0.08208 -2.541 0.011038 *
## GRUPO_EDAD40-44 años 0.32232 0.09483 3.399 0.000676 ***
## GRUPO_EDAD45-49 años 0.58900 0.09977 5.904 3.56e-09 ***
## GRUPO_EDAD50-54 años -0.19375 0.18365 -1.055 0.291440
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 4308.7 on 3145 degrees of freedom
## Residual deviance: 3981.9 on 3138 degrees of freedom
## AIC: 3997.9
##
## Number of Fisher Scoring iterations: 4Los resultados muestran que el modelo es estadísticamente significativo en conjunto, con una reducción de la desviación residual (de 4308.7 a 3981.9), lo que indica que las variables incluidas explican parte importante de la variabilidad en la probabilidad de cesárea.
Interpretación de los coeficientes principales:
Intercepto: Representa el logaritmo de las probabilidades de cesárea cuando todas las variables independientes están en su valor base. Su significancia (p < 0.001) muestra que el modelo tiene una constante estadísticamente relevante.
PESO_NAC: Presenta un coeficiente negativo (0.011), no resulta significativo. Esto sugiere que el peso del recién nacido, por sí solo, no influye de manera importante en la probabilidad de cesárea dentro del rango observado.
T_GES (Tiempo de gestación): Presenta un coeficiente negativo (-0.563), lo que indica que a mayor tiempo de gestación, menor es la probabilidad de cesárea. Es decir, los partos con gestaciones más prolongadas tienden a ser naturales con mayor frecuencia.
N_EMB (Número de embarazos): También tiene un coeficiente negativo (-0.244), lo que significa que a medida que aumenta el número de embarazos previos, la probabilidad de cesárea disminuye. Esto puede relacionarse con que las mujeres con mayor experiencia obstétrica suelen presentar partos más espontáneos o menos complicados.
TALLA_NAC (Talla del nacido): Es significativa, con un coeficiente negativo (-0.209). Esto indica que los recién nacidos con mayor talla tienen menor probabilidad de nacer por cesárea, aunque este efecto es más moderado.
GRUPO_EDAD (comparado con el grupo base de 35–39 años)
40–44 años (coef = 0.322) → Incrementa significativamente la probabilidad de cesárea.
45–49 años (coef = 0.589) → Aumenta aún más el riesgo de cesárea.
50–54 años (coef = - 0.193) → No significativa, posiblemente por el tamaño pequeño del grupo o la baja frecuencia de casos.
En general, la edad materna avanzada incrementa la probabilidad de cesárea, especialmente en los rangos de 40–49 años, lo que coincide con la literatura médica y los antecedentes del estudio.
Tabla de frecuencias
table(BN$EDAD_MADRE, useNA = "ifany")##
## 6 7 8 9
## 1000 1000 1000 146BN5 <- BN %>%
mutate(GRUPO_EDAD = case_when(EDAD_MADRE == 6 ~ "35-39 años",
EDAD_MADRE == 7 ~ "40-44 años",
EDAD_MADRE == 8 ~ "45-49 años",
EDAD_MADRE == 9 ~ "50-54 años",
TRUE ~ NA_character_),
GRUPO_EDAD = factor(GRUPO_EDAD,
levels = c("35-39 años","40-44 años","45-49 años","50-54 años")),
Y_CESAREA = factor(Y_CESAREA,
levels = c(0, 1),
labels = c("No Cesárea", "Cesárea")))
table(BN5$Y_CESAREA, useNA = "ifany")##
## No Cesárea Cesárea
## 1370 1776El propósito de esta distribución fue buscar un equilibrio en la cantidad de datos por grupo de edades, de manera que cada categoría tuviera un número de observaciones similar para permitir comparaciones más justas y estables en el modelo.
Normalidad de los residuos
shapiro.test(modelo_logit$residuals)##
## Shapiro-Wilk normality test
##
## data: modelo_logit$residuals
## W = 0.87579, p-value < 2.2e-16qqnorm(modelo_logit$residuals, main = "Gráfico Q-Q de los residuos")
qqline(modelo_logit$residuals, col = "red", lwd = 2)
El valor p (<2.2e-16) es mucho menor que 0.05, lo que significa que rechazamos la hipótesis nula de normalidad, en otras palabras, los residuos no siguen una distribución normal. Esta falta de normalidad también se observa en el gráfico Q-Q, donde los puntos se alejan de la línea de referencia.
Verificar homocedasticidad (varianza constante)
library(lmtest)
bptest(modelo_logit)##
## studentized Breusch-Pagan test
##
## data: modelo_logit
## BP = 50.964, df = 7, p-value = 9.338e-09Con un estadístico BP = 50.964 y un valor p (<9.338e-09), se indica que los residuos del modelo no presentan varianza constante (heterocedasticidad). Este resultado simplemente refleja que la variabilidad de los residuos cambia según las probabilidades predichas, lo cual es un comportamiento habitual en modelos binarios.
Independencia
library(lmtest)
dwtest(modelo_logit)##
## Durbin-Watson test
##
## data: modelo_logit
## DW = 1.993, p-value = 0.4005
## alternative hypothesis: true autocorrelation is greater than 0El test arrojó un estadístico DW = 1.993 con un valor p = 0.4005, lo que indica que no existe autocorrelación significativa entre los residuos del modelo. Dado que el valor del estadístico está muy próximo a 2, se concluye que los residuos son independientes, cumpliéndose así el supuesto de independencia en la regresión logística.
Multicolinealidad
library(car)
vif(modelo_logit)## GVIF Df GVIF^(1/(2*Df))
## PESO_NAC 1.871306 1 1.367957
## T_GES 1.343703 1 1.159182
## N_EMB 1.106835 1 1.052062
## TALLA_NAC 1.627923 1 1.275901
## GRUPO_EDAD 1.125266 3 1.019865Los resultados del análisis de multicolinealidad (VIF), muestran valores bajos para todas las variables (menores a 2), lo que indica que no existe colinealidad significativa entre los predictores del modelo.
Grafica frecuencia del Tiempo de gestión
library(gridExtra)
p1 <- ggplot(BN, aes(x = T_GES,)) +
geom_histogram(bins = 10, color = "white", alpha = 0.9) +
facet_wrap(~Y_CESAREA, labeller = labeller(Y_CESAREA = c("0" = "NO Cesárea", "1" = "Cesárea"))) +
labs(title = "Distribución del tiempo de gestion por tipo de parto",
subtitle = "Comparación entre partos naturales y cesáreas",
x = "Tiempo de gestión (T_GES)",
y = "Frecuencia",
fill = "Tipo de parto") +
scale_fill_manual(
values = c("0" = "#81D4FA",
"1" = "#F8BBD0")) +
theme_minimal(base_size = 13) +
theme(
plot.background = element_rect(fill = "#E3F2FD", color = NA),
panel.background = element_rect(fill = "#81D4FA", color = NA),
strip.text = element_text(face = "bold", color = "#0D47A1"),
plot.title = element_text(size = 16, face = "bold", color = "#1565C0", hjust = 0.5),
plot.subtitle = element_text(size = 13, color = "#5C6BC0", hjust = 0.5),
axis.title = element_text(face = "bold", color = "#333333"),
axis.text = element_text(color = "#333333"),
legend.position = "bottom",
legend.background = element_rect(fill = "#E3F2FD", color = NA),
legend.title = element_text(face = "bold")
) +
xlim(0, 5)
p1
El análisis del tiempo de gestación por tipo de parto muestra que la mayoría de los nacimientos en Colombia (según la muestra) se producen entre las semanas 38 y 41, tanto en partos naturales como en cesáreas.
Sin embargo, los partos por cesárea tienden a ser más frecuentes en embarazos de duración ligeramente menor, lo que puede asociarse a la intervención médica ante riesgos o complicaciones en gestaciones prematuras.
Este patrón sugiere que el tiempo de gestación influye en la probabilidad de cesárea, respaldando su inclusión como variable significativa dentro del modelo de regresión logística.
Grafica frecuencia del Peso al nacer
p2 <- ggplot(BN, aes(x = factor(Y_CESAREA,
levels = c(0, 1),
labels = c("No Cesárea", "Cesárea")),
y = PESO_NAC,
fill = factor(Y_CESAREA))) +
geom_boxplot(color = "black", alpha = 0.8, width = 0.5) +
labs(
title = "Peso al nacer según tipo de parto",
subtitle = "Comparación entre partos naturales y cesáreas",
x = "Tipo de parto",
y = "Peso al nacer (kg)",
fill = "Tipo de parto"
) +
scale_fill_manual(
values = c("0" = "#90CAF9",
"1" = "#F8BBD0")) +
ylim(2.5, 7.5) +
theme_minimal(base_size = 13) +
theme(
plot.background = element_rect(fill = "#E3F2FD", color = NA),
panel.background = element_rect(fill = "white", color = NA),
panel.grid.major = element_line(color = "gray85"),
plot.title = element_text(size = 16, face = "bold", color = "#1565C0", hjust = 0.5),
plot.subtitle = element_text(size = 13, color = "#5C6BC0", hjust = 0.5),
axis.title = element_text(face = "bold", color = "#333333"),
axis.text = element_text(color = "#333333"),
legend.position = "bottom",
legend.background = element_rect(fill = "#E3F2FD", color = NA),
legend.title = element_text(face = "bold"))
p2
El análisis del peso al nacer según el tipo de parto muestra que no existen diferencias marcadas entre partos naturales y cesáreas, ya que ambos presentan medianas similares y rangos de variación comparables. En conjunto, el peso del recién nacido no parece ser un factor determinante principal, pero puede influir moderadamente en la elección o necesidad de una cesárea.
Grafica frecuencia de la Talla del recién nacido
p3 <- ggplot(BN, aes(x = factor(TALLA_NAC))) +
geom_bar(aes(fill = factor(Y_CESAREA)), position = "dodge", color = "black", alpha = 0.85) +
facet_wrap(~Y_CESAREA,
labeller = labeller(Y_CESAREA = c("0" = "No Cesárea", "1" = "Cesárea"))) +
labs(
title = "Distribución de la talla del recién nacido según tipo de parto",
subtitle = "Comparación entre partos naturales y cesáreas",
x = "Talla del recién nacido (categorías)",
y = "Frecuencia",
fill = "Tipo de parto"
) +
scale_fill_manual(
values = c("0" = "#90CAF9",
"1" = "#F8BBD0")) +
theme_minimal(base_size = 13) +
theme(
plot.background = element_rect(fill = "#E3F2FD", color = NA),
panel.background = element_rect(fill = "white", color = NA),
panel.grid.major = element_line(color = "gray85"),
axis.text.x = element_text(angle = 45, hjust = 1, color = "#333333"),
axis.text.y = element_text(color = "#333333"),
plot.title = element_text(size = 16, face = "bold", color = "#1565C0", hjust = 0.5),
plot.subtitle = element_text(size = 13, color = "#5C6BC0", hjust = 0.5),
axis.title = element_text(face = "bold", color = "#333333"),
legend.position = "bottom",
legend.background = element_rect(fill = "#E3F2FD", color = NA),
legend.title = element_text(face = "bold"))
p3
La distribución de la talla del recién nacido según el tipo de parto muestra que la mayoría de los bebés, tanto en partos naturales como por cesárea, presentan tallas entre 40 y 59 cm, consideradas normales para gestaciones a término. Sin embargo, se observa una ligera mayor frecuencia de tallas más altas en los partos por cesárea, lo que podría estar relacionado con la elección médica de este tipo de parto para evitar complicaciones derivadas del tamaño del bebé.
En general, la talla al nacer no parece diferenciar de forma sustancial ambos tipos de parto, aunque puede tener un papel moderado como factor asociado a la decisión de realizar una cesárea.
table(BN$EDAD_MADRE, useNA = "ifany")##
## 6 7 8 9
## 1000 1000 1000 146BN5 <- BN %>%
mutate(GRUPO_EDAD = case_when(EDAD_MADRE == 6 ~ "35-39 años",
EDAD_MADRE == 7 ~ "40-44 años",
EDAD_MADRE == 8 ~ "45-49 años",
EDAD_MADRE == 9 ~ "50-54 años",
TRUE ~ NA_character_),
GRUPO_EDAD = factor(GRUPO_EDAD,
levels = c("35-39 años","40-44 años","45-49 años","50-54 años")),
Y_CESAREA = factor(Y_CESAREA,
levels = c(0, 1),
labels = c("No Cesárea", "Cesárea")))
table(BN5$GRUPO_EDAD, useNA = "ifany")##
## 35-39 años 40-44 años 45-49 años 50-54 años
## 1000 1000 1000 146Grafica frecuencia de Grupo de edad materna
p4 <- ggplot(BN5, aes(x = Y_CESAREA, y = GRUPO_EDAD, color = Y_CESAREA)) +
geom_jitter(
position = position_jitter(width = 0.2, height = 0.2),
size = 2.8, alpha = 0.7
) +
scale_color_manual(values = c("#0D47A1", "#BD2B9C")) +
labs(
title = "Grupo de edad de la madre según tipo de parto",
x = "Tipo de parto",
y = "Grupo de edad materna",
color = "Tipo de parto"
) +
theme_minimal(base_family = "Poppins") +
theme(
plot.background = element_rect(fill = "#E3F2FD", color = NA),
panel.background = element_rect(fill = "#B3E5FC", color = NA),
plot.title = element_text(size = 16, face = "bold", color = "#0D47A1", hjust = 0.5),
axis.title = element_text(size = 13, color = "#424242"),
axis.text = element_text(size = 11, color = "#333333"),
legend.position = "right",
legend.background = element_rect(fill = "#FFFFFF", color = "#E0E0E0"),
legend.key = element_rect(fill = "#FFFFFF", color = NA)
)
p4
El gráfico del grupo de edad materna según el tipo de parto muestra que la frecuencia de cesáreas aumenta con la edad, siendo más marcada a partir de los 45 años. A su vez, se observa que el grupo de 50–54 años tiene una cantidad significativamente menor de registros. por lo cual, realmente no podemos sacar una conclución definitiva.
Matriz de correlación
#Multi
library(ggcorrplot)
vars <- BN %>%
select(Y_CESAREA, PESO_NAC, EDAD_MADRE, T_GES, N_EMB)
matriz_cor <- cor(vars, use = "complete.obs")
ggcorrplot(matriz_cor,
lab = TRUE,
title = "Matriz de correlación entre variables independientes",
colors = c("red", "white", "blue"),
ggtheme = theme_minimal())
La matriz de correlación evidencia que no existen relaciones fuertes entre las variables independientes, las correlaciones más destacadas son la positiva entre peso al nacer y tiempo de gestación (r = 0.53) y la negativa entre número de embarazos y cesárea (r = –0.25).
En general, los resultados indican que las variables seleccionadas son estadísticamente independientes entre sí, permitiendo una interpretación confiable de los coeficientes del modelo y minimizando el riesgo de multicolinealidad.
Entrenamiento knn
library(caret)
set.seed(2004)
idx <- createDataPartition(BN$Y_CESAREA, p = 0.7, list = FALSE)
train <- BN[idx, ]
test <- BN[-idx, ]
dv <- dummyVars(Y_CESAREA ~ ., data = train)
train_x <- predict(dv, train)
test_x <- predict(dv, test)
preproc <- preProcess(train_x, method = c("center", "scale"))
train_x <- predict(preproc, train_x)
test_x <- predict(preproc, test_x)
train_y <- factor(ifelse(train$Y_CESAREA == 1, "cesarea", "no_cesarea"),
levels = c("cesarea", "no_cesarea"))
test_y <- factor(ifelse(test$Y_CESAREA == 1, "cesarea", "no_cesarea"),
levels = c("cesarea", "no_cesarea"))
ctrl <- trainControl(method = "repeatedcv", number = 5, repeats = 3,
classProbs = TRUE, summaryFunction = twoClassSummary)
knn_fit <- train(train_x, train_y,
method = "knn",
tuneLength = 200,
metric = "ROC",
trControl = ctrl)
knn_fit## k-Nearest Neighbors
##
## 2203 samples
## 9 predictor
## 2 classes: 'cesarea', 'no_cesarea'
##
## No pre-processing
## Resampling: Cross-Validated (5 fold, repeated 3 times)
## Summary of sample sizes: 1761, 1763, 1763, 1762, 1763, 1762, ...
## Resampling results across tuning parameters:
##
## k ROC Sens Spec
## 5 0.6308832 0.7089852 0.4696170
## 7 0.6383128 0.7138272 0.4841194
## 9 0.6403967 0.7248868 0.4810249
## 11 0.6419180 0.7259523 0.4689475
## 13 0.6421833 0.7283934 0.4668910
## 15 0.6442195 0.7372938 0.4655040
## 17 0.6449376 0.7324387 0.4720563
## 19 0.6468659 0.7329753 0.4706746
## 21 0.6461305 0.7391711 0.4668768
## 23 0.6467459 0.7408014 0.4623934
## 25 0.6479215 0.7472596 0.4603333
## 27 0.6478926 0.7512973 0.4489522
## 29 0.6475049 0.7596535 0.4479159
## 31 0.6470273 0.7671999 0.4396471
## 33 0.6473017 0.7736722 0.4306875
## 35 0.6484817 0.7804025 0.4148051
## 37 0.6492251 0.7852586 0.4120453
## 39 0.6486814 0.7914642 0.4151470
## 41 0.6479471 0.7971355 0.4078949
## 43 0.6474673 0.7973967 0.4041077
## 45 0.6484171 0.8006138 0.3968502
## 47 0.6483156 0.8089548 0.3916725
## 49 0.6503492 0.8173023 0.3820148
## 51 0.6515646 0.8186616 0.3792621
## 53 0.6514441 0.8191959 0.3778840
## 55 0.6517416 0.8267500 0.3751260
## 57 0.6528738 0.8313232 0.3661539
## 59 0.6545211 0.8297059 0.3647775
## 61 0.6546601 0.8326716 0.3626996
## 63 0.6538228 0.8369836 0.3589000
## 65 0.6541895 0.8386030 0.3616580
## 67 0.6545642 0.8439848 0.3551075
## 69 0.6544740 0.8445290 0.3547531
## 71 0.6548069 0.8442558 0.3530260
## 73 0.6548253 0.8477580 0.3495736
## 75 0.6554066 0.8491076 0.3474992
## 77 0.6550853 0.8426538 0.3530331
## 79 0.6560421 0.8496441 0.3461300
## 81 0.6556115 0.8515237 0.3443976
## 83 0.6554463 0.8523334 0.3426722
## 85 0.6545975 0.8504462 0.3423375
## 87 0.6537656 0.8509915 0.3454338
## 89 0.6531668 0.8496452 0.3450902
## 91 0.6524171 0.8496496 0.3433613
## 93 0.6522897 0.8510013 0.3423197
## 95 0.6520355 0.8510024 0.3412887
## 97 0.6513305 0.8550477 0.3347471
## 99 0.6515791 0.8555842 0.3347400
## 101 0.6505426 0.8558541 0.3357727
## 103 0.6500280 0.8574725 0.3333636
## 105 0.6506808 0.8553165 0.3357762
## 107 0.6515227 0.8588242 0.3333654
## 109 0.6519648 0.8577500 0.3316365
## 111 0.6516870 0.8590963 0.3295746
## 113 0.6528003 0.8585564 0.3302619
## 115 0.6523617 0.8590941 0.3306073
## 117 0.6528124 0.8585543 0.3309528
## 119 0.6528666 0.8558683 0.3326692
## 121 0.6531317 0.8561371 0.3357780
## 123 0.6527876 0.8566780 0.3326745
## 125 0.6528180 0.8553295 0.3343963
## 127 0.6526699 0.8564103 0.3347382
## 129 0.6525900 0.8518251 0.3347346
## 131 0.6530427 0.8529047 0.3337055
## 133 0.6541506 0.8518219 0.3312839
## 135 0.6534985 0.8523628 0.3302477
## 137 0.6534278 0.8526338 0.3299022
## 139 0.6538175 0.8512864 0.3319730
## 141 0.6540999 0.8539855 0.3302459
## 143 0.6546347 0.8547876 0.3288731
## 145 0.6551771 0.8588361 0.3264551
## 147 0.6553877 0.8591060 0.3226412
## 149 0.6548665 0.8593716 0.3236989
## 151 0.6537288 0.8596426 0.3236953
## 153 0.6531719 0.8582909 0.3264427
## 155 0.6531725 0.8577456 0.3243826
## 157 0.6525337 0.8577380 0.3209266
## 159 0.6529312 0.8580090 0.3240390
## 161 0.6534124 0.8607081 0.3219682
## 163 0.6530479 0.8555875 0.3254189
## 165 0.6539765 0.8539735 0.3278333
## 167 0.6545106 0.8542412 0.3281787
## 169 0.6550738 0.8539746 0.3264569
## 171 0.6550145 0.8574736 0.3236935
## 173 0.6548472 0.8574757 0.3250699
## 175 0.6546857 0.8585521 0.3254171
## 177 0.6550146 0.8585532 0.3257643
## 179 0.6546221 0.8593585 0.3247227
## 181 0.6544766 0.8604327 0.3233463
## 183 0.6539797 0.8609769 0.3216299
## 185 0.6537292 0.8609725 0.3178320
## 187 0.6540671 0.8631252 0.3161085
## 189 0.6543514 0.8636596 0.3178356
## 191 0.6545467 0.8639273 0.3174902
## 193 0.6542674 0.8636563 0.3154212
## 195 0.6540213 0.8663467 0.3119759
## 197 0.6540080 0.8658069 0.3109342
## 199 0.6534637 0.8674241 0.3085234
## 201 0.6539642 0.8695790 0.3088706
## 203 0.6533309 0.8717350 0.3081780
## 205 0.6532021 0.8725415 0.3050763
## 207 0.6533603 0.8728103 0.3047344
## 209 0.6530454 0.8749695 0.3016238
## 211 0.6534739 0.8728255 0.3033349
## 213 0.6526739 0.8720202 0.3036786
## 215 0.6521809 0.8714836 0.3026405
## 217 0.6517847 0.8755268 0.2926411
## 219 0.6516361 0.8763321 0.2915995
## 221 0.6512154 0.8763365 0.2905614
## 223 0.6514470 0.8801054 0.2867635
## 225 0.6517922 0.8795623 0.2853747
## 227 0.6511974 0.8803687 0.2839984
## 229 0.6512525 0.8811784 0.2812350
## 231 0.6513451 0.8819849 0.2774389
## 233 0.6519929 0.8822515 0.2795114
## 235 0.6514677 0.8846742 0.2774371
## 237 0.6515950 0.8849364 0.2767552
## 239 0.6513080 0.8806267 0.2774389
## 241 0.6517264 0.8819751 0.2746773
## 243 0.6512059 0.8817063 0.2705500
## 245 0.6510929 0.8844021 0.2677955
## 247 0.6506887 0.8846665 0.2677955
## 249 0.6506584 0.8868138 0.2650393
## 251 0.6494465 0.8895063 0.2636469
## 253 0.6500756 0.8873547 0.2674501
## 255 0.6504116 0.8911388 0.2615832
## 257 0.6504073 0.8916797 0.2636576
## 259 0.6500721 0.8889828 0.2626231
## 261 0.6501316 0.8873678 0.2626195
## 263 0.6500327 0.8881764 0.2612360
## 265 0.6502038 0.8873699 0.2588288
## 267 0.6503033 0.8876409 0.2595196
## 269 0.6504105 0.8879108 0.2574471
## 271 0.6505660 0.8906088 0.2553745
## 273 0.6509641 0.8946552 0.2463971
## 275 0.6512980 0.8978854 0.2436373
## 277 0.6512245 0.8976155 0.2401795
## 279 0.6506902 0.9008445 0.2346491
## 281 0.6505572 0.9038102 0.2332657
## 283 0.6505380 0.9038135 0.2301586
## 285 0.6507284 0.9056996 0.2291242
## 287 0.6513657 0.9097449 0.2229190
## 289 0.6513693 0.9124418 0.2177430
## 291 0.6518607 0.9132493 0.2167032
## 293 0.6514879 0.9164849 0.2129089
## 295 0.6513786 0.9183721 0.2087656
## 297 0.6504128 0.9202582 0.2073821
## 299 0.6499854 0.9210646 0.2053220
## 301 0.6492803 0.9232184 0.2028987
## 303 0.6490671 0.9248335 0.1994534
## 305 0.6485223 0.9261797 0.1970372
## 307 0.6483641 0.9267163 0.1960063
## 309 0.6479361 0.9294110 0.1918630
## 311 0.6477834 0.9323702 0.1915193
## 313 0.6471838 0.9329045 0.1891049
## 315 0.6472136 0.9326346 0.1911775
## 317 0.6468208 0.9334433 0.1873778
## 319 0.6470195 0.9347884 0.1897940
## 321 0.6466255 0.9355981 0.1901412
## 323 0.6467622 0.9369466 0.1870342
## 325 0.6469065 0.9356014 0.1894521
## 327 0.6471791 0.9366778 0.1828909
## 329 0.6476776 0.9377574 0.1818546
## 331 0.6471842 0.9383005 0.1825365
## 333 0.6477504 0.9385682 0.1801204
## 335 0.6472733 0.9377607 0.1766697
## 337 0.6468444 0.9396522 0.1787440
## 339 0.6460275 0.9420759 0.1732172
## 341 0.6465461 0.9415372 0.1697648
## 343 0.6465634 0.9428834 0.1704556
## 345 0.6462115 0.9447684 0.1670032
## 347 0.6457220 0.9455759 0.1621726
## 349 0.6448450 0.9469211 0.1611417
## 351 0.6445384 0.9488061 0.1587255
## 353 0.6440239 0.9485351 0.1563075
## 355 0.6430023 0.9498825 0.1545822
## 357 0.6425095 0.9512298 0.1563093
## 359 0.6425280 0.9520363 0.1525132
## 361 0.6423110 0.9531126 0.1494098
## 363 0.6418804 0.9536513 0.1473426
## 365 0.6411238 0.9547310 0.1456190
## 367 0.6403851 0.9555396 0.1438919
## 369 0.6402011 0.9571601 0.1418176
## 371 0.6403037 0.9574278 0.1435465
## 373 0.6399640 0.9585075 0.1397504
## 375 0.6395188 0.9585086 0.1352670
## 377 0.6394616 0.9603957 0.1349180
## 379 0.6388723 0.9590418 0.1331962
## 381 0.6398325 0.9595849 0.1321600
## 383 0.6397642 0.9603935 0.1311184
## 385 0.6399128 0.9603925 0.1297331
## 387 0.6396597 0.9620086 0.1293895
## 389 0.6393402 0.9625463 0.1280095
## 391 0.6391719 0.9647022 0.1249043
## 393 0.6397334 0.9663184 0.1242170
## 395 0.6392455 0.9671281 0.1214572
## 397 0.6385481 0.9682056 0.1176611
## 399 0.6385443 0.9687432 0.1162901
## 401 0.6382176 0.9722422 0.1124904
## 403 0.6377520 0.9719744 0.1083489
##
## ROC was used to select the optimal model using the largest value.
## The final value used for the model was k = 79.plot(knn_fit)
El modelo KNN muestra un comportamiento estable y un rendimiento moderado, alcanzando su mejor desempeño con 79 vecinos (ROC ≈ 0.656). Este valor indica que el modelo logra una capacidad aceptable para distinguir entre partos por cesárea y naturales
El gráfico refleja que el rendimiento del modelo KNN mejora al aumentar k hasta cierto punto (=79), pero empeora cuando se agregan demasiados vecinos.Esto demuestra el equilibrio clásico del Knn
Predicción knn
pred_knn_class <- predict(knn_fit, newdata = test_x)
pred_knn_prob <- predict(knn_fit, newdata = test_x, type = "prob")
conf_matrix_knn <- confusionMatrix(pred_knn_class, test_y, positive = "cesarea")
conf_matrix_knn## Confusion Matrix and Statistics
##
## Reference
## Prediction cesarea no_cesarea
## cesarea 458 271
## no_cesarea 81 133
##
## Accuracy : 0.6267
## 95% CI : (0.595, 0.6577)
## No Information Rate : 0.5716
## P-Value [Acc > NIR] : 0.000326
##
## Kappa : 0.1901
##
## Mcnemar's Test P-Value : < 2.2e-16
##
## Sensitivity : 0.8497
## Specificity : 0.3292
## Pos Pred Value : 0.6283
## Neg Pred Value : 0.6215
## Prevalence : 0.5716
## Detection Rate : 0.4857
## Detection Prevalence : 0.7731
## Balanced Accuracy : 0.5895
##
## 'Positive' Class : cesarea
## print(conf_matrix_knn$overall)## Accuracy Kappa AccuracyLower AccuracyUpper AccuracyNull
## 6.267232e-01 1.901274e-01 5.949650e-01 6.576872e-01 5.715801e-01
## AccuracyPValue McnemarPValue
## 3.259881e-04 7.218450e-24print(conf_matrix_knn$byClass)## Sensitivity Specificity Pos Pred Value
## 0.8497217 0.3292079 0.6282579
## Neg Pred Value Precision Recall
## 0.6214953 0.6282579 0.8497217
## F1 Prevalence Detection Rate
## 0.7223975 0.5715801 0.4856840
## Detection Prevalence Balanced Accuracy
## 0.7730647 0.5894648library(pROC)
roc_knn <- roc(response = test_y,
predictor = pred_knn_prob$cesarea,
levels = c("no_cesarea", "cesarea"))
plot(roc_knn, col = "blue", main = "Curva ROC - Modelo KNN")
auc(roc_knn)## Area under the curve: 0.6647El modelo predijo correctamente 458 cesáreas y 133 partos naturales.Pero se equivocó 271 veces al clasificar partos naturales como cesáreas y 81 veces al clasificar cesáreas como partos naturales.
Se logró un desempeño moderado en la clasificación de partos por cesárea y partos naturales, con una exactitud del 62.7% y un área bajo la curva ROC aproximada de 0.65. Estos resultados indican una capacidad aceptable, aunque limitada, para diferenciar entre ambos tipos de parto.
Entrenamiento logic
library(caret)
library(pROC)
library(dplyr)
set.seed(2004)
modelo_logit <- train(train_x, train_y,
method = "glm",
family = "binomial",
trControl = trainControl(method = "cv",
classProbs = TRUE,
summaryFunction = twoClassSummary),
metric = "ROC")
pred_logit_prob <- predict(modelo_logit, test_x, type = "prob")
pred_logit_class <- predict(modelo_logit, test_x)
conf_matrix_logit <- confusionMatrix(pred_logit_class, test_y, positive = "cesarea")
print(conf_matrix_logit)## Confusion Matrix and Statistics
##
## Reference
## Prediction cesarea no_cesarea
## cesarea 426 213
## no_cesarea 113 191
##
## Accuracy : 0.6543
## 95% CI : (0.623, 0.6847)
## No Information Rate : 0.5716
## P-Value [Acc > NIR] : 1.288e-07
##
## Kappa : 0.2715
##
## Mcnemar's Test P-Value : 4.179e-08
##
## Sensitivity : 0.7904
## Specificity : 0.4728
## Pos Pred Value : 0.6667
## Neg Pred Value : 0.6283
## Prevalence : 0.5716
## Detection Rate : 0.4517
## Detection Prevalence : 0.6776
## Balanced Accuracy : 0.6316
##
## 'Positive' Class : cesarea
## roc_logit <- roc(response = test_y,
predictor = pred_logit_prob$cesarea,
levels = c("no_cesarea", "cesarea"))
auc_logit <- auc(roc_logit)
plot(roc_logit, col = "red", main = "Curva ROC - Modelo Logit")
cat("AUC Logit:", round(as.numeric(auc_logit), 3), "\n")## AUC Logit: 0.699El modelo logit obtuvo una exactitud del 65,4 %, lo que significa que clasifica correctamente aproximadamente 2 de cada 3 casos sobre si un parto fue por cesárea o no. El intervalo de confianza (95 % CI: 0.623 – 0.685) indica que la precisión del modelo es razonablemente estable y superior a la predicción aleatoria.
Sensibilidad (0.79): el modelo logra detectar correctamente el 79 % de los casos positivos (mujeres que tuvieron cesárea) y especificidad (0.47): identifica correctamente el 47 % de los casos negativos (partos sin cesárea). Esto indica que el modelo es mejor identificando los casos de cesárea que los de parto natural, lo cual puede ser útil si el objetivo es predecir el riesgo de cesárea.
Comparación entre el modelo Logit y el modelo KNN
## ===== Resultados del modelo KNN =====## KNN mejor k: 79## KNN Accuracy: 0.627## KNN Sensibilidad: 0.85## KNN Especificidad: 0.329## KNN AUC: 0.665## ===== Resultados del modelo Logit =====## Logit Accuracy: 0.654## Logit Sensibilidad: 0.79## Logit Especificidad: 0.473## Logit AUC: 0.699Exactitud (Accuracy): El modelo Logit tiene una precisión global ligeramente superior (65.4 %) en comparación con el modelo KNN (62.7 %). Esto sugiere que el logit realiza una clasificación más consistente entre los casos de cesárea y los de parto natural.
Sensibilidad: El modelo KNN detecta más casos positivos (85 %) que el Logit (79 %), lo cual significa que KNN identifica más mujeres que tuvieron cesárea. Sin embargo, esto ocurre a costa de una pérdida en especificidad.
Especificidad: El modelo Logit discrimina mejor los casos negativos (partos naturales) con una especificidad del 47 %, mientras que el KNN apenas alcanza el 32,9 %. Por tanto, Logit es más equilibrado entre verdaderos positivos y verdaderos negativos.
Área bajo la curva (AUC): El Logit (AUC = 0.699) supera al KNN (AUC ≈ 0.65), mostrando una mejor capacidad para distinguir entre partos por cesárea y naturales. Esto significa que el logit tiene un mayor poder predictivo general.
En términos generales, el modelo de regresión logística demuestra un mejor desempeño global frente al modelo KNN, ofreciendo una mayor exactitud, mejor equilibrio entre sensibilidad y especificidad, y un área bajo la curva más alta.
Por su parte, el modelo KNN muestra una mayor sensibilidad, lo que puede ser útil si el objetivo prioritario es detectar el mayor número posible de casos de cesárea, aunque esto implique aumentar los falsos positivos.
Conclución
El presente estudio logró analizar los factores que influyen en la probabilidad de que un parto sea por cesárea en mujeres colombianas mayores de 35 años, a partir de una muestra representativa del año 2017. Mediante la aplicación de modelos de regresión logística binaria (Logit) y k-Nearest Neighbors (KNN), se buscó identificar cuáles variables maternas y del recién nacido inciden de manera significativa en este tipo de intervención obstétrica.
Los resultados evidenciaron que la edad materna avanzada, el tiempo de gestación y el número de embarazos previos son factores determinantes en la probabilidad de cesárea. En particular, los grupos de edad entre 40 y 49 años mostraron un aumento considerable en la probabilidad de parto por cesárea, mientras que un mayor número de embarazos y un tiempo de gestación más prolongado reducen la necesidad de esta intervención.
En cuanto al desempeño de los modelos, la regresión logística obtuvo mejores resultados globales (AUC = 0.699, exactitud ≈ 65%), mostrando una mejor capacidad para explicar y predecir la variable dependiente, además de un equilibrio adecuado entre sensibilidad y especificidad. El modelo KNN, por su parte, presentó una mayor sensibilidad (≈85%), lo que significa que detecta más casos de cesárea, aunque con menor precisión general.
Con base en estos hallazgos, se concluye que el modelo Logit respondió satisfactoriamente al objetivo de la investigación, al permitir identificar de forma clara los factores asociados al aumento del riesgo de cesárea y cuantificar su influencia estadística. Los resultados obtenidos son coherentes con la literatura médica, confirmando que la edad materna avanzada y ciertas condiciones clínicas del embarazo elevan la probabilidad de intervención quirúrgica.
Finalmente, los resultados de este estudio refuerzan la importancia de mejorar la atención prenatal en mujeres mayores de 35 años, promoviendo un acompañamiento médico continuo y estrategias de prevención que reduzcan las cesáreas innecesarias. Además, se recomienda ampliar la base de datos en futuros trabajos e incorporar nuevas variables socioeconómicas y clínicas, con el fin de construir modelos predictivos más precisos y útiles para la toma de decisiones en salud pública.
Codigo R
Codigo Codigo R
library(tidyverse)
library(janitor)
library(caret)
library(class)
library(pROC)
library(ROCR)
library(scales)
library(gridExtra)
nac2017 <- read_csv("Datos/nac2017.csv")
DF <- nac2017 %>%
mutate(
Y_CESAREA = case_when(
TIPO_PARTO == 2 ~ 1,
TIPO_PARTO %in% c(1, 3) ~ 0,
TRUE ~ NA_real_) )
BN1 <- DF %>%
select(Y_CESAREA, PESO_NAC, EDAD_MADRE, T_GES, N_EMB, TALLA_NAC) %>%
filter(EDAD_MADRE %in% c(6, 7, 8, 9))
BN <- BN1 %>%
filter(
!is.na(Y_CESAREA),
!is.na(PESO_NAC),
!is.na(EDAD_MADRE),
!is.na(T_GES),
!is.na(N_EMB),
!is.na(TALLA_NAC)
) %>%
group_by(EDAD_MADRE) %>%
slice_head(n = 1000) %>%
ungroup() %>%
mutate(
GRUPO_EDAD = case_when(
EDAD_MADRE == 6 ~ "35-39 años",
EDAD_MADRE == 7 ~ "40-44 años",
EDAD_MADRE == 8 ~ "45-49 años",
EDAD_MADRE == 9 ~ "50-54 años",
TRUE ~ "Otro" ) )
BN
summary(BN)
BN_resumen <- BN %>%
group_by(GRUPO_EDAD, Y_CESAREA) %>%
summarise(
n = n(),
N_EMB_prom = mean(N_EMB, na.rm = TRUE),
T_GES_prom = mean(T_GES, na.rm = TRUE),
PESO_NAC_prom = mean(PESO_NAC, na.rm = TRUE),
TALLA_prom = mean(TALLA_NAC, na.rm = TRUE),
.groups = "drop"
) %>%
mutate(
Tipo_Parto = if_else(Y_CESAREA == 1, "Cesárea", "Natural")
) %>%
arrange(GRUPO_EDAD, Y_CESAREA)
BN_resumen
modelo_logit <- glm(Y_CESAREA ~ PESO_NAC + T_GES + N_EMB + TALLA_NAC + GRUPO_EDAD,
data = BN, family = binomial(link = "logit"))
summary(modelo_logit)
table(BN$EDAD_MADRE, useNA = "ifany")
BN5 <- BN %>%
mutate(GRUPO_EDAD = case_when(EDAD_MADRE == 6 ~ "35-39 años",
EDAD_MADRE == 7 ~ "40-44 años",
EDAD_MADRE == 8 ~ "45-49 años",
EDAD_MADRE == 9 ~ "50-54 años",
TRUE ~ NA_character_),
GRUPO_EDAD = factor(GRUPO_EDAD,
levels = c("35-39 años","40-44 años","45-49 años","50-54 años")),
Y_CESAREA = factor(Y_CESAREA,
levels = c(0, 1),
labels = c("No Cesárea", "Cesárea")))
table(BN5$Y_CESAREA, useNA = "ifany")
shapiro.test(modelo_logit$residuals)
qqnorm(modelo_logit$residuals, main = "Gráfico Q-Q de los residuos")
qqline(modelo_logit$residuals, col = "red", lwd = 2)
library(lmtest)
bptest(modelo_logit)
library(lmtest)
dwtest(modelo_logit)
library(car)
vif(modelo_logit)
p1 <- ggplot(BN, aes(x = T_GES,)) +
geom_histogram(bins = 10, color = "white", alpha = 0.9) +
facet_wrap(~Y_CESAREA, labeller = labeller(Y_CESAREA = c("0" = "NO Cesárea", "1" = "Cesárea"))) +
labs(title = "Distribución del tiempo de gestion por tipo de parto",
subtitle = "Comparación entre partos naturales y cesáreas",
x = "Tiempo de gestión (T_GES)",
y = "Frecuencia",
fill = "Tipo de parto") +
scale_fill_manual(
values = c("0" = "#81D4FA",
"1" = "#F8BBD0")) +
theme_minimal(base_size = 13) +
theme(
plot.background = element_rect(fill = "#E3F2FD", color = NA),
panel.background = element_rect(fill = "#81D4FA", color = NA),
strip.text = element_text(face = "bold", color = "#0D47A1"),
plot.title = element_text(size = 16, face = "bold", color = "#1565C0", hjust = 0.5),
plot.subtitle = element_text(size = 13, color = "#5C6BC0", hjust = 0.5),
axis.title = element_text(face = "bold", color = "#333333"),
axis.text = element_text(color = "#333333"),
legend.position = "bottom",
legend.background = element_rect(fill = "#E3F2FD", color = NA),
legend.title = element_text(face = "bold")
) +
xlim(0, 5)
p1
p2 <- ggplot(BN, aes(x = factor(Y_CESAREA,
levels = c(0, 1),
labels = c("No Cesárea", "Cesárea")),
y = PESO_NAC,
fill = factor(Y_CESAREA))) +
geom_boxplot(color = "black", alpha = 0.8, width = 0.5) +
labs(
title = "Peso al nacer según tipo de parto",
subtitle = "Comparación entre partos naturales y cesáreas",
x = "Tipo de parto",
y = "Peso al nacer (kg)",
fill = "Tipo de parto"
) +
scale_fill_manual(
values = c("0" = "#90CAF9",
"1" = "#F8BBD0")) +
ylim(2.5, 7.5) +
theme_minimal(base_size = 13) +
theme(
plot.background = element_rect(fill = "#E3F2FD", color = NA),
panel.background = element_rect(fill = "white", color = NA),
panel.grid.major = element_line(color = "gray85"),
plot.title = element_text(size = 16, face = "bold", color = "#1565C0", hjust = 0.5),
plot.subtitle = element_text(size = 13, color = "#5C6BC0", hjust = 0.5),
axis.title = element_text(face = "bold", color = "#333333"),
axis.text = element_text(color = "#333333"),
legend.position = "bottom",
legend.background = element_rect(fill = "#E3F2FD", color = NA),
legend.title = element_text(face = "bold"))
p2
p3 <- ggplot(BN, aes(x = factor(TALLA_NAC))) +
geom_bar(aes(fill = factor(Y_CESAREA)), position = "dodge", color = "black", alpha = 0.85) +
facet_wrap(~Y_CESAREA,
labeller = labeller(Y_CESAREA = c("0" = "No Cesárea", "1" = "Cesárea"))) +
labs(
title = "Distribución de la talla del recién nacido según tipo de parto",
subtitle = "Comparación entre partos naturales y cesáreas",
x = "Talla del recién nacido (categorías)",
y = "Frecuencia",
fill = "Tipo de parto"
) +
scale_fill_manual(
values = c("0" = "#90CAF9",
"1" = "#F8BBD0")) +
theme_minimal(base_size = 13) +
theme(
plot.background = element_rect(fill = "#E3F2FD", color = NA),
panel.background = element_rect(fill = "white", color = NA),
panel.grid.major = element_line(color = "gray85"),
axis.text.x = element_text(angle = 45, hjust = 1, color = "#333333"),
axis.text.y = element_text(color = "#333333"),
plot.title = element_text(size = 16, face = "bold", color = "#1565C0", hjust = 0.5),
plot.subtitle = element_text(size = 13, color = "#5C6BC0", hjust = 0.5),
axis.title = element_text(face = "bold", color = "#333333"),
legend.position = "bottom",
legend.background = element_rect(fill = "#E3F2FD", color = NA),
legend.title = element_text(face = "bold"))
p3
p4 <- ggplot(BN5, aes(x = Y_CESAREA, y = GRUPO_EDAD, color = Y_CESAREA)) +
geom_jitter(
position = position_jitter(width = 0.2, height = 0.2),
size = 2.8, alpha = 0.7
) +
scale_color_manual(values = c("#0D47A1", "#BD2B9C")) +
labs(
title = "Grupo de edad de la madre según tipo de parto",
x = "Tipo de parto",
y = "Grupo de edad materna",
color = "Tipo de parto"
) +
theme_minimal(base_family = "Poppins") +
theme(
plot.background = element_rect(fill = "#E3F2FD", color = NA),
panel.background = element_rect(fill = "#B3E5FC", color = NA),
plot.title = element_text(size = 16, face = "bold", color = "#0D47A1", hjust = 0.5),
axis.title = element_text(size = 13, color = "#424242"),
axis.text = element_text(size = 11, color = "#333333"),
legend.position = "right",
legend.background = element_rect(fill = "#FFFFFF", color = "#E0E0E0"),
legend.key = element_rect(fill = "#FFFFFF", color = NA)
)
p4
vars <- BN %>%
select(Y_CESAREA, PESO_NAC, EDAD_MADRE, T_GES, N_EMB)
matriz_cor <- cor(vars, use = "complete.obs")
ggcorrplot(matriz_cor,
lab = TRUE,
title = "Matriz de correlación entre variables independientes",
colors = c("red", "white", "blue"),
ggtheme = theme_minimal())
set.seed(2004)
idx <- createDataPartition(BN$Y_CESAREA, p = 0.7, list = FALSE)
train <- BN[idx, ]
test <- BN[-idx, ]
dv <- dummyVars(Y_CESAREA ~ ., data = train)
train_x <- predict(dv, train)
test_x <- predict(dv, test)
preproc <- preProcess(train_x, method = c("center", "scale"))
train_x <- predict(preproc, train_x)
test_x <- predict(preproc, test_x)
train_y <- factor(ifelse(train$Y_CESAREA == 1, "cesarea", "no_cesarea"),
levels = c("cesarea", "no_cesarea"))
test_y <- factor(ifelse(test$Y_CESAREA == 1, "cesarea", "no_cesarea"),
levels = c("cesarea", "no_cesarea"))
ctrl <- trainControl(method = "repeatedcv", number = 5, repeats = 3,
classProbs = TRUE, summaryFunction = twoClassSummary)
knn_fit <- train(train_x, train_y,
method = "knn",
tuneLength = 200,
metric = "ROC",
trControl = ctrl)
knn_fit
plot(knn_fit)
pred_knn_class <- predict(knn_fit, newdata = test_x)
pred_knn_prob <- predict(knn_fit, newdata = test_x, type = "prob")
conf_matrix_knn <- confusionMatrix(pred_knn_class, test_y, positive = "cesarea")
conf_matrix_knn
print(conf_matrix_knn$overall)
print(conf_matrix_knn$byClass)
library(pROC)
roc_knn <- roc(response = test_y,
predictor = pred_knn_prob$cesarea,
levels = c("no_cesarea", "cesarea"))
plot(roc_knn, col = "blue", main = "Curva ROC - Modelo KNN")
auc(roc_knn)
set.seed(2004)
modelo_logit <- train(train_x, train_y,
method = "glm",
family = "binomial",
trControl = trainControl(method = "cv",
classProbs = TRUE,
summaryFunction = twoClassSummary),
metric = "ROC")
pred_logit_prob <- predict(modelo_logit, test_x, type = "prob")
pred_logit_class <- predict(modelo_logit, test_x)
conf_matrix_logit <- confusionMatrix(pred_logit_class, test_y, positive = "cesarea")
print(conf_matrix_logit)
roc_logit <- roc(response = test_y,
predictor = pred_logit_prob$cesarea,
levels = c("no_cesarea", "cesarea"))
auc_logit <- auc(roc_logit)
plot(roc_logit, col = "red", main = "Curva ROC - Modelo Logit")
cat("AUC Logit:", round(as.numeric(auc_logit), 3), "\n")
library(pROC)
# AUC para cada modelo (asegúrate de haberlos calculado antes)
auc_knn <- auc(roc_knn)
auc_logit <- auc(roc_logit)
# Mostrar resultados con cat()
cat("===== Resultados del modelo KNN =====\n")
cat("KNN mejor k:", knn_fit$bestTune$k, "\n")
cat("KNN Accuracy:", round(conf_matrix_knn$overall["Accuracy"], 3), "\n")
cat("KNN Sensibilidad:", round(conf_matrix_knn$byClass["Sensitivity"], 3), "\n")
cat("KNN Especificidad:", round(conf_matrix_knn$byClass["Specificity"], 3), "\n")
cat("KNN AUC:", round(as.numeric(auc_knn), 3), "\n\n")
cat("===== Resultados del modelo Logit =====\n")
cat("Logit Accuracy:", round(conf_matrix_logit$overall["Accuracy"], 3), "\n")
cat("Logit Sensibilidad:", round(conf_matrix_logit$byClass["Sensitivity"], 3), "\n")
cat("Logit Especificidad:", round(conf_matrix_logit$byClass["Specificity"], 3), "\n")
cat("Logit AUC:", round(as.numeric(auc_logit), 3), "\n")