# Cargar las librerías necesarias
library(ggplot2)
library(dplyr)
library(readr)
library(plotly) # Para gráficos interactivos
# Leer el archivo de datos
data1 <- read_csv2("Nacimientos_Hospital_Medellin.csv", col_names = TRUE, locale = locale(encoding = "UTF-8"))
# Limpiar nombres
colnames(data1) <- trimws(colnames(data1))
# Factor de régimen
regimen_column_name <- grep("REGIMEN.*SEGURIDAD", colnames(data1), value = TRUE, ignore.case = TRUE)
if (length(regimen_column_name) == 0) stop("No se encontró la columna 'REGIMEN SEGURIDAD SOCIAL' en los datos")
data1[[regimen_column_name]] <- as.factor(data1[[regimen_column_name]])
# Talla
talla_column_name <- grep("TALLA.*CENT", colnames(data1), value = TRUE, ignore.case = TRUE)
if (length(talla_column_name) == 0) stop("No se encontró la columna 'TALLA (Centímetros)' en los datos")
talla_min <- min(data1[[talla_column_name]], na.rm = TRUE)
talla_max <- max(data1[[talla_column_name]], na.rm = TRUE)
delta <- 1
breaks_seq <- seq(floor(talla_min / delta) * delta, ceiling(talla_max / delta) * delta, by = delta)
bin_width <- diff(breaks_seq)[1]
# Densidades por régimen
density_data <- lapply(levels(data1[[regimen_column_name]]), function(lvl) {
subset_data <- data1 %>% filter(.data[[regimen_column_name]] == lvl & !is.na(.data[[talla_column_name]]))
hist_obj <- hist(subset_data[[talla_column_name]], breaks = breaks_seq, plot = FALSE)
midpoints <- hist_obj$mids
dens_vals <- (hist_obj$counts / sum(hist_obj$counts)) / bin_width
data.frame(REGIMEN = lvl, x = midpoints, density = dens_vals)
})
density_data <- do.call(rbind, density_data)
density_data <- density_data %>%
group_by(REGIMEN) %>%
arrange(x) %>%
summarise(
x = c(min(breaks_seq), x, max(breaks_seq)),
density = c(0, density, 0),
.groups = "drop"
)
# Paleta de colores automática para todos los niveles
niveles_regimen <- levels(data1[[regimen_column_name]])
color_palette <- scales::hue_pal()(length(niveles_regimen))
names(color_palette) <- niveles_regimen
# Gráfico con polígonos superpuestos interactivo
plot_overlay <- ggplot(density_data, aes(x = x, y = density, fill = REGIMEN, group = REGIMEN)) +
geom_polygon(color = "black", alpha = 0.6) +
scale_fill_manual(values = color_palette) +
labs(
x = "Talla del recién nacido (centímetros)",
y = "Densidad",
title = "Distribución de la talla al nacer por régimen de seguridad social",
fill = "Régimen"
) +
theme_minimal() +
theme(legend.position = "top")
plotly_overlay <- ggplotly(plot_overlay, tooltip = c("x", "y", "fill"))
# Gráfico de densidad con líneas suaves interactivo
plot_densidades <- ggplot(data1, aes(x = .data[[talla_column_name]], fill = .data[[regimen_column_name]])) +
geom_density(alpha = 0.6) +
scale_fill_manual(values = color_palette) +
labs(
x = "Talla del recién nacido (centímetros)",
y = "Densidad",
fill = "Régimen",
title = "Densidad de la talla al nacer según régimen de seguridad social"
) +
theme_minimal() +
theme(legend.position = "top")
plotly_densidades <- ggplotly(plot_densidades, tooltip = c("x", "y", "fill"))
# Mostrar los gráficos interactivos
plotly_overlayContributivo y Subsidiado muestran las distribuciones más altas (mayor frecuencia de recién nacidos en tallas normales, alrededor de 45-50 cm). No Asegurado tiene la distribución más baja, lo que sugiere peores resultados en talla al nacer.
Todos los regímenes alcanzan su máxima frecuencia entre 40-50 cm, pero con diferencias en altura: Contributivo tiene el pico más alto (mejores condiciones), no Asegurado tiene el pico más bajo (posibles carencias en acceso a salud o nutrición).
Regímenes Especial y Excepción, se ubican en un punto intermedio, pero con densidad menor que el Contributivo/Subsidiado, sugiriendo coberturas desiguales.
# Gráfico de histograma separado por régimen de seguridad social
library(ggplot2)
library(dplyr) # También es bueno tener dplyr por si haces filtros
library(scales) # Para la función hue_pal()
plot_hist_dens <- ggplot(data1, aes(x = .data[[talla_column_name]], fill = factor(.data[[regimen_column_name]]))) +
geom_histogram(aes(y = ..density..), bins = 30, alpha = 0.8, color = "black") +
scale_fill_manual(values = color_palette) +
labs(
x = "Talla del recién nacido (centímetros)",
y = "Densidad",
fill = "Régimen",
title = "Histograma de la talla al nacer por régimen de seguridad social"
) +
theme_minimal() +
theme(legend.position = "top") +
facet_wrap(~ .data[[regimen_column_name]], scales = "free_y") # Separa los gráficos por categoría
# Mostrar el gráfico
print(plot_hist_dens)No Asegurado y Excepción tienen frecuencias relativamente altas aquí, lo que podría indicar: Carencia de control prenatal adecuado y factores de riesgo como desnutrición materna.
Todos los regímenes muestran su pico entre 45-50 cm, pero la altura del pico varía según la cobertura: A mejor régimen, más alto y estrecho el pico (mayor concentración en tallas óptimas).
# Crear la paleta de colores ANTES del gráfico
num_niveles <- length(unique(df$`REGIMEN SEGURIDAD`))
colores <- scales::hue_pal()(num_niveles) # Esto genera los colores automáticamente
# Crear el boxplot con etiquetas corregidas y texto rotado
boxplot_caso2 <- ggplot(df, aes(x = `REGIMEN SEGURIDAD`, y = `TALLA (CentImetros)`, fill = `REGIMEN SEGURIDAD`)) +
geom_boxplot(outlier.shape = 16, outlier.size = 2, alpha = 0.7) +
scale_fill_manual(values = colores) +
labs(x = "Régimen de Seguridad Social",
y = "Talla al Nacer (centímetros)",
title = "Distribución de la Talla al Nacer por Régimen de Seguridad Social") +
theme_minimal() +
theme(
legend.position = "none",
plot.title = element_text(hjust = 0.5, size = 14, face = "bold"),
axis.text = element_text(size = 12),
axis.title = element_text(size = 13),
axis.text.x = element_text(angle = 45, hjust = 1) # Rotar etiquetas
)
# Mostrar el gráfico
print(boxplot_caso2)Tallas Bajas (<40 cm): Más frecuentes en No Asegurado y Excepción, lo que sugiere falta de control prenatal o condiciones socioeconómicas adversas.
Tallas Altas (>50 cm): Dominadas por Contributivo, posiblemente por mejor nutrición y seguimiento médico.
El gráfico confirma una relación directa entre nivel de cobertura y talla neonatal: Contributivo (mejor acceso) > Subsidiado > Excepción/Especial > No Asegurado (sin acceso).
# Cargar las librerías necesarias
library(ggplot2)
library(dplyr)
library(readr)
library(plotly) # Para interactividad
# Leer el archivo de datos
data1 <- read_delim("Nacimientos_Hospital_Medellin.csv", delim = ";", col_types = cols())
# Asegurarse de que la variable REGIMEN SEGURIDAD es un factor
data1$`REGIMEN SEGURIDAD` <- as.factor(data1$`REGIMEN SEGURIDAD`)
# Definir los breaks automáticos usando hist() sobre la Talla
breaks_auto <- hist(data1$`TALLA (CentImetros)`, plot = FALSE)$breaks
# Calcular las frecuencias acumuladas para cada nivel de REGIMEN SEGURIDAD
cumulative_data <- lapply(levels(data1$`REGIMEN SEGURIDAD`), function(lvl) {
subset_data <- data1 %>% filter(`REGIMEN SEGURIDAD` == lvl)
hist_obj <- hist(subset_data$`TALLA (CentImetros)`, breaks = breaks_auto, plot = FALSE)
midpoints <- hist_obj$mids
cum_vals <- cumsum(hist_obj$counts) / sum(hist_obj$counts)
data.frame(
REGIMEN_SEGURIDAD = lvl,
x = midpoints,
cumulative = cum_vals
)
})
cumulative_data <- do.call(rbind, cumulative_data)
# Graficar las ojivas con ggplot y convertirlo a interactivo
plot_ojivas <- ggplot(cumulative_data, aes(x = x, y = cumulative, color = REGIMEN_SEGURIDAD, group = REGIMEN_SEGURIDAD,
text = paste("Talla:", round(x,1),
"<br>Frecuencia acumulada:", scales::percent(cumulative, accuracy = 0.1),
"<br>Régimen:", REGIMEN_SEGURIDAD))) +
geom_step(size = 1.2) +
scale_color_brewer(palette = "Set3") +
labs(
x = "Talla al nacer (centímetros)",
y = "Frecuencia acumulada",
title = "Ojivas de Talla al Nacer según Régimen de Seguridad Social",
color = "Régimen"
) +
theme_minimal() +
theme(legend.position = "top")
# Convertir a gráfico interactivo con tooltip personalizado
plotly_ojivas <- ggplotly(plot_ojivas, tooltip = "text")
# Mostrar el gráfico interactivo
plotly_ojivasEl régimen Subsidiado y Contributivo presentan una distribución muy parecida hasta el percentil 50% (mediana) Observando las pendientes de las ojivas, cerca del punto medio (aprox. 47-48 cm), los regímenes Subsidiado y Contributivo alcanzan el 50% de los nacimientos casi al mismo nivel de talla, lo que indica que la mediana de talla al nacer es similar entre ambos grupos.
Los regímenes Especial, Excepción y No Asegurado presentan una ligera tendencia a tener tallas ligeramente más bajas en los percentiles inferiores En los primeros tramos (percentil 25% o primer cuartil), las ojivas de estos regímenes empiezan a acumular casos desde tallas más bajas (alrededor de 38-40 cm), lo que sugiere que hay una proporción mayor de niños con tallas más pequeñas en estos regímenes comparados con Contributivo y Subsidiado.
En el percentil 75% (tercer cuartil), todas las ojivas tienden a converger A partir de los 49-50 cm (percentil 75%), todas las curvas tienden a acercarse, indicando que las diferencias entre regímenes desaparecen en los recién nacidos con tallas más altas. Esto sugiere que las diferencias se concentran en la parte baja de la distribución, mientras que en la parte superior, todas las poblaciones presentan tallas similares.
El régimen de seguridad social determina de cierta manera la talla al nacer, los recién nacidos del régimen contributivo presentan las mejores tallas (distribución concentrada en 45-50 cm, menor frecuencia de tallas bajas y atípicos). Los no asegurados tienen los peores resultados: mayor proporción de tallas críticas (<40 cm), alta variabilidad y más valores atípicos.
Desigualdad sistémica en salud neonatal: Existe un gradiente claro: Contributivo > Subsidiado > Especial/Excepción > No Asegurado.La brecha no es solo en tallas promedio, sino en riesgo de extremos (ej. 25% de no asegurados con tallas <40 cm vs. <5% en contributivo).
La talla al nacer es un termómetro de inequidad: refleja directamente las condiciones de acceso a salud. Políticas que universalicen la cobertura prenatal podrían reducir estas brechas.