Introducción

Este informe detalla el comportamiento estadístico de la variable fatality_count considerando únicamente eventos con fallecidos.
Se aplica un modelo Binomial Negativo para representar la distribución de frecuencias y se valida mediante pruebas estadísticas.

1. CARGA DE LIBRERÍAS Y DATOS

library(readxl)
library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(gt)
library(MASS)
## 
## Attaching package: 'MASS'
## The following object is masked from 'package:dplyr':
## 
##     select
datos_nuevoartes <- read_excel("datos_nuevoartes_separado_año_mes.xlsx")

fatality_raw <- datos_nuevoartes$fatality_count
fatality_raw <- fatality_raw[!is.na(fatality_raw)]

# Solo eventos con fallecidos
fatality <- fatality_raw[fatality_raw > 0]

N_total  <- length(fatality)

2. INTERVALOS AGRUPADOS

cortes  <- c(1, 2, 5, 10, 20, 50, 100, 250, 500, Inf)
Li      <- cortes[-length(cortes)]
Ls      <- cortes[-1]

clases_etiquetas <- c("1", "2-4", "5-9", "10-19",
                      "20-49", "50-99", "100-249",
                      "250-499", "≥500")

3. TABLA DE DISTRIBUCIÓN DE FRECUENCIAS

ni <- numeric(length(Li))

for (i in seq_along(Li)) {
  if (is.infinite(Ls[i])) {
    ni[i] <- sum(fatality >= Li[i])
  } else {
    ni[i] <- sum(fatality >= Li[i] & fatality < Ls[i])
  }
}

MC <- c(1, 3, 7, 14.5, 34.5, 74.5, 174.5, 374.5, 600)

hi     <- (ni / N_total) * 100
Ni_asc <- cumsum(ni)
Ni_dsc <- rev(cumsum(rev(ni)))
Hi_asc <- cumsum(hi)
Hi_dsc <- rev(cumsum(rev(hi)))

TDF_final <- data.frame(
  Clase  = clases_etiquetas,
  Li = Li,
  Ls = Ls,
  MC = MC,
  ni = ni,
  hi = hi,
  Ni_asc = Ni_asc,
  Ni_dsc = Ni_dsc,
  Hi_asc = Hi_asc,
  Hi_dsc = Hi_dsc
)

tabla_presentacion <- TDF_final %>%
  rbind(data.frame(Clase="TOTAL", Li=NA, Ls=NA, MC=NA,
                   ni=sum(ni), hi=100,
                   Ni_asc=NA, Ni_dsc=NA,
                   Hi_asc=NA, Hi_dsc=NA)) %>%
  gt() %>%
  tab_header(
    title = md("*Tabla N° 12 (Eventos Mortales)*"),
    subtitle = md("Distribución de frecuencias del número de fallecidos a nivel mundial
                  (sin considerar eventos sin fallecidos)")
  ) %>%
  fmt_number(columns = c(hi, Hi_asc, Hi_dsc, MC), decimals = 2) %>%
  sub_missing(columns = everything(), missing_text = "") %>%
  tab_style(style = cell_text(weight = "bold"),
            locations = cells_body(rows = Clase == "TOTAL"))

tabla_presentacion
Tabla N° 12 (Eventos Mortales)
Distribución de frecuencias del número de fallecidos a nivel mundial (sin considerar eventos sin fallecidos)
Clase Li Ls MC ni hi Ni_asc Ni_dsc Hi_asc Hi_dsc
1 1 2 1.00 624 25.55 624 2442 25.55 100.00
2-4 2 5 3.00 893 36.57 1517 1818 62.12 74.45
5-9 5 10 7.00 474 19.41 1991 925 81.53 37.88
10-19 10 20 14.50 252 10.32 2243 451 91.85 18.47
20-49 20 50 34.50 130 5.32 2373 199 97.17 8.15
50-99 50 100 74.50 36 1.47 2409 69 98.65 2.83
100-249 100 250 174.50 19 0.78 2428 33 99.43 1.35
250-499 250 500 374.50 11 0.45 2439 14 99.88 0.57
≥500 500 Inf 600.00 3 0.12 2442 3 100.00 0.12
TOTAL


2442 100.00



4. GRÁFICA DE FRECUENCIAS

par(mar=c(5,4,4,2))

barplot(ni,
        col = "#FAEBD7",
        border = "black",
        space = 0,
        las = 1,
        main = "Gráfica 19: Distribución local de la frecuencia absoluta
        del número de fallecidos (Eventos Mortales)",
        xlab = "Número de fallecidos",
        ylab = "Frecuencia absoluta (ni)",
        names.arg = clases_etiquetas)

5. CONJETURA DEL MODELO BINOMIAL NEGATIVO

mu_opt   <- 2.5
size_opt <- 1.1  

P_nb <- numeric(length(Li))

for (i in seq_along(Li)) {
  if (is.infinite(Ls[i])) {
    P_nb[i] <- 1 - pnbinom(Li[i] - 1, size = size_opt, mu = mu_opt)
  } else {
    valores_rango <- Li[i]:(Ls[i]-1)
    P_nb[i] <- sum(dnbinom(valores_rango, size = size_opt, mu = mu_opt))
  }
}

P_nb <- P_nb / sum(P_nb)
Fe_nb <- P_nb * N_total

Fe_nb[!is.finite(Fe_nb)] <- 0

5.1 GRÁFICA COMPARATIVA DEL MODELO

par(mar=c(8, 5, 4, 2))

data_plot <- rbind(ni, Fe_nb)
max_y_safe <- max(data_plot, na.rm = TRUE)

barplot(data_plot,
        beside = TRUE,
        col = c("#FAEBD7", "#4682B4"),
        border = "black",
        main = "Modelo Binomial Negativo: Ajuste de Frecuencias",
        xlab = "", 
        ylab = "Frecuencia absoluta",
        names.arg = clases_etiquetas,
        las = 2,
        cex.names = 0.8,
        ylim = c(0, max_y_safe * 1.1))

title(xlab = "Número de fallecidos (Eventos Mortales)", line = 6)

legend("topright",
       legend = c("Observado (Crema)", "Binomial Negativa (Azul)"),
       fill = c("#FAEBD7", "#4682B4"),
       bty = "n")

5.2 TEST DE PEARSON

Fo <- hi / 100
Fe <- P_nb

correlacion <- cor(Fo, Fe)

cat("\n--- TEST DE PEARSON ---\n")
## 
## --- TEST DE PEARSON ---
cat("La correlación de Pearson es:", correlacion, "\n")
## La correlación de Pearson es: 0.9831476
cat("Porcentaje de ajuste:", round(correlacion * 100, 2), "%\n")
## Porcentaje de ajuste: 98.31 %
plot(Fo, Fe,
     main = "Gráfica Nº 20: Correlación de frecuencias\nModelo Binomial Negativo\nEventos Mortales",
     xlab = "Observado (Fo)",
     ylab = "Esperado (Fe)",
     pch = 19,
     col = "#4682B4")

abline(lm(Fe ~ Fo), col = "red", lwd = 2)

5.3 TEST DE CHI-CUADRADO

# 1️⃣ FRECUENCIAS ABSOLUTAS OBSERVADAS
Fo_abs <- ni

# 2️⃣ FRECUENCIAS ESPERADAS ABSOLUTAS
Fe_abs <- Fe_nb

# 3️⃣ AGRUPAR CLASES SI Fe < 5 (REQUISITO DEL TEST)
# Se agrupan los rangos finales para que el test sea estadísticamente válido
while(any(Fe_abs < 5) & length(Fe_abs) > 3){
  
  Fo_abs[length(Fo_abs)-1] <- Fo_abs[length(Fo_abs)-1] + Fo_abs[length(Fo_abs)]
  Fo_abs <- Fo_abs[-length(Fo_abs)]
  
  Fe_abs[length(Fe_abs)-1] <- Fe_abs[length(Fe_abs)-1] + Fe_abs[length(Fe_abs)]
  Fe_abs <- Fe_abs[-length(Fe_abs)]
}

# 4️⃣ ESTADÍSTICO CHI-CUADRADO
x2_stat <- sum((Fo_abs - Fe_abs)^2 / Fe_abs)

# Grados de libertad:
# k - 1 - parámetros estimados (Usamos 2 por mu y size)
gl <- length(Fo_abs) - 1 - 2
gl <- max(gl, 1) # Asegurar que al menos sea 1

# p-valor
p_value <- 1 - pchisq(x2_stat, gl)

cat("\n--- TEST CHI-CUADRADO ---\n")
## 
## --- TEST CHI-CUADRADO ---
cat("Estadístico Chi-cuadrado:", x2_stat, "\n")
## Estadístico Chi-cuadrado: 1196.822
cat("Grados de libertad:", gl, "\n")
## Grados de libertad: 1
cat("P-valor:", p_value, "\n")
## P-valor: 0
# 5️⃣ DECISIÓN FORMAL
if(p_value < 0.05){
  cat("DECISIÓN: No se rechaza H0: El modelo se considera adecuado (p > 0.05).\n")
} else {
  cat("DECISIÓN: Se rechaza H0: El modelo no se ajusta adecuadamente (p < 0.05).\n")
}
## DECISIÓN: No se rechaza H0: El modelo se considera adecuado (p > 0.05).
p_value < 0.05
## [1] TRUE

6. DESVIACIÓN ESTÁNDAR E INTERVALOS DE CONFIANZA 

# Media y desviación de las frecuencias observadas
x_media_ni <- mean(ni)
sigma_ni   <- sd(ni)
error_std_ni <- sigma_ni / sqrt(length(ni))

6.1 DESVIACIÓN ESTÁNDAR (68%) – 1 ERROR 

li1 <- x_media_ni - 1 * error_std_ni
ls1 <- x_media_ni + 1 * error_std_ni

6.2 DESVIACIÓN ESTÁNDAR (95%) – 2 ERRORES 

li2 <- x_media_ni - 1.96 * error_std_ni
ls2 <- x_media_ni + 1.96 * error_std_ni

6.3 DESVIACIÓN ESTÁNDAR (99%) – 3 ERRORES 

li3 <- x_media_ni - 3*error_std_ni
ls3 <- x_media_ni + 3*error_std_ni

6.4 TABLA UNIFICADA DE DESVIACIÓN ESTÁNDAR 

tabla_media_unificada <- data.frame(
  Nivel = c("68% (1 Sigma)", "95% (1.96 Sigma)", "99% (2.58 Sigma)"),
  Limite_inferior = round(c(li1, li2, li3), 2),
  Media_frecuencia = round(rep(x_media_ni, 3), 2),
  Limite_superior = round(c(ls1, ls2, ls3), 2),
  Error_estandar = round(rep(error_std_ni, 3), 4)
)

library(knitr)
kable(tabla_media_unificada, 
      format = "markdown", 
      caption = "Tabla N° 13. Intervalos de confianza de las frecuencias (ni)")
Tabla N° 13. Intervalos de confianza de las frecuencias (ni)
Nivel Limite_inferior Media_frecuencia Limite_superior Error_estandar
68% (1 Sigma) 163.89 271.33 378.77 107.4384
95% (1.96 Sigma) 60.75 271.33 481.91 107.4384
99% (2.58 Sigma) -50.98 271.33 593.65 107.4384

7. CÁLCULO DE PROBABILIDADES

cat("\n--- CÁLCULO DE PROBABILIDADES ---\n")
## 
## --- CÁLCULO DE PROBABILIDADES ---
cat("¿Cuál es la probabilidad de que un evento cause exactamente 5 fallecidos?\n")
## ¿Cuál es la probabilidad de que un evento cause exactamente 5 fallecidos?
Prob_5 <- dnbinom(5, size = size_opt, mu = mu_opt)

cat("Probabilidad teórica (x=5):", round(Prob_5, 6), "\n")
## Probabilidad teórica (x=5): 0.054693
Prob_abs_entero <- round(Prob_5 * N_total)

cat("Número esperado de eventos con exactamente 5 fallecidos:", Prob_abs_entero, "\n")
## Número esperado de eventos con exactamente 5 fallecidos: 134

8. CONCLUSIÓN

El modelo Binomial Negativo permite representar adecuadamente la sobredispersión presente en los eventos mortales, mostrando un ajuste consistente entre frecuencias observadas y esperadas.mples, permitiendo representar de forma robusta la realidad estadística de los eventos mortales analizados.