# Cargar librerías necesarias
library(psych)
library(knitr)
library(dplyr)
library(forcats)
library(kableExtra)
library(scales)
library(tidyr)
library(RColorBrewer)
library(ggsci)
library(patchwork)
library(ggthemes)
library(readxl)
library(tidyverse)
library(lubridate)
library(forecast)
library(tseries)
library(ggplot2)
library(fitdistrplus)
library(sf)
library(sp)
library(viridis)
library(ggspatial)
library(spdep)
library(tmap)
library(vegan)
library(stringi)
library(geodata)
La violencia sexual constituye una grave vulneración de los derechos humanos con profundas repercusiones en la salud física y mental de las víctimas, representando además un serio problema de salud pública. En el territorio colombiano, la presencia de análisis estadísticos que desagreguen la información por grupos etarios es importante para contribuir en la comprensión integral del fenómeno y el diseño de políticas públicas efectivas. Este proyecto se justifica en la necesidad de caracterizar la tendencia temporal de los exámenes médico-legales por presunto delito sexual entre los meses correspondientes de 2015 hasta 2024, con un enfoque diferencial que permita comparar la dinámica en menores y mayores de edad. El análisis de series de tiempo que se propone, utilizando datos oficiales del Instituto Nacional de Medicina Legal, busca identificar patrones, estacionalidades y puntos de inflexión en la ocurrencia de estos eventos, generando evidencia crucial para la focalización de estrategias de prevención y la implementación de intervenciones oportunas, contribuyendo así a la construcción de un sistema de respuesta más eficiente a las particularidades de cada grupo poblacional afectado.
#Descargar shapefile de Colombia (nivel 1 = departamentos)
#Nivel 0 = país, Nivel 1 = departamentos, Nivel 2 = municipios
colombia_departamentos <- gadm(country = "COL", level = 1, path = tempdir())
#Convertir a objeto sf (simple features)
colombia_sf <- st_as_sf(colombia_departamentos)
#Ver estructura de la base
#print(colombia_sf)
Para el desarrollo de este estudio se utilizó la base de datos oficial “Exámenes médico legales por presunto delito sexual. Colombia, años 2015 a 2024. Cifras definitivas”, suministrada por el Instituto Nacional de Medicina Legal y Ciencias Forenses, la cual comprende un total de 233,352 observaciones correspondientes a casos individuales de exámenes practicados -donde cada fila representa un caso único-, estructurada en 32 variables que recopilan información demográfica, geográfica y contextual de cada evento. Para los fines específicos de este análisis de series temporales, se realizó una selección estratégica de tres variables clave: “Año del hecho”, “Mes del hecho” que permiten la agregación temporal de los casos, y “Grupo Mayor Menor de Edad”, variable categórica fundamental que discrimina entre víctimas “Mayor de Edad (>18 Años)” y “Menor de Edad (<18 Años)”, identificándose únicamente 2 casos sin información de grupo etario durante todo el periodo de estudio. A partir de la frecuencia mensual de estas categorías se calcularon estadísticos descriptivos y se construyeron las visualizaciones que sustentan el análisis comparativo de las tendencias temporales entre ambos grupos poblacionales a lo largo del periodo estudiado.
# Cargar base
Examenes_medico_legales <- read_excel("Examenes_medico_legales.xlsx")
glimpse(Examenes_medico_legales)
## Rows: 233,352
## Columns: 32
## $ ID <chr> "1", "2", "3", "4", "5", "6", "7",…
## $ `Año del hecho` <chr> "2015", "2015", "2015", "2015", "2…
## $ `Sexo de la victima` <chr> "Hombre", "Hombre", "Mujer", "Muje…
## $ `Grupo de Edad Quinquenal` <chr> "(00 a 04)", "(05 a 09)", "(05 a 0…
## $ `Grupo Mayor Menor de Edad` <chr> "a) Menor de Edad (<18 Años)", "a)…
## $ `Grupo de Edad judicial` <chr> "(00 a 04)", "(05 a 09)", "(05 a 0…
## $ `Ciclo Vital` <chr> "(00 a 05) Primera Infancia", "(00…
## $ `País de Nacimiento` <chr> "Colombia", "Colombia", "Colombia"…
## $ Escolaridad <chr> "Ninguna", "Preescolar", "Preescol…
## $ `Estado Civil` <chr> "No aplica", "No aplica", "No apli…
## $ `Tipo de Discapacidad` <chr> "Ninguna", "Ninguna", "Ninguna", "…
## $ `Pertenencia Étnica` <chr> "Sin información", "Sin pertenenci…
## $ `Orientación Sexual` <chr> "No aplica", "No aplica", "No apli…
## $ `Identidad de Género` <chr> "No aplica", "No aplica", "No apli…
## $ Transgénero <chr> "No aplica", "No aplica", "No apli…
## $ `Pertenencia Grupal` <chr> "Sin información", "Sin informació…
## $ `Mes del hecho` <chr> "Junio", "Agosto", "Febrero", "Jun…
## $ `Dia del hecho` <chr> "miércoles", "jueves", "miércoles"…
## $ `Rango de Hora del Hecho X 3 Horas` <chr> "(12:00 a 14:59)", "(12:00 a 14:59…
## $ `Código Dane Municipio` <chr> "25307", "54001", "8001", "63401",…
## $ `Municipio del hecho DANE` <chr> "Girardot", "Cúcuta", "Barranquill…
## $ `Departamento del hecho DANE` <chr> "Cundinamarca", "Norte de Santande…
## $ `Código Dane Departamento` <chr> "25", "54", "8", "63", "52", "8", …
## $ `Localidad del Hecho` <chr> "Sin información", "Sin informació…
## $ `Zona del Hecho` <chr> "Cabecera municipal", "Cabecera mu…
## $ `Escenario del Hecho` <chr> "Centros Educativos", "Vivienda", …
## $ `Actividad Durante el Hecho` <chr> "Actividades relacionadas con la a…
## $ `Circunstancia del Hecho Detallada` <chr> "Abuso sexual", "Abuso sexual", "A…
## $ `Contexto del Hecho` <chr> "2 Exámenes Medicolegales por Pres…
## $ `Sexo del Agresor` <chr> "Hombre", "Hombre", "Mujer", "Homb…
## $ `Presunto Agresor Detallado` <chr> "Agresor desconocido", "Vecino", "…
## $ `Pueblo Indígena` <chr> "No había sido implementada", "No …
Esta sección presenta la distribución geográfica de los exámenes médico-legales por presunto delito sexual en Colombia durante el período 2015-2024. La visión general a escala departamental resulta fundamental para contextualizar las dinámicas temporales que se analizarán en detalle, ya que evidencia cómo la distribución geográfica de los casos de estudio en menores y mayores de edad presenta heterogeneidades o homogeneidades regionales que proporcionan la comprensión integral del fenómeno.
# 1. Calcular la frecuencia de casos por departamento para mayores de edad
frecuencia_departamentos_mayores <- Examenes_medico_legales %>%
filter(`Grupo Mayor Menor de Edad` == "b) Mayor de Edad (>18 Años)") %>%
count(`Departamento del hecho DANE`, name = "Casos_Mayores") %>%
rename(NAME_1 = `Departamento del hecho DANE`)
# 2. Unir los datos de frecuencia con el objeto espacial
colombia_con_datos_mayores <- colombia_sf %>%
left_join(frecuencia_departamentos_mayores, by = "NAME_1")
# 1. Calcular la frecuencia de casos por departamento para menores de edad
frecuencia_departamentos_menores <- Examenes_medico_legales %>%
filter(`Grupo Mayor Menor de Edad` == "a) Menor de Edad (<18 Años)") %>%
count(`Departamento del hecho DANE`, name = "Casos_Menores") %>%
rename(NAME_1 = `Departamento del hecho DANE`)
# 2. Unir los datos de frecuencia con el objeto espacial
colombia_con_datos <- colombia_sf %>%
left_join(frecuencia_departamentos_menores, by = "NAME_1")
# 3. Crear el mapa
# Crear ambos mapas para comparación
mapa_menores <- tm_shape(colombia_con_datos) +
tm_polygons("Casos_Menores",
title = "Casos en Menores",
style = "quantile",
palette = "Reds",
n = 5,
border.col = "white") +
tm_layout(
legend.outside = FALSE,
frame = FALSE)
mapa_mayores <- tm_shape(colombia_con_datos_mayores) +
tm_polygons("Casos_Mayores",
title = "Casos en Mayores",
style = "quantile",
palette = "Blues",
n = 5,
border.col = "white") +
tm_layout(
legend.outside = FALSE,
frame = FALSE)
# Primero crear el objeto del mapa combinado
mapa_combinado <- tmap_arrange(mapa_menores, mapa_mayores,
ncol = 2,
outer.margins = 0)
# Guardar como JPG
#tmap_save(mapa_combinado,
# filename = "mapa_menores_mayores.jpg",
# width = 12, # Ancho en pulgadas
# height = 6, # Alto en pulgadas
# dpi = 300) # Calidad de imagen
print(frecuencia_departamentos_mayores)
## # A tibble: 34 × 2
## NAME_1 Casos_Mayores
## <chr> <int>
## 1 Amazonas 87
## 2 Antioquia 4390
## 3 Arauca 321
## 4 Atlántico 1339
## 5 Bogotá D.C. 6948
## 6 Bolívar 1320
## 7 Boyacá 1154
## 8 Caldas 724
## 9 Caquetá 471
## 10 Casanare 584
## # ℹ 24 more rows
print(frecuencia_departamentos_menores)
## # A tibble: 34 × 2
## NAME_1 Casos_Menores
## <chr> <int>
## 1 Amazonas 746
## 2 Antioquia 21402
## 3 Arauca 2299
## 4 Atlántico 9347
## 5 Bogotá D.C. 35273
## 6 Bolívar 7613
## 7 Boyacá 5127
## 8 Caldas 4235
## 9 Caquetá 2943
## 10 Casanare 3493
## # ℹ 24 more rows
La distribución geográfica evidencia una marcada concentración de los casos en seis departamentos específicos: Antioquia, Valle del Cauca, Tolima, Cundinamarca, Santander y Atlántico, los cuales presentaron las frecuencias más elevadas tanto para menores como para mayores de edad. Este patrón espacial sugiere la existencia de factores territoriales comunes que trascienden las diferencias etarias, posiblemente asociados a dinámicas poblacionales, condiciones socioeconómicas particulares o capacidades institucionales diferenciadas en la ruta de atención a víctimas.
Se presenta el comportamiento temporal anual de los exámenes médico-legales por presunto delito sexual en Colombia durante el período 2015-2024, desagregado por grupos etarios. Se evidencia la evolución comparativa de los casos en menores y mayores de edad, permitiendo identificar quizás tendencias, puntos de inflexión o patrones para este estudio a lo largo del periodo.
# 1. Conteo anual básico por grupos
conteo_anual_grupos <- Examenes_medico_legales %>%
count(`Año del hecho`, `Grupo Mayor Menor de Edad`) %>%
arrange(`Año del hecho`)
print(conteo_anual_grupos)
## # A tibble: 21 × 3
## `Año del hecho` `Grupo Mayor Menor de Edad` n
## <chr> <chr> <int>
## 1 2015 a) Menor de Edad (<18 Años) 19181
## 2 2015 b) Mayor de Edad (>18 Años) 2974
## 3 2016 a) Menor de Edad (<18 Años) 18416
## 4 2016 b) Mayor de Edad (>18 Años) 2983
## 5 2017 a) Menor de Edad (<18 Años) 20663
## 6 2017 b) Mayor de Edad (>18 Años) 3135
## 7 2018 a) Menor de Edad (<18 Años) 22794
## 8 2018 b) Mayor de Edad (>18 Años) 3271
## 9 2019 a) Menor de Edad (<18 Años) 22613
## 10 2019 b) Mayor de Edad (>18 Años) 3545
## # ℹ 11 more rows
# 2. Visualización combinada (barras + líneas + puntos)
ggplot(conteo_anual_grupos,
aes(x = as.factor(`Año del hecho`), y = n,
fill = `Grupo Mayor Menor de Edad`,
group = `Grupo Mayor Menor de Edad`)) +
# Barras
geom_bar(stat = "identity", position = "dodge", alpha = 0.7) +
# Líneas que conectan los puntos
geom_line(aes(color = `Grupo Mayor Menor de Edad`),
position = position_dodge(0.9), size = 1) +
# Puntos en cada barra
geom_point(aes(color = `Grupo Mayor Menor de Edad`),
position = position_dodge(0.9), size = 3) +
# Personalizar colores (puedes cambiar estos códigos de color)
scale_fill_manual(values = c("a) Menor de Edad (<18 Años)" = "lightcoral",
"b) Mayor de Edad (>18 Años)" = "lightblue")) +
scale_color_manual(values = c("a) Menor de Edad (<18 Años)" = "darkred",
"b) Mayor de Edad (>18 Años)" = "darkblue")) +
labs(title = "Exámenes médico-legales por presunto delito sexual",
subtitle = "Colombia 2015-2024",
x = "Año",
y = "Número de exámenes",
fill = "Grupo de edad",
color = "Grupo de edad") +
theme_minimal() +
theme(legend.position = "top")
El análisis de frecuencia anual reveló evidencias temporales diferenciados entre los grupos etarios. Para los menores de edad, se identificaron picos significativos en los años 2018, 2019 y 2022, sugiriendo periodos de mayor vulnerabilidad o mejora en los sistemas de detección y reporte. En contraste, los mayores de edad presentaron sus valores más altos en años más recientes (2022, 2023 y 2024), indicando que ultimamente existió una tendencia creciente en la victimización de este grupo poblacional. Es importante anotar que en general, se evidenciaron 196850 casos en el grupo de menores de edad y 36500 casos para el grupo de mayores de edad en el período de estudio.
Notablemente, ambos grupos experimentaron una disminución coincidente en el año 2020, esto asociado a las restricciones, cambios y circunstancias asociadas durante la pandemia por COVID-19 (Betancourt, 2022).
Esta sección constituye el análisis temporal al desagregar la información a nivel mensual, permitiendo una caracterización detallada del comportamiento de los casos a lo largo de los 120 meses del período de estudio. Mediante estadísticos descriptivos, diagramas de caja e histogramas de densidad, se estudia la variabilidad, distribución y patrones de los exámenes médico-legales para cada grupo etario. El análisis mensual revela la estructura interna de los comportamientos anuales previamente identificados, destacando fluctuaciones, concentraciones que permanecen ocultas en las agregaciones anuales, proporcionando así una comprensión más detallada de la dinámica de los exámenes médico-legales por presunto delito sexual en Colombia.
# Preparar datos en formato ancho MENSUAL
datos_ancho_mensual <- Examenes_medico_legales %>%
group_by(`Año del hecho`, `Mes del hecho`, `Grupo Mayor Menor de Edad`) %>%
summarise(Casos = n(), .groups = 'drop') %>%
pivot_wider(
names_from = `Grupo Mayor Menor de Edad`,
values_from = Casos,
values_fill = 0
) %>%
rename(
Año = `Año del hecho`,
Mes = `Mes del hecho`,
Menores = `a) Menor de Edad (<18 Años)`,
Mayores = `b) Mayor de Edad (>18 Años)`
)
# Ordenar los meses correctamente
meses_orden <- c("Enero", "Febrero", "Marzo", "Abril", "Mayo", "Junio",
"Julio", "Agosto", "Septiembre", "Octubre", "Noviembre", "Diciembre")
datos_ancho_mensual <- datos_ancho_mensual %>%
mutate(Mes = factor(Mes, levels = meses_orden)) %>%
arrange(Año, Mes)
# Ver la estructura de los datos mensuales
print(head(datos_ancho_mensual, 12))
## # A tibble: 12 × 5
## Año Mes Menores Mayores `c) Sin información`
## <chr> <fct> <int> <int> <int>
## 1 2015 Enero 1664 250 0
## 2 2015 Febrero 1801 281 0
## 3 2015 Marzo 1883 290 0
## 4 2015 Abril 1767 296 0
## 5 2015 Mayo 1799 269 0
## 6 2015 Junio 1596 224 0
## 7 2015 Julio 1648 245 0
## 8 2015 Agosto 1783 270 0
## 9 2015 Septiembre 1659 230 0
## 10 2015 Octubre 1498 239 0
## 11 2015 Noviembre 1209 206 0
## 12 2015 Diciembre 874 174 0
A continuación se proporciona las medidas fundamentales de tendencia central y dispersión que caracterizan la distribución mensual de los casos para cada grupo etario. A través de estadísticos como media, mediana, desviación estándar y medidas de forma, se establece el perfil numérico base que permite comprender la variabilidad y comportamiento general de los exámenes médico-legales a lo largo del período de estudio, sentando las bases para las interpretaciones gráficas posteriores.
df_menores_mensual <- data.frame(
Grupo = "Menores de Edad",
Casos = datos_ancho_mensual$Menores
)
df_mayores_mensual <- data.frame(
Grupo = "Mayores de Edad",
Casos = datos_ancho_mensual$Mayores
)
# Función personalizada para calcular estadísticas (la misma)
mi_describe <- function(x) {
# Calcular moda (función auxiliar)
calcular_moda <- function(v) {
uniqv <- unique(v)
uniqv[which.max(tabulate(match(v, uniqv)))]
}
data.frame(
n = length(x),
mean = round(mean(x), 2),
sd = round(sd(x), 2),
var = round(var(x), 2), # Varianza
moda = calcular_moda(x), # Moda (valor entero)
min = min(x),
max = max(x),
rango = max(x) - min(x), # Rango agregado
median = round(median(x), 2),
skew = round(psych::skew(x), 2),
kurtosis = round(psych::kurtosi(x), 2)
)
}
# Aplicar la función personalizada a datos MENSUALES
resultados_mensuales <- data.frame(
Grupo = c("Menores", "Mayores")
) %>%
cbind(
bind_rows(
mi_describe(datos_ancho_mensual$Menores),
mi_describe(datos_ancho_mensual$Mayores)
)
)
# Mostrar resultados mensuales
print(resultados_mensuales)
## Grupo n mean sd var moda min max rango median skew kurtosis
## 1 Menores 120 1640.42 288.0 82946.67 1493 648 2219 1571 1662 -0.56 0.52
## 2 Mayores 120 304.17 68.6 4705.72 256 120 450 330 294 0.13 -0.68
El análisis descriptivo mensual para menores de edad revela un promedio de 1640 casos mensuales con una mediana de 1662, indicando una distribución ligeramente concentrada en valores altos. La desviación estándar de 288 casos y el amplio rango de 1571 evidencian una variabilidad significativa entre meses, confirmada por el coeficiente de asimetría de -0.56 que señala una cola hacia valores bajos. La curtosis de 0.52 indica una distribución más puntiaguda que la normal, mientras que la moda en 1493 casos (por debajo de la media) sugiere meses frecuentes con menor incidencia. Estos resultados, destacan la necesidad de implementar estrategias diferenciadas que consideren esta variabilidad mensual, particularmente para los periodos que alcanzan hasta 2219 casos mensuales.
Para el grupo de mayores de edad, el análisis revela un promedio mensual de 304 casos con una mediana de 294, mostrando una distribución algo simétrica confirmada por el coeficiente de asimetría de 0.13. La desviación estándar de 68.6 casos y el rango de 330 reflejan una variabilidad moderada pero significativa. La curtosis negativa de -0.68 indica una distribución más aplanada que la normal, con datos menos concentrados alrededor del promedio, mientras que la moda en 256 casos (inferior a la media) sugiere la presencia de meses con incidencia particularmente baja. Estos resultados, evidencian un patrón de victimización más estable pero con dispersión amplia que requiere atención en los meses que alcanzan hasta 450 casos.
Se analiza la relación lineal entre los casos mensuales de menores y mayores de edad mediante el coeficiente de correlación de Pearson, el cual cuantifica la dirección y fuerza de asociación entre ambas variables, con valores que oscilan entre -1 (correlación negativa perfecta) y +1 (correlación positiva perfecta), teniendo en cuenta a cero como correlación nula. La aplicación de esta medida es fundamental para determinar si existen patrones temporales compartidos entre los grupos etarios, lo que permitiría identificar factores de riesgo comunes o diferenciados en la victimización sexual.
# Calcular correlación entre menores y mayores
correlacion <- cor(df_menores_mensual$Casos, df_mayores_mensual$Casos, method = "pearson")
cat("CORRELACIÓN ENTRE GRUPOS \n")
## CORRELACIÓN ENTRE GRUPOS
cat("Coeficiente de correlación (r):", round(correlacion, 4), "\n")
## Coeficiente de correlación (r): 0.3647
# Gráfico de dispersión básico
plot(df_menores_mensual$Casos, df_mayores_mensual$Casos,
main = "Relación entre Casos Mensuales de Menores y Mayores",
xlab = "Casos en Menores de Edad",
ylab = "Casos en Mayores de Edad",
pch = 19, col = "darkblue", cex = 0.7)
# Agregar línea de tendencia (regresión lineal)
abline(lm(df_mayores_mensual$Casos ~ df_menores_mensual$Casos),
col = "red", lwd = 1)
# Agregar grid
grid()
# Agregar texto con el coeficiente de correlación
text(x = max(df_menores_mensual$Casos) * 0.7,
y = max(df_mayores_mensual$Casos) * 0.9,
labels = paste("r =", round(correlacion, 4)),
col = "black", cex = 0.7)
Se identifica una correlación positiva débil (\(r = 0.3647\)) entre los casos mensuales de menores y mayores de edad, indicando que existe una tendencia leve a que cuando aumentan los exámenes médico-legales en un grupo, también lo hagan en el otro, aunque esta relación no es fuerte. El coeficiente de determinación (\(r^2 = 0.133\)) revela que solo el 13.3% de la variabilidad en los casos de mayores de edad puede explicarse por la variación en los casos de menores, sugiriendo que ambos grupos presentan dinámicas predominantemente independientes y están influenciados por factores de riesgo diferenciados.
En esta sección complementa el análisis descriptivo mediante visualizaciones que revelan la estructura distribucional de los casos mensuales en menores de edad. El boxplot evidencia la dispersión y valores extremos, mientras el histograma de densidad muestra la forma sugerida por los estadísticos de asimetría y curtosis, proporcionando una comprensión gráfica integral de la variabilidad temporal del fenómeno.
# Diagrama de caja con más detalles
boxplot(datos_ancho_mensual$Menores,
main = "Exámenes Médico-Legales - Menores de Edad\nDatos Mensuales 2015-2024",
ylab = "Casos mensuales",
col = "lightcoral",
border = "darkred",
boxwex = 0.6, #tamaño de la caja
cex.main = 1.1,
cex.lab = 1.0,
horizontal = TRUE)
# Agregar grid
grid()
# Agregar puntos de datos (similar a jitter)
stripchart(datos_ancho_mensual$Menores,
method = "jitter",
add = TRUE,
vertical = F,
pch = 20,
col = rgb(0, 0, 0, 0.2), # Azul semitransparente
cex = 0.8)
El diagrama de caja confirma la significativa variabilidad mensual en los casos de menores de edad, evidenciando un rango intercuartílico amplio que concentra el 50% central de los datos entre 1490 (Q1) y 1830 (Q3) casos mensuales. La presencia de valores atípicos por debajo de 1000 casos y la mediana ligeramente desplazada hacia el cuartil superior reflejan la asimetría negativa previamente identificada (-0.56), indicando meses recurrentes con baja incidencia que contrastan con la tendencia general de alta actividad. Esta dispersión sustancial justifica la necesidad de considerar la variabilidad mensual en el diseño de estrategias de atención y prevención.
# Histograma con curva de densidad para datos MENSUALES
ggplot(df_menores_mensual, aes(x = Casos)) +
geom_histogram(aes(y = ..density..),
bins = 15, # Más bins para datos mensuales
fill = "lightcoral",
color = "darkred",
alpha = 0.7) +
geom_density(alpha = 0.3, fill = "red", color = "darkred", size = 1) +
geom_vline(aes(xintercept = mean(Casos)),
color = "blue", linetype = "dashed", size = 1) +
geom_vline(aes(xintercept = median(Casos)),
color = "green", linetype = "dashed", size = 1) +
labs(title = "Distribución de Frecuencia - Menores de Edad",
subtitle = "Datos Mensuales 2015-2024 | Línea azul: Media | Línea verde: Mediana",
x = "Número de casos mensuales",
y = "Densidad") +
theme_minimal() +
theme(plot.title = element_text(face = "bold", hjust = 0.5))
A partir de este histograma con curva de densidad es importante conocer la distribución probabilística que mejor describe el comportamiento de los datos, comparando múltiples distribuciones teóricas frente a la distribución observada. Para seleccionar la distribución óptima, se pueden emplear los criterios de información AIC (Akaike Information Criterion) y BIC (Bayesian Information Criterion), que evalúan la calidad del ajuste penalizando la complejidad del modelo, donde valores más bajos indican mejor equilibrio en bondad de ajuste.
Mediante la función “fitdist” del paquete “fitdistrplus” realiza el ajuste de distribuciones probabilísticas a un conjunto de datos mediante el método de máxima verosimilitud, que encuentra los parámetros de cada distribución que maximizan la probabilidad de observar los datos reales. El proceso compara sistemáticamente distribuciones teóricas con la distribución empírica de los datos, estimando para cada una sus parámetros óptimos y calculando medidas de bondad de ajuste como AIC y BIC. Esta metodología permite identificar objetivamente qué distribución describe mejor el comportamiento de los datos, proporcionando las bases para análisis y pronósticos en el estudio de series temporales.
Dado que las frecuencias mensuales de exámenes médico-legales en este estudio alcanzan valores en el orden de centenas y miles, el uso de distribuciones discretas como la Poisson o la binomial negativa no resulta adecuado. Estas distribuciones están diseñadas para modelar conteos de eventos poco frecuentes, mientras que en este caso los valores son suficientemente grandes para aproximarse al comportamiento de una variable continua. Por ello, resulta más apropiado emplear distribuciones continuas como la normal, gamma, weibull o lognormal, que permiten describir de mejor manera la variabilidad y la posible asimetría en los niveles mensuales de casos observados.
A continuación se evidencia los valores AIC y BIC para analizar y ver el ajuste con distribuciones continuas teniendo presente lo anteriormente descrito y explicado.
# Distribuciones a evaluar
fit_norm <- fitdist(df_menores_mensual$Casos, "norm")
fit_lnorm <- fitdist(df_menores_mensual$Casos, "lnorm")
fit_gamma <- fitdist(df_menores_mensual$Casos, "gamma")
fit_weibull <- fitdist(df_menores_mensual$Casos, "weibull")
fit_logis <- fitdist(df_menores_mensual$Casos, "logis")
comparacion <- data.frame(
Distribucion = c("Normal", "Log-Normal", "Gamma", "Weibull", "Logística"),
AIC = c(fit_norm$aic, fit_lnorm$aic, fit_gamma$aic, fit_weibull$aic, fit_logis$aic),
BIC = c(fit_norm$bic, fit_lnorm$bic, fit_gamma$bic, fit_weibull$bic, fit_logis$bic)
)
print(comparacion[order(comparacion$AIC), ])
## Distribucion AIC BIC
## 4 Weibull 1696.830 1702.405
## 5 Logística 1701.483 1707.058
## 1 Normal 1702.655 1708.230
## 3 Gamma 1715.636 1721.211
## 2 Log-Normal 1725.114 1730.689
denscomp(list(fit_norm, fit_lnorm, fit_gamma, fit_weibull),
legendtext = c("Normal", "Log-Normal", "Gamma", "Weibull"),
main = "Comparación de Densidades Ajustadas - Menores de Edad",
xlab = "Número de casos mensuales",
ylab = "Densidad")
El análisis de ajuste distribucional indica y muestra que la distribución Weibull es la que mejor se adapta a los datos mensuales de menores de edad, con el AIC más bajo (1696.83) y BIC más bajo (1702.41). Le siguen muy de cerca las distribuciones Logística (AIC: 1701.48) y Normal (AIC: 1702.66), mientras que las distribuciones Gamma y Log-Normal presentan ajustes significativamente inferiores.
# Diagrama de caja con más detalles
boxplot(datos_ancho_mensual$Mayores,
main = "Exámenes Médico-Legales - Mayores de Edad\nDatos Mensuales 2015-2024",
ylab = "Casos mensuales",
col = "lightblue",
border = "darkblue",
boxwex = 0.5,
cex.main = 1.1,
cex.lab = 1.0,
horizontal = TRUE)
# Agregar grid
grid()
# Agregar puntos de datos (similar a jitter)
stripchart(datos_ancho_mensual$Mayores,
method = "jitter",
add = TRUE,
vertical = F,
pch = 20,
col = rgb(0, 0, 0, 0.2), # Azul semitransparente
cex = 0.8)
El diagrama de caja para mayores de edad revela una distribución con menor variabilidad relativa en comparación con el grupo de menores, mostrando un rango intercuartílico compacto que concentra el 50% central de los datos entre 255.5 (Q1) y 365 (Q3) casos mensuales. La posición casi central de la mediana y la cercana simetría en la dispersión de los bigotes confirman el coeficiente de asimetría cercano a cero (0.13) previamente calculado. La presencia de valores hacia el extremo superior, alcanzando hasta 450 casos mensuales, sugiere la ocurrencia periódica de meses con incidencia excepcionalmente alta dentro de una tendencia general más estable y predecible.
# Histograma con curva de densidad para MAYORES MENSUAL
ggplot(df_mayores_mensual, aes(x = Casos)) +
geom_histogram(aes(y = ..density..),
bins = 15, # Más bins para datos mensuales
fill = "lightblue",
color = "darkblue",
alpha = 0.7) +
geom_density(alpha = 0.3, fill = "blue", color = "darkblue", size = 1) +
geom_vline(aes(xintercept = mean(Casos)),
color = "red", linetype = "dashed", size = 1) +
geom_vline(aes(xintercept = median(Casos)),
color = "orange", linetype = "dashed", size = 1) +
labs(title = "Distribución de Frecuencia - Mayores de Edad",
subtitle = "Datos Mensuales 2015-2024 | Línea roja: Media | Línea naranja: Mediana",
x = "Número de casos mensuales",
y = "Densidad") +
theme_minimal() +
theme(plot.title = element_text(face = "bold", hjust = 0.5))
Ahora bien, partiendo de este histograma con curva de densidad se determina la distribución probabilística que mejor describe el comportamiento de los casos mensuales en mayores de edad mediante la función fitdist, evaluando distribuciones continuas (Normal, Log-Normal, Gamma, Weibull, Logística). Este análisis permitirá identificar el modelo teórico que más se ajusta a los datos observados, fundamentando inferencias estadísticas sobre exámenes médico-legales por presunto delito sexual en la población adulta.
# Distribuciones continuas a evaluar para MAYORES
fit_norm_mayores <- fitdist(df_mayores_mensual$Casos, "norm")
fit_lnorm_mayores <- fitdist(df_mayores_mensual$Casos, "lnorm")
fit_gamma_mayores <- fitdist(df_mayores_mensual$Casos, "gamma")
fit_weibull_mayores <- fitdist(df_mayores_mensual$Casos, "weibull")
fit_logis_mayores <- fitdist(df_mayores_mensual$Casos, "logis")
# Comparar para mayores
comparacion_mayores <- data.frame(
Distribucion = c("Normal", "Log-Normal", "Gamma", "Weibull", "Logística"),
AIC = c(fit_norm_mayores$aic, fit_lnorm_mayores$aic, fit_gamma_mayores$aic,
fit_weibull_mayores$aic, fit_logis_mayores$aic),
BIC = c(fit_norm_mayores$bic, fit_lnorm_mayores$bic, fit_gamma_mayores$bic,
fit_weibull_mayores$bic, fit_logis_mayores$bic)
)
#print("COMPARACIÓN DISTRIBUCIONES CONTINUAS - MAYORES DE EDAD:")
print(comparacion_mayores[order(comparacion_mayores$AIC), ])
## Distribucion AIC BIC
## 1 Normal 1358.325 1363.900
## 3 Gamma 1358.972 1364.547
## 4 Weibull 1360.377 1365.952
## 2 Log-Normal 1362.484 1368.059
## 5 Logística 1365.243 1370.818
# Comparación de densidades para MAYORES de edad
denscomp(list(fit_norm_mayores, fit_lnorm_mayores, fit_gamma_mayores, fit_weibull_mayores),
legendtext = c("Normal", "Log-Normal", "Gamma", "Weibull"),
main = "Comparación de Densidades Ajustadas - Mayores de Edad",
xlab = "Número de casos mensuales",
ylab = "Densidad")
Para el grupo de mayores de edad, el análisis distribucional revela que la distribución Normal presenta el mejor ajuste entre las distribuciones continuas, seguida muy de cerca por la distribución Gamma. La casi simetría observada en los datos (0.13) explica y complementa el buen desempeño de la distribución Normal como aproximación continua, pero recordando que la Binomial Negativa representa el modelo teóricamente más coherente con la naturaleza del fenómeno estudiado.
Observar primeramente la frecuencia mensual de los casos por cada grupo etario a través de mapas de calor, complementa visualmente la concentración temporal dado los años con sus respectivos meses, aportando así el inicio de lo que podría esperarse en un posterior análisis de series de tiempo.
# Heatmap de frecuencia mensual
ggplot(datos_ancho_mensual, aes(x = Mes, y = as.factor(Año), fill = Menores)) +
geom_tile(color = "white") +
geom_text(aes(label = Menores), color = "black", size = 3) +
scale_fill_gradient(low = "white", high = "darkred", name = "Casos") +
labs(title = "Mapa de Calor - Frecuencia Mensual de Exámenes",
subtitle = "Menores de Edad (2015-2024)",
x = "Mes",
y = "Año") +
theme_minimal() +
theme(plot.title = element_text(face = "bold", hjust = 0.5),
axis.text.x = element_text(angle = 45, hjust = 1))
# Heatmap de frecuencia mensual
ggplot(datos_ancho_mensual, aes(x = Mes, y = as.factor(Año), fill = Mayores)) +
geom_tile(color = "white") +
geom_text(aes(label = Mayores), color = "black", size = 3) +
scale_fill_gradient(low = "white", high = "darkblue", name = "Casos") +
labs(title = "Mapa de Calor - Frecuencia Mensual de Exámenes",
subtitle = "Mayores de Edad (2015-2024)",
x = "Mes",
y = "Año") +
theme_minimal() +
theme(plot.title = element_text(face = "bold", hjust = 0.5),
axis.text.x = element_text(angle = 45, hjust = 1))
Se continúa con la función “ts()” del paquete stats de R, la cual convierte vectores numéricos en objetos de serie temporal mediante la especificación de parámetros de inicio, frecuencia y puntos de tiempo. Esta transformación es fundamental para estructurar los datos mensuales de exámenes médico-legales por presunto delito sexual en un formato temporal reconocible por los algoritmos de análisis de series, permitiendo la identificación de patrones estacionales, tendencias y la aplicación de modelos predictivos ARIMA. La función se implementa tanto para el grupo de menores como para mayores de edad, estableciendo como punto de inicio enero de 2015 con frecuencia mensual.
# Crear series de tiempo MENSUALES separadas para cada grupo
series_mensuales <- Examenes_medico_legales %>%
group_by(`Año del hecho`, `Mes del hecho`, `Grupo Mayor Menor de Edad`) %>%
summarise(total_casos = n(), .groups = 'drop') %>%
pivot_wider(
names_from = `Grupo Mayor Menor de Edad`,
values_from = total_casos,
values_fill = 0
)
# Ver la estructura de los datos mensuales
#print(head(series_mensuales, 12))
series_mensuales <- series_mensuales %>%
mutate(`Mes del hecho` = factor(`Mes del hecho`)) %>%
arrange(`Año del hecho`, `Mes del hecho`)
# Crear objetos de serie de tiempo MENSUALES
# Para menores de edad
ts_menores_mensual <- ts(
series_mensuales$`a) Menor de Edad (<18 Años)`,
start = c(2015, 1), # Año 2015, mes 1 (Enero)
frequency = 12 # 12 meses por año
)
# Para mayores de edad
ts_mayores_mensual <- ts(
series_mensuales$`b) Mayor de Edad (>18 Años)`,
start = c(2015, 1),
frequency = 12
)
# Verificar la estructura
print(ts_menores_mensual)
## Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
## 2015 1767 1783 874 1664 1801 1648 1596 1883 1799 1209 1498 1659
## 2016 1605 1665 1187 1493 1563 1638 1579 1673 1617 1348 1453 1595
## 2017 1599 1898 1682 1320 1455 1727 1696 1652 1954 1793 1941 1946
## 2018 2066 2219 1280 1577 1741 1967 1860 1807 2177 1831 2202 2067
## 2019 1993 1998 1337 1896 1847 2023 1790 2060 2141 1585 1951 1992
## 2020 648 1136 957 1809 1926 1270 1269 1462 1101 1183 1323 1286
## 2021 1440 1668 1225 1551 1580 1518 1467 1793 1322 1565 1611 1738
## 2022 1926 1913 1268 1686 1757 1701 1870 2143 1977 1614 1777 1863
## 2023 1629 1827 1155 1680 1571 1638 1711 1829 1833 1456 1674 1762
## 2024 1739 1480 1009 1609 1496 1493 1367 1660 1731 1390 1554 1547
print(ts_mayores_mensual)
## Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
## 2015 296 270 174 250 281 245 224 290 269 206 239 230
## 2016 250 277 211 259 276 256 237 247 264 213 256 237
## 2017 239 261 312 222 247 268 261 238 275 306 253 253
## 2018 280 275 262 271 256 272 256 260 299 254 323 263
## 2019 286 327 265 293 281 293 307 336 281 265 295 316
## 2020 120 220 200 343 314 215 206 210 163 244 232 217
## 2021 330 331 318 371 322 376 312 322 368 337 364 376
## 2022 382 418 304 415 406 337 379 450 413 350 380 376
## 2023 390 342 298 427 435 392 377 440 390 334 356 403
## 2024 380 416 325 436 408 372 386 381 391 353 355 384
# Menores de edad - serie mensual
plot(ts_menores_mensual, type = "o", lwd = 1.5,
main = "Menores de Edad (<18 años) - Serie Mensual",
ylab = "Casos", col = "darkred",
xlab = "Año", cex = 0.7)
axis(1, at = 2015:2024, labels = 2015:2024)
grid()
# Mayores de edad - serie mensual
plot(ts_mayores_mensual, type = "o", lwd = 1.5,
main = "Mayores de Edad (>18 años) - Serie Mensual",
ylab = "Casos", col = "darkblue",
xlab = "Año", cex = 0.7)
axis(1, at = 2015:2024, labels = 2015:2024)
grid()
Para el caso en el Grupo de menores de edad:
# DESCOMPOSICIÓN ADITIVA
decompose_aditivo_menores <- decompose(ts_menores_mensual, type = "a")
decompose_multi_menores <- decompose(ts_menores_mensual, type = "m")
# Gráficos de descomposición aditiva
par(mfrow = c(1, 2))
plot(decompose_aditivo_menores)
plot(decompose_multi_menores)
Dadas las descomposiciones tanto aditivas como multiplicativas, para el caso en los menores de edad se observa que el componente de tendencia de las cifras de los exámenes medico-legales por presunto delito sexual a partir del año 2017 comienza a aumentar, pero en 2020 se va inferiorizando. Inmediantame, en 2021 se aprecia de nuevo un crecimiento hasta 2022. El componente de estacionariedad, evidencia que en los meses fines de año es cuando estos casos crecen y decrecen marcadamente. Mientras, que el componente de ruido situa entre 2020 y 2021 un evento puntual presentado posiblmente por la pandemia de COVID-19.
Para el caso en el Grupo de mayores de edad:
# DESCOMPOSICIÓN MULTIPLICATIVA
decompose_aditivo_mayores <- decompose(ts_mayores_mensual, type = "a")
decompose_multi_mayores <- decompose(ts_mayores_mensual, type = "m")
# Gráficos de descomposición multiplicativa
par(mfrow = c(1, 2))
plot(decompose_aditivo_mayores)
plot(decompose_multi_mayores)
Para las casos en los mayores de edad, el componente de tendencia presenta un aumento de las cifras de los exámenes medico-legales por presunto delito sexual momentos antes de iniciar el año 2021. Sin embargo, de 2022 hasta 2024 se evidencia una tendencia semejantemente plana. El componente de estacionariedad, evidencia que en los meses fines de año es cuando estos casos crecen y decrecen drásticamente. Por último, el componente de ruido situa dos eventos puntuales, uno entre 2017-2018 y otro entre 2020-2021.
Se verifica el supuesto de estacionariedad mediante el test de Kwiatkowski-Phillips-Schmidt-Shin (KPSS), el cual contrasta la hipótesis nula de estacionariedad alrededor de una tendencia. Esta prueba complementaria permite confirmar que las series temporales no presentan componentes de tendencia que comprometan la validez de los modelos de pronóstico (López, 2002).
Hipóstesis del test
\[ \left\{\begin{matrix} H_0: \text{La serie es estacionaria (no tiene raíz unitaria)} \\ H_1: \text{La serie no es estacionaria (tiene raíz unitaria)} \end{matrix}\right.\]
Interpretación del test
Si p-value \(< 0.05\): Se rechaza \(H_0\), es decir, la serie no es estacionaria.
Si p-value \(> 0.05\): No se rechaza \(H_0\), es decir, la serie es estacionaria.
El análisis de estacionariedad es fundamental para garantizar que la media y varianza de los casos se mantengan constantes en el tiempo, permitiendo la aplicación adecuada de metodologías de series temporales.
# Para menores de edad
cat("\n MENORES DE EDAD \n")
##
## MENORES DE EDAD
kpss_menores <- kpss.test(ts_menores_mensual)
print(kpss_menores)
##
## KPSS Test for Level Stationarity
##
## data: ts_menores_mensual
## KPSS Level = 0.16163, Truncation lag parameter = 4, p-value = 0.1
# Para mayores de edad
cat("\n MAYORES DE EDAD \n")
##
## MAYORES DE EDAD
kpss_mayores <- kpss.test(ts_mayores_mensual)
print(kpss_mayores)
##
## KPSS Test for Level Stationarity
##
## data: ts_mayores_mensual
## KPSS Level = 1.8614, Truncation lag parameter = 4, p-value = 0.01
Con el test de KPSS, la serie para los menores de edad es estacionaria dado que su p-value es mayor que \(0.05\) (No se rechaza \(H_0\)). Por otro lado, la serie para los mayores de edad no es estacionaria dado que su p-value es menor que \(0.05\) (Se rechaza \(H_0\)).
Se requiere aplicar diferencia a la serie de los mayores de edad para eliminar componentes no estacionarios, transformándola en serie estacionaria que cumpla con los requisitos necesarios para la implementación de modelos de series temporales.
La función “diff()” aplica diferenciación a una serie temporal calculando las diferencias entre observaciones consecutivas (\(\nabla X_t = X_t-X_{t-1}\)), eliminando así tendencias y componentes no estacionarios. Esta transformación es fundamental cuando el test indica no estacionariedad, ya que convierte la serie en estacionaria al remover dependencias temporales y estabilizar la media. Esto es con el fin de que las series cumplan con los supuestos de estacionariedad requeridos para la aplicación de metodologías en modelamiento de series temporales.
Antes de esto, la función “ndiffs()” del paquete forecast muestra el número de diferencias necesarias para que la serie se vuelva estacionaria.
cat("\n Número de diferencias para que la serie de los menores de edad sea estacionaria \n")
##
## Número de diferencias para que la serie de los menores de edad sea estacionaria
ndif1 <- ndiffs(ts_menores_mensual)
print(ndif1)
## [1] 0
cat("\n Número de diferencias para que la serie de los mayores de edad sea estacionaria \n")
##
## Número de diferencias para que la serie de los mayores de edad sea estacionaria
ndif2 <- ndiffs(ts_mayores_mensual)
print(ndif2)
## [1] 1
Se debe por lo tanto aplicar diferencia a la serie del grupo de mayores de edad.
# Aplicar diferenciación para hacerlas estacionarias
#ts_menores_diff1 <- diff(ts_menores_mensual)
ts_mayores_diff1 <- diff(ts_mayores_mensual)
# Para mayores de edad
cat("\n MAYORES DE EDAD \n")
##
## MAYORES DE EDAD
kpss_mayores1 <- kpss.test(ts_mayores_diff1)
print(kpss_mayores1)
##
## KPSS Test for Level Stationarity
##
## data: ts_mayores_diff1
## KPSS Level = 0.051336, Truncation lag parameter = 4, p-value = 0.1
# Menores de edad - serie mensual
plot(ts_mayores_diff1, type = "o", lwd = 1.5,
main = "Mayores de Edad (>18 años) - Serie Mensual",
ylab = "Casos", col = "darkblue",
xlab = "Año", cex = 0.7)
axis(1, at = 2015:2024, labels = 2015:2024)
grid()
Tras aplicar diferenciación de primer orden, el test de Kwiatkowski-Phillips-Schmidt-Shin (KPSS) confirma que la serie transformada para el grupo de mayores de edad es ahora estacionaria, con p-value de \(0.1 > 0.05\). Este resultado valida que las serie diferenciada cumple con el supuesto de estacionariedad, eliminando raíces unitarias y estabilizando su media y varianza temporal.
Serie grupo menores de edad
par(mfrow=c(1,2))
Acf(ts_menores_mensual, main = "FAC - Serie Grupo menores", lag.max=12)
Pacf(ts_menores_mensual, main = "FACP - Serie Grupo menores", lag.max=12)
Serie grupo mayores de edad
par(mfrow=c(1,2))
Acf(ts_mayores_mensual, main = "FAC - Serie Grupo mayores", lag.max=12)
Pacf(ts_mayores_mensual, main = "FACP - Serie Grupo mayores", lag.max=12)
Serie grupo mayores de edad con diferencia de primer orden
par(mfrow=c(1,2))
Acf(ts_mayores_diff1, main = "FAC - Serie con diferencia", lag.max=12)
Pacf(ts_mayores_diff1, main = "FACP - Serie con diferencia", lag.max=12)
Para la selección óptima de modelos de series temporales, se emplea la función “auto.arima()” del paquete forecast, la cual automatiza la identificación del mejor modelo ARIMA mediante búsqueda exhaustiva de combinaciones de parámetros (p,d,q). Este algoritmo evalúa automáticamente la estacionariedad de las series, determina el orden de diferenciación requerido y selecciona la estructura autorregresiva y de media móvil que minimiza los criterios de información AIC y BIC, garantizando así la elección del modelo más parsimonioso y adecuado para cada serie bajo estudio.
# Auto.arima detectará que es estacionaria y usará d=0
mejor_modelo_menores <- auto.arima(ts_menores_mensual,
seasonal = FALSE, # Sin componente estacional
stepwise = FALSE, # Búsqueda exhaustiva
approximation = FALSE, trace=TRUE) # Máxima precisión
##
## ARIMA(0,0,0) with zero mean : 2122.842
## ARIMA(0,0,0) with non-zero mean : 1702.758
## ARIMA(0,0,1) with zero mean : 1997.313
## ARIMA(0,0,1) with non-zero mean : 1692.688
## ARIMA(0,0,2) with zero mean : 1923.536
## ARIMA(0,0,2) with non-zero mean : 1693.489
## ARIMA(0,0,3) with zero mean : 1874.563
## ARIMA(0,0,3) with non-zero mean : 1693.187
## ARIMA(0,0,4) with zero mean : 1854.823
## ARIMA(0,0,4) with non-zero mean : 1695.07
## ARIMA(0,0,5) with zero mean : 1828.482
## ARIMA(0,0,5) with non-zero mean : 1695.658
## ARIMA(1,0,0) with zero mean : 1738.959
## ARIMA(1,0,0) with non-zero mean : 1690.234
## ARIMA(1,0,1) with zero mean : Inf
## ARIMA(1,0,1) with non-zero mean : 1688.529
## ARIMA(1,0,2) with zero mean : Inf
## ARIMA(1,0,2) with non-zero mean : 1689.534
## ARIMA(1,0,3) with zero mean : Inf
## ARIMA(1,0,3) with non-zero mean : 1691.189
## ARIMA(1,0,4) with zero mean : Inf
## ARIMA(1,0,4) with non-zero mean : 1693.443
## ARIMA(2,0,0) with zero mean : Inf
## ARIMA(2,0,0) with non-zero mean : 1691.423
## ARIMA(2,0,1) with zero mean : Inf
## ARIMA(2,0,1) with non-zero mean : Inf
## ARIMA(2,0,2) with zero mean : Inf
## ARIMA(2,0,2) with non-zero mean : 1690.982
## ARIMA(2,0,3) with zero mean : Inf
## ARIMA(2,0,3) with non-zero mean : 1693.231
## ARIMA(3,0,0) with zero mean : Inf
## ARIMA(3,0,0) with non-zero mean : 1691.259
## ARIMA(3,0,1) with zero mean : Inf
## ARIMA(3,0,1) with non-zero mean : 1691.299
## ARIMA(3,0,2) with zero mean : Inf
## ARIMA(3,0,2) with non-zero mean : 1693.231
## ARIMA(4,0,0) with zero mean : Inf
## ARIMA(4,0,0) with non-zero mean : 1693.012
## ARIMA(4,0,1) with zero mean : Inf
## ARIMA(4,0,1) with non-zero mean : 1693.555
## ARIMA(5,0,0) with zero mean : Inf
## ARIMA(5,0,0) with non-zero mean : 1693.927
##
##
##
## Best model: ARIMA(1,0,1) with non-zero mean
cat(" MEJOR MODELO PARA MENORES (SERIE ESTACIONARIA) \n")
## MEJOR MODELO PARA MENORES (SERIE ESTACIONARIA)
print(mejor_modelo_menores)
## Series: ts_menores_mensual
## ARIMA(1,0,1) with non-zero mean
##
## Coefficients:
## ar1 ma1 mean
## 0.8674 -0.6681 1636.0362
## s.e. 0.0961 0.1473 58.6438
##
## sigma^2 = 72174: log likelihood = -840.09
## AIC=1688.18 AICc=1688.53 BIC=1699.33
#summary(mejor_modelo_menores)
El mejor modelo ajustado para la serie de los exámenes médico-legales en el grupo de menores mediante la función utilizada corresponde a un ARIMA(1,0,1), equivalentemente reducido a un ARMA(1,1), expresado de la siguiente manera:
\(X_t = 1636.0362 + 0.8674X_{t-1} + \varepsilon_t - 0.6681\varepsilon_{t-1}\)
Dado que la media es diferente de cero, entonces el modelo puede ser aplicado a la serie con media ajustada, es decir,
\(X_t - 1636.0362 = 0.8674(X_{t-1}-1636.0362) + \varepsilon_t - 0.6681\varepsilon_{t-1}\)
# Forzamos d=0 porque ya está diferenciada
mejor_modelo_mayores_diff <- auto.arima(ts_mayores_diff1,
seasonal = FALSE,
stepwise = FALSE,
approximation = FALSE, trace = TRUE)
##
## ARIMA(0,0,0) with zero mean : 1276.579
## ARIMA(0,0,0) with non-zero mean : 1278.623
## ARIMA(0,0,1) with zero mean : 1232.231
## ARIMA(0,0,1) with non-zero mean : 1233.308
## ARIMA(0,0,2) with zero mean : 1234.027
## ARIMA(0,0,2) with non-zero mean : 1234.994
## ARIMA(0,0,3) with zero mean : 1234.093
## ARIMA(0,0,3) with non-zero mean : 1235.375
## ARIMA(0,0,4) with zero mean : 1236.172
## ARIMA(0,0,4) with non-zero mean : 1237.411
## ARIMA(0,0,5) with zero mean : 1238.012
## ARIMA(0,0,5) with non-zero mean : 1238.856
## ARIMA(1,0,0) with zero mean : 1258.112
## ARIMA(1,0,0) with non-zero mean : 1260.161
## ARIMA(1,0,1) with zero mean : 1234.131
## ARIMA(1,0,1) with non-zero mean : 1235.139
## ARIMA(1,0,2) with zero mean : Inf
## ARIMA(1,0,2) with non-zero mean : 1236.137
## ARIMA(1,0,3) with zero mean : 1236.222
## ARIMA(1,0,3) with non-zero mean : 1237.517
## ARIMA(1,0,4) with zero mean : 1238.342
## ARIMA(1,0,4) with non-zero mean : 1239.512
## ARIMA(2,0,0) with zero mean : 1240.184
## ARIMA(2,0,0) with non-zero mean : 1242.129
## ARIMA(2,0,1) with zero mean : 1233.901
## ARIMA(2,0,1) with non-zero mean : 1235.218
## ARIMA(2,0,2) with zero mean : 1236.002
## ARIMA(2,0,2) with non-zero mean : 1237.309
## ARIMA(2,0,3) with zero mean : 1234.517
## ARIMA(2,0,3) with non-zero mean : Inf
## ARIMA(3,0,0) with zero mean : 1236.455
## ARIMA(3,0,0) with non-zero mean : 1238.285
## ARIMA(3,0,1) with zero mean : 1235.937
## ARIMA(3,0,1) with non-zero mean : 1237.187
## ARIMA(3,0,2) with zero mean : 1238.086
## ARIMA(3,0,2) with non-zero mean : Inf
## ARIMA(4,0,0) with zero mean : 1237.462
## ARIMA(4,0,0) with non-zero mean : 1239.239
## ARIMA(4,0,1) with zero mean : 1237.933
## ARIMA(4,0,1) with non-zero mean : Inf
## ARIMA(5,0,0) with zero mean : 1239.673
## ARIMA(5,0,0) with non-zero mean : 1241.497
##
##
##
## Best model: ARIMA(0,0,1) with zero mean
cat(" MEJOR MODELO PARA MAYORES (SERIE DIFERENCIADA) \n")
## MEJOR MODELO PARA MAYORES (SERIE DIFERENCIADA)
print(mejor_modelo_mayores_diff)
## Series: ts_mayores_diff1
## ARIMA(0,0,1) with zero mean
##
## Coefficients:
## ma1
## -0.7294
## s.e. 0.0608
##
## sigma^2 = 1780: log likelihood = -614.06
## AIC=1232.13 AICc=1232.23 BIC=1237.69
#summary(mejor_modelo_mayores_diff)
Para la serie del grupo de mayores siendo ya diferenciada para que ser estacionaria se ajusta mediante la función un ARIMA(0,0,1) que equivale a un modelo MA(1) expresado de la siguiente manera:
\(X_t = \varepsilon_t - 0.7294\varepsilon_{t-1}\)
# Auto.arima detectará que necesita diferenciación (d=1)
mejor_modelo_mayores <- auto.arima(ts_mayores_mensual,
seasonal = FALSE,
stepwise = FALSE,
approximation = FALSE, trace=TRUE)
##
## ARIMA(0,1,0) : 1276.579
## ARIMA(0,1,0) with drift : 1278.623
## ARIMA(0,1,1) : 1232.231
## ARIMA(0,1,1) with drift : 1233.308
## ARIMA(0,1,2) : 1234.027
## ARIMA(0,1,2) with drift : 1234.994
## ARIMA(0,1,3) : 1234.093
## ARIMA(0,1,3) with drift : 1235.375
## ARIMA(0,1,4) : 1236.172
## ARIMA(0,1,4) with drift : 1237.411
## ARIMA(0,1,5) : 1238.012
## ARIMA(0,1,5) with drift : 1238.856
## ARIMA(1,1,0) : 1258.112
## ARIMA(1,1,0) with drift : 1260.161
## ARIMA(1,1,1) : 1234.131
## ARIMA(1,1,1) with drift : 1235.139
## ARIMA(1,1,2) : Inf
## ARIMA(1,1,2) with drift : 1236.137
## ARIMA(1,1,3) : 1236.222
## ARIMA(1,1,3) with drift : 1237.517
## ARIMA(1,1,4) : 1238.342
## ARIMA(1,1,4) with drift : 1239.512
## ARIMA(2,1,0) : 1240.184
## ARIMA(2,1,0) with drift : 1242.129
## ARIMA(2,1,1) : 1233.901
## ARIMA(2,1,1) with drift : 1235.218
## ARIMA(2,1,2) : 1236.002
## ARIMA(2,1,2) with drift : 1237.309
## ARIMA(2,1,3) : 1234.517
## ARIMA(2,1,3) with drift : Inf
## ARIMA(3,1,0) : 1236.455
## ARIMA(3,1,0) with drift : 1238.285
## ARIMA(3,1,1) : 1235.937
## ARIMA(3,1,1) with drift : 1237.187
## ARIMA(3,1,2) : 1238.086
## ARIMA(3,1,2) with drift : Inf
## ARIMA(4,1,0) : 1237.462
## ARIMA(4,1,0) with drift : 1239.239
## ARIMA(4,1,1) : 1237.933
## ARIMA(4,1,1) with drift : Inf
## ARIMA(5,1,0) : 1239.673
## ARIMA(5,1,0) with drift : 1241.497
##
##
##
## Best model: ARIMA(0,1,1)
cat(" MEJOR MODELO PARA MAYORES (SERIE NO ESTACIONARIA) \n")
## MEJOR MODELO PARA MAYORES (SERIE NO ESTACIONARIA)
print(mejor_modelo_mayores)
## Series: ts_mayores_mensual
## ARIMA(0,1,1)
##
## Coefficients:
## ma1
## -0.7294
## s.e. 0.0608
##
## sigma^2 = 1780: log likelihood = -614.06
## AIC=1232.13 AICc=1232.23 BIC=1237.69
#summary(mejor_modelo_mayores)
Para la serie del grupo de mayores aún sin diferenciar se ajusta un modelo ARIMA(0,1,1). Se nota que la serie no tiene un componente autorregresivono,es decir, no se utilizan valores pasados de la propia serie para predecir el siguiente valor.
Recordando que un ARIMA(p,d,q), con \(d > 0\):
\(\Theta_q(B)\varepsilon_t=\varepsilon_t + \theta_1B\varepsilon_t+\theta_2B^2\varepsilon_t+\dotsi + \theta_qB^q\varepsilon_t\)
\(= (1+\theta_1B+\theta_2B^2+\dotsi +\theta_qB^q)\varepsilon_t\)
Por lo tanto, en este caso dado que \(q=1\)
\(\Theta_1(B)\varepsilon_t=\varepsilon_t + \theta_1B\varepsilon_t\)
\(= (1+\theta_1B)\varepsilon_t\)
\(= (1- 0.7294B)\varepsilon_t\)
Equivalente a
\(X_t = \varepsilon_t - 0.7294B\varepsilon_t\)
\(X_t = \varepsilon_t - 0.7294\varepsilon_{t-1}\)
El análisis en general, evidencia patrones diferenciados entre grupos etarios que demandan intervenciones específicas. La población menor de edad presenta una carga sustancialmente mayor (196,850 casos) con alta variabilidad mensual y patrones estacionarios que responden a un modelo ARMA(1,1), indicando persistencia temporal y mecanismos de corrección de errores que sugieren factores de vulnerabilidad estructural. Contrariamente, los mayores de edad (36,500 casos) exhiben una tendencia creciente reciente con comportamiento no estacionario que requiere diferenciación (ARIMA(0,1,1)), reflejando dinámicas emergentes que podrían asociarse a cambios contextuales recientes. La correlación positiva débil entre grupos (r=0.36) confirma la necesidad de abordajes diferenciados, mientras que la marcada disminución en 2020 evidencia la sensibilidad del fenómeno a factores como la pandemia del COVID-2019. Estos hallazgos recomiendan estrategias de prevención con enfoque etario, sistemas de alerta temprana basados en la variabilidad mensual identificada, y protocolos de respuesta que consideren la estacionalidad y persistencia temporal caracterizada en los modelos ARIMA.
La implementación de estas evidencias permitirá optimizar la asignación de recursos, focalizando intervenciones intensivas en periodos de mayor vulnerabilidad para menores y desarrollando estrategias específicas para contener la tendencia creciente en adultos. Los modelos desarrollados constituyen herramientas valiosas para la planificación operativa y el diseño de políticas públicas basadas en evidencia estadística, asegurando una respuesta efectiva y diferenciada ante los exámenes médico-legales por presunto delito sexual en Colombia.
Observatorio [Internet]. https://www.medicinalegal.gov.co/cifras-estadisticas/forensis 2025 [citado 01 noviembre 2025]. Disponible en: https://www.medicinalegal.gov.co/
Observatorio [Internet]. https://www.datos.gov.co/d/hyqu-diue 2025 [citado 19 septiembre 2025]. Disponible en: https://www.datos.gov.co/
López, A. J. (2002). Contrastes de estacionariedad en series con un cambio en la media. Revista de Economía Aplicada, 10(29), 107-134. http://www.redalyc.org/articulo.oa?id=96917636005
Tróchez González, J., & Valencia Cárdenas, M. (2014). Análisis de series temporales en el sector lácteo de Antioquia para detectar efectos de la apertura comercial. Revista Investigaciones Aplicadas. http://hdl.handle.net/20.500.11912/6814
Betancourt, G. A. D. (2022). EXÁMENES MÉDICOLEGALES POR PRESUNTO DELITO SEXUAL. DATOS PARA LA VIDA, 144. https://www.medicinalegal.gov.co/documents/20143/989825/Forensis_2022.pdf#page=145
Nurkholis, Z. (2023). A Practical Guide to ARIMA with auto.arima Function in R. Medium. https://medium.com/@mouse3mic3/a-practical-guide-to-arima-with-auto-arima-function-in-r-252aa84232af
Cowpertwait, P. S., & Metcalfe, A. V. (2009). Introductory time series with R. Springer Science & Business Media. http://repository.cinec.edu/bitstream/cinec20/1223/1/2009_Book_IntroductoryTimeSeriesWithR.pdf