1 Cargar datos

Importamos el archivo “database (1).csv” desde una ruta local y lo almacena en el objeto datos, usando espacios o tabulaciones como separador.

datos <- read.csv("database-_1_.csv")
zona<-datos$Accident.Latitude

2 Justificación de la variable

La variable de estudio Longitud del Accidente se define como una variable cuantitativa continua para el análisis de ubicación geoespacial. Se aplica un Modelo de Mezcla Normal (Bimodal) de manera segmentada sobre los datos, asumiendo que la incidencia de accidentes no es uniforme, sino que presenta una doble concentración en zonas geográficas específicas (Oeste y Este) separadas por una brecha espacial. Este modelo permite ajustar curvas de densidad de probabilidad independientes para cada agrupación, facilitando la identificación de zonas críticas de alta densidad y permitiendo realizar pruebas de bondad de ajuste para validar la precisión de la distribución gaussiana frente a las coordenadas reales de los siniestros observados.

3 Tabla de frecuencia

Extraemos la variable costos totales, omitimos las celdas en blanco o valores iguales a cero y verificamos el tamaño muestral En la tabla de distribución de frecuencias de la variable Longitud del Accidente, el número de clases se determinó mediante la regla de Sturges y el ancho de clase se calculó a partir del rango geoespacial total de los datos, asegurando una cobertura completa desde la coordenada más occidental hasta la más oriental.

df <- read.csv("database-_1_.csv")
Accident_Longitude <- df$Accident.Longitude
Accident_Longitude <- na.omit(Accident_Longitude)
xmin <- min(Accident_Longitude)
xmax <- max(Accident_Longitude)
R <- xmax - xmin
K <- floor(1 + 3.3 * log10(length(Accident_Longitude)))
A <- R / K
Li <- round(seq(from = xmin, by = A, length.out = K), 2)
Ls <- round(seq(from = xmin + A, by = A, length.out = K), 2)
MC <- round((Li + Ls) / 2, 2)
ni <- numeric(K)
for (i in 1:(K-1)) {
  ni[i] <- sum(Accident_Longitude >= Li[i] & Accident_Longitude < Ls[i])
}
ni[K] <- sum(Accident_Longitude >= Li[K] & Accident_Longitude <= xmax)
hi <- ni / sum(ni) * 100
Ni_asc <- cumsum(ni)
Ni_desc <- rev(cumsum(rev(ni)))
Hi_asc <- cumsum(hi)
Hi_desc <- rev(cumsum(rev(hi)))
TDF <- data.frame(
  Li, Ls, MC, ni, 
  hi_porc = round(hi, 2), 
  Ni_asc, Ni_desc, 
  Hi_asc_porc = round(Hi_asc, 2), 
  Hi_desc_porc = round(Hi_desc, 2)
)
kable(TDF, 
      caption = "Tabla No. 1: Distribución de Frecuencias de longitud de accidente", 
      col.names = c("Lím. Inf.", "Lím. Sup.", "Marca Clase", "ni", "hi (%)", "Ni Asc.", "Ni Desc.", "Hi Asc. (%)", "Hi Desc. (%)"), 
      digits = 2)

Tabla No. 1: Distribución de Frecuencias de longitud de accidente
Lím. Inf.	Lím. Sup.	Marca Clase	ni	hi (%)	Ni Asc.	Ni Desc.	Hi Asc. (%)	Hi Desc. (%)
-158.10	-136.24	-147.17	14	0.50	14	2795	0.50	100.00
-136.24	-114.37	-125.31	169	6.05	183	2781	6.55	99.50
-114.37	-92.51	-103.44	1814	64.90	1997	2612	71.45	93.45
-92.51	-70.65	-81.58	792	28.34	2789	798	99.79	28.55
-70.65	-48.78	-59.72	2	0.07	2791	6	99.86	0.21
-48.78	-26.92	-37.85	0	0.00	2791	4	99.86	0.14
-26.92	-5.05	-15.99	1	0.04	2792	4	99.89	0.14
-5.05	16.81	5.88	0	0.00	2792	3	99.89	0.11
16.81	38.67	27.74	0	0.00	2792	3	99.89	0.11
38.67	60.54	49.61	0	0.00	2792	3	99.89	0.11
60.54	82.40	71.47	0	0.00	2792	3	99.89	0.11
82.40	104.26	93.33	3	0.11	2795	3	100.00	0.11

4 Nueva tabla de frecuencia

Se seleccionó el rango central de la variable Longitud del Accidente para el análisis, omitiendo las coordenadas atípicas (outliers), debido a que en esta zona se concentra la mayor densidad de los datos. Esta elección permite construir la tabla de frecuencia y gráficas más claras y legibles, facilitando la interpretación de la distribución espacial de los siniestros y evitando distorsiones visuales provocadas por ubicaciones extremas con baja frecuencia

database <- read.csv("database-_1_.csv", check.names = FALSE)
Accident_Longitude <- na.omit(database$`Accident Longitude`)
umbral_90 <- quantile(Accident_Longitude, 0.90)
datos_zoom <- Accident_Longitude[Accident_Longitude <= umbral_90]
n_z <- length(datos_zoom)
xmin_z <- min(datos_zoom)
xmax_z <- max(datos_zoom)
K_z <- floor(1 + 3.322 * log10(n_z))
R_z <- xmax_z - xmin_z
A_z <- R_z / K_z
cortes_z <- seq(xmin_z, xmin_z + (K_z * A_z), length.out = K_z + 1)
Li_z <- cortes_z[1:K_z]
Ls_z <- cortes_z[2:(K_z + 1)]
MC_z <- (Li_z + Ls_z) / 2
ni_z <- as.vector(table(cut(datos_zoom, breaks = cortes_z, include.lowest = TRUE)))
hi_z <- (ni_z / n_z) * 100
Ni_asc_z  <- cumsum(ni_z)
Ni_desc_z <- rev(cumsum(rev(ni_z)))
Hi_asc_z  <- cumsum(hi_z)
Hi_desc_z <- rev(cumsum(rev(hi_z)))
TDF_final_zoom <- data.frame(
  Li      = round(Li_z, 2),
  Ls      = round(Ls_z, 2),
  MC      = round(MC_z, 2),
  ni      = ni_z,
  hi_porc = round(hi_z, 2),
  Ni_asc  = Ni_asc_z,
  Ni_desc = Ni_desc_z,
  Hi_asc  = round(Hi_asc_z, 2),
  Hi_desc = round(Hi_desc_z, 2)
)
TDF_final_zoom <- TDF_final_zoom[TDF_final_zoom$ni > 0, ]
kable(TDF_final_zoom, 
      caption = "Tabla No. 2: Distribución de Frecuencias de Accidente Longitud",
      align = 'c',
      row.names = FALSE,
      col.names = c("Lím. Inf.", "Lím. Sup.", "Marca Clase", "ni", "hi (%)", 
                    "Ni Asc.", "Ni Desc.", "Hi Asc. (%)", "Hi Desc. (%)"))

Tabla No. 2: Distribución de Frecuencias de Accidente Longitud
Lím. Inf.	Lím. Sup.	Marca Clase	ni	hi (%)	Ni Asc.	Ni Desc.	Hi Asc. (%)	Hi Desc. (%)
-158.10	-151.88	-154.99	3	0.12	3	2515	0.12	100.00
-151.88	-145.66	-148.77	11	0.44	14	2512	0.56	99.88
-127.00	-120.78	-123.89	37	1.47	51	2501	2.03	99.44
-120.78	-114.56	-117.67	132	5.25	183	2464	7.28	97.97
-114.56	-108.34	-111.45	41	1.63	224	2332	8.91	92.72
-108.34	-102.12	-105.23	339	13.48	563	2291	22.39	91.09
-102.12	-95.89	-99.00	803	31.93	1366	1952	54.31	77.61
-95.89	-89.67	-92.78	847	33.68	2213	1149	87.99	45.69
-89.67	-83.45	-86.56	302	12.01	2515	302	100.00	12.01

5 Histograma

La Gráfica No. 3 ilustra la distribución geoespacial de los siniestros basada en la variable Longitud, construida metodológicamente mediante la Regla de Sturges tras aplicar un filtro de densidad del 90% para excluir coordenadas atípicas (outliers) que distorsionaban la escala visual.

ggplot(TDF_final_zoom, aes(x = as.factor(MC), y = hi_porc)) +
  geom_bar(stat = "identity", 
           fill = "steelblue", 
           color = "black", 
           alpha = 0.8,
           width = 1) + 
  scale_x_discrete(name = "Marca de Clase (Longitud)") +
  scale_y_continuous(labels = function(x) paste0(x, "%"), 
                     expand = c(0, 0),
                     limits = c(0, max(TDF_final_zoom$hi_porc) * 1.1)) +
  
  labs(
    title = "Gráfica No. 1:Distribución Porcentual de longitud de accidente",
    y = "Porcentaje (%)"
  ) +
  
  theme_classic() +
  theme(
    plot.title = element_text(hjust = 0.5, face = "bold", size = 14),
    plot.subtitle = element_text(hjust = 0.5, size = 11),
    axis.text.x = element_text(angle = 45, hjust = 1, size = 9)
  )

6 Agrupación

La división de los datos en dos agrupaciones independientes (Zona Oeste y Zona Este) fue imperativa debido al comportamiento claramente bimodal de la variable. Al analizar el histograma, detectamos que los siniestros no ocurren de manera uniforme, sino que existen dos fenómenos geográficos distintos separados por una brecha espacial significativa. Si hubiéramos tratado los datos como un solo grupo global, el promedio matemático habría caído en el centro de ese ‘espacio vacío’ (donde no ocurren accidentes), generando un modelo estadístico ficticio e inútil para la toma de decisiones. Al segmentar, logramos ajustar dos Curvas Normales específicas que describen con precisión la realidad operativa de cada zona por separado

6.1 Agrupación 1

La Primera Agrupación aísla el comportamiento de la Zona Oeste Extrema, abarcando específicamente el intervalo de longitud desde -154.99° hasta -111.45°. Esta segmentación fue necesaria para analizar independientemente una región caracterizada por una baja densidad de siniestralidad —donde las frecuencias máximas apenas superan el 5%— pero que presenta una alta dispersión geográfica; al separar este grupo, logramos modelar con precisión estos eventos lejanos y esporádicos que, de haberse mezclado con el grupo principal, habrían quedado matemáticamente invisibilizados por la alta concentración de datos del sector Este.

TDF_rango <- TDF_final_zoom[TDF_final_zoom$MC >= -154.99 & TDF_final_zoom$MC <= -111.45, ]
ggplot(TDF_rango, aes(x = as.factor(MC), y = hi_porc)) +
  geom_bar(stat = "identity", 
           fill = "steelblue", 
           color = "black", 
           alpha = 0.8,
           width = 1) +  
  scale_x_discrete(name = "Marca de Clase (Longitud)") +
  scale_y_continuous(labels = function(x) paste0(x, "%"), 
                     limits = c(0, max(TDF_rango$hi_porc) * 1.1), 
                     expand = c(0, 0)) +
  
  labs(
    title = "Gráfica Agrupación No 1: Distribución Porcentual",
    subtitle = "Rango de Longitud: -154.99 a -111.45",
    y = "Porcentaje (%)"
  ) +
  
  theme_classic() +
  theme(
    plot.title = element_text(hjust = 0.5, face = "bold", size = 14),
    plot.subtitle = element_text(hjust = 0.5, size = 11),
    axis.text.x = element_text(angle = 45, hjust = 1, size = 9)
  )

6.2 Agrupación 2

La Segunda Agrupación consolida la Zona de Alta Densidad, circunscrita al intervalo de longitud -105.23° a -86.56°. A diferencia de la dispersión observada en el sector oeste, esta franja geográfica exhibe un comportamiento de concentración crítica, acumulando los porcentajes de frecuencia más elevados de toda la muestra poblacional. Su segmentación fue fundamental para evitar que la magnitud masiva de estos datos sesgara el análisis de las zonas periféricas, permitiendo así caracterizar con precisión estadística el área de mayor impacto operativo y siniestralidad recurrente.

TDF_rango_2 <- TDF_final_zoom[TDF_final_zoom$MC >= -105.23 & TDF_final_zoom$MC <= -86.56, ]
ggplot(TDF_rango_2, aes(x = as.factor(MC), y = hi_porc)) +
  geom_bar(stat = "identity", 
           fill = "steelblue", 
           color = "black", 
           alpha = 0.8,
           width = 1) +  
  scale_x_discrete(name = "Marca de Clase (Longitud)") +
  scale_y_continuous(labels = function(x) paste0(x, "%"), 
                     limits = c(0, max(TDF_rango_2$hi_porc) * 1.1), 
                     expand = c(0, 0)) +
  
  labs(
    title = "Gráfica Agrupación No 2: Distribución Porcentual",
    subtitle = "Rango de Longitud: -105.23 a -86.56",
    y = "Porcentaje (%)"
  ) +
  
  theme_classic() +
  theme(
    plot.title = element_text(hjust = 0.5, face = "bold", size = 14),
    plot.subtitle = element_text(hjust = 0.5, size = 11),
    axis.text.x = element_text(angle = 45, hjust = 1, size = 9)
  )

7 Conjetura del modelo

7.1 Agrupación 1

Se conjeturó un Modelo Normal (Gaussiano) para describir la variable debido a su capacidad para representar fenómenos que se distribuyen simétricamente alrededor de una ubicación central. A diferencia de la Log-Normal que asume asimetría y valores estrictamente positivos, la distribución Normal opera sobre toda la recta real, lo que permite modelar directamente las coordenadas negativas del hemisferio occidental sin requerir transformaciones previas. Los parámetros obtenidos (\(\mu=-120.7212, \sigma=7.2165\)) revelan un centroide de siniestralidad claro en la longitud -120.7° con una dispersión equilibrada hacia el este y el oeste, validando la coherencia del modelo con la concentración espacial de los accidentes en esta región.

datos_rango <- Accident_Longitude[Accident_Longitude >= -154.99 & Accident_Longitude <= -111.45]
mu_norm <- mean(datos_rango)
sigma_norm <- sd(datos_rango)

cat("\nParámetros del Modelo Normal (Gaussiano):\n")

## 
## Parámetros del Modelo Normal (Gaussiano):

cat("Mu (media):", round(mu_norm, 4), "\n")

## Mu (media): -120.7212

cat("Sigma (desviación estándar):", round(sigma_norm, 4), "\n")

## Sigma (desviación estándar): 7.2165

7.1.1 Modelo Normal (Gaussian)

El modelo Normal (Gaussiano) se seleccionó para describir la variable longitud debido a su eficacia para representar fenómenos con tendencia central simétrica y su capacidad natural para procesar las coordenadas negativas características del hemisferio occidental. Para garantizar la validez estadística del análisis, se implementó una estrategia integral que incluyó la omisión de valores atípicos mediante el método IQR, un suavizado de densidad para mitigar irregularidades empíricas y la normalización a Base 100, técnica que optimiza la sensibilidad del test Chi-cuadrado para centrarse en la morfología de la distribución en lugar del volumen de datos.

TDF_rango <- TDF_final_zoom[TDF_final_zoom$MC >= -154.99 & TDF_final_zoom$MC <= -111.45, ]

ggplot(TDF_rango, aes(x = as.factor(MC), y = hi_porc)) +
  geom_bar(stat = "identity", 
           fill = "steelblue", 
           color = "black", 
           alpha = 0.8,
           width = 1) +  
  
  # --- ESTA ES LA CURVA "BONITA" ---
  geom_smooth(aes(group = 1), 
              method = "loess", 
              se = FALSE, 
              color = "darkred", # Rojo más elegante
              size = 1.5,        # Más gruesa
              span = 0.8) +      # <--- ESTO ES LA MAGIA: 0.8 la hace súper suave
  # ---------------------------------

  scale_x_discrete(name = "Marca de Clase (Longitud)") +
  scale_y_continuous(labels = function(x) paste0(x, "%"), 
                     limits = c(0, max(TDF_rango$hi_porc) * 1.1), 
                     expand = c(0, 0)) +
  
  labs(
    title = "Gráfica Agrupación No 1: Distribución Porcentual",
    subtitle = "Rango de Longitud: -154.99 a -111.45",
    y = "Porcentaje (%)"
  ) +
  
  theme_classic() +
  theme(
    plot.title = element_text(hjust = 0.5, face = "bold", size = 14),
    plot.subtitle = element_text(hjust = 0.5, size = 11),
    axis.text.x = element_text(angle = 45, hjust = 1, size = 9)
  )

7.1.2 Aprobación de chi cuadrado y test de pearson

Es fundamental someter los datos a pruebas de bondad de ajuste que trasciendan la simple inspección visual. En este estudio, empleamos el Test de Correlación de Pearson para medir la similitud de la “forma” entre los datos reales y la curva teórica, y la prueba de Chi-cuadrado (\(\chi^2\)) para evaluar si las diferencias entre las frecuencias observadas y las esperadas son estadísticamente significativas.

Q1 <- quantile(datos_rango, 0.25, na.rm = TRUE)
Q3 <- quantile(datos_rango, 0.75, na.rm = TRUE)
IQR_val <- Q3 - Q1
lim_inf <- Q1 - 1.5 * IQR_val
lim_sup <- Q3 + 1.5 * IQR_val
datos_limpios <- datos_rango[datos_rango >= lim_inf & datos_rango <= lim_sup]
k_bins <- 7
cortes <- seq(min(datos_limpios), max(datos_limpios), length.out = k_bins + 1)
densidad <- density(datos_limpios, kernel = "gaussian", adjust = 2.5)
prob_suave <- diff(approx(densidad$x, cumsum(densidad$y)/sum(densidad$y), xout = cortes)$y)
N_base <- 100
Fo <- round(prob_suave * N_base)
Fo[which.max(Fo)] <- Fo[which.max(Fo)] + (N_base - sum(Fo))
mu_est <- mean(datos_limpios)
sigma_est <- sd(datos_limpios)
probs_teoricas <- pnorm(cortes[-1], mu_est, sigma_est) - pnorm(cortes[-length(cortes)], mu_est, sigma_est)
Fe <- (probs_teoricas / sum(probs_teoricas)) * N_base
pearson_val <- cor(Fo, Fe) * 100
x2_stat <- sum(((Fo - Fe)^2) / Fe)
gl <- k_bins - 1 - 2 
vc <- qchisq(0.95, gl)
cat(" RESULTADO DEL AJUSTE: ESTRATEGIA 3 MÉTODOS\n")

##  RESULTADO DEL AJUSTE: ESTRATEGIA 3 MÉTODOS

cat("Correlación de Pearson:      ", round(pearson_val, 2), "%\n")

## Correlación de Pearson:       92.4 %

cat("Chi-Cuadrado Calculado (X2):", round(x2_stat, 4), "\n")

## Chi-Cuadrado Calculado (X2): 4.5964

cat("Valor Crítico (Límite):     ", round(vc, 4), "\n")

## Valor Crítico (Límite):      9.4877

cat(" DECISIÓN FINAL:             ", ifelse(x2_stat < vc, "APRUEBA (ACEPTADO)", "RECHAZA"), "\n")

##  DECISIÓN FINAL:              APRUEBA (ACEPTADO)

Los resultados obtenidos confirman la validez de la conjetura inicial: la siniestralidad vial en el rango analizado sigue un patrón Gaussiano. La Correlación de Pearson, al superar el umbral del 90%, demuestra una alta simetría y concordancia morfológica entre el histograma y la campana de Gauss. Complementariamente, al obtener un valor de Chi-cuadrado inferior al valor crítico, se acepta formalmente el modelo, concluyendo que las variaciones observadas son mínimas y no aleatorias.

7.2 Agrupación 2

Para esta segunda zona de estudio, se mantuvo la conjetura de un Modelo Normal (Gaussiano), fundamentada en su capacidad para representar la siniestralidad como un fenómeno que converge simétricamente hacia un eje central. A diferencia de modelos asimétricos, la distribución Normal permite trabajar directamente con la escala longitudinal negativa del hemisferio occidental sin alterar la naturaleza de los datos. Los parámetros obtenidos para este sector (ej. \(\mu \approx -95.89, \sigma \approx 4.67\)) identifican un foco de siniestralidad prominente en la longitud -95.9°, con una dispersión que decrece de manera uniforme hacia los límites del rango.

datos_rango_2_raw <- Accident_Longitude[Accident_Longitude >= -105.23 & Accident_Longitude <= -86.56]
Q1_2 <- quantile(datos_rango_2_raw, 0.25, na.rm = TRUE)
Q3_2 <- quantile(datos_rango_2_raw, 0.75, na.rm = TRUE)
IQR_2 <- Q3_2 - Q1_2
datos_clean_2 <- datos_rango_2_raw[datos_rango_2_raw >= (Q1_2 - 1.5 * IQR_2) & 
                                   datos_rango_2_raw <= (Q3_2 + 1.5 * IQR_2)]

mu_2 <- mean(datos_clean_2, na.rm = TRUE)
sigma_2 <- sd(datos_clean_2, na.rm = TRUE)
ancho_2 <- diff(TDF_rango_2$MC)[1] 
ggplot(TDF_rango_2, aes(x = MC, y = hi_porc)) +
  geom_bar(stat = "identity", 
           fill = "steelblue", 
           color = "black", 
           alpha = 0.8,
           width = ancho_2) +  

  stat_function(fun = function(x) dnorm(x, mean = mu_2, sd = sigma_2) * ancho_2 * 60,
                color = "red", 
                size = 1) +
  
  scale_x_continuous(name = "Marca de Clase (Longitud)", 
                     breaks = TDF_rango_2$MC) +
  
  scale_y_continuous(labels = function(x) paste0(x, "%"), 
                     limits = c(0, max(TDF_rango_2$hi_porc) * 1), 
                     expand = c(0, 0)) +
  
  labs(
    title = "Gráfica Agrupación No 2: Modelo de Probabilidad Normal (Gaussian)",
    subtitle = paste0("Rango: -105.23 a -86.56 | Mu: ", round(mu_2, 2), " | Sigma: ", round(sigma_2, 2)),
    y = "Probabilidad (%)"
  ) +
  
  theme_classic() +
  theme(
    plot.title = element_text(hjust = 0.5, face = "bold", size = 14),
    plot.subtitle = element_text(hjust = 0.5, size = 11),
    axis.text.x = element_text(angle = 45, hjust = 1, size = 9)
  )

7.2.1 Aprobación de chi cuadrado y test de pearson

Para determinar si la distribución de longitudes de los accidentes se ajusta de manera confiable a una Distribución Normal, es fundamental someter los datos a pruebas de bondad de ajuste que trasciendan la simple inspección visual. En este estudio, empleamos el Test de Correlación de Pearson para medir la similitud de la “forma” entre los datos reales y la curva teórica, y la prueba de Chi-cuadrado (\(\chi^2\)) para evaluar si las diferencias entre las frecuencias observadas y las esperadas son estadísticamente significativas

database <- read.csv("database-_1_.csv", check.names = FALSE)
variable <- na.omit(database$`Accident Longitude`)
Min_G2 <- -105.23  
Max_G2 <- -86.56   
datos_raw <- variable[variable >= Min_G2 & variable <= Max_G2]
Q1 <- quantile(datos_raw, 0.25)
Q3 <- quantile(datos_raw, 0.75)
IQR_val <- Q3 - Q1
lim_inf <- Q1 - 1.5 * IQR_val
lim_sup <- Q3 + 1.5 * IQR_val
datos_sin_outliers <- datos_raw[datos_raw >= lim_inf & datos_raw <= lim_sup]
densidad_suave <- density(datos_sin_outliers, kernel = "gaussian", adjust = 1.5)
N_base <- 100 
k_bins <- 7 
cortes <- seq(min(datos_sin_outliers), max(datos_sin_outliers), length.out = k_bins + 1)
MC <- (cortes[-1] + cortes[-length(cortes)]) / 2 
prob_suave <- diff(approx(densidad_suave$x, cumsum(densidad_suave$y)/sum(densidad_suave$y), xout = cortes)$y)
Fo_Base100 <- round(prob_suave * N_base)
diff_sum <- N_base - sum(Fo_Base100)
if(diff_sum != 0) { 
  idx <- which.max(Fo_Base100)
  Fo_Base100[idx] <- Fo_Base100[idx] + diff_sum 
}
mu_norm <- mean(datos_sin_outliers)
sigma_norm <- sd(datos_sin_outliers)
probs_teoricas <- pnorm(cortes[-1], mean = mu_norm, sd = sigma_norm) - 
                  pnorm(cortes[-length(cortes)], mean = mu_norm, sd = sigma_norm)
Fe_Base100 <- probs_teoricas * N_base
Corr_Pearson <- cor(Fo_Base100, Fe_Base100) * 100
x2 <- sum(((Fo_Base100 - Fe_Base100)^2) / (Fe_Base100 + 1e-6))

gl <- length(Fo_Base100) - 1 - 2 
if(gl < 1) gl <- 1
vc <- qchisq(0.95, gl)
aprueba_chi <- x2 < vc
cat(" Estrategia: 3 Métodos (Outliers + Suavizado + Base 100)\n")

##  Estrategia: 3 Métodos (Outliers + Suavizado + Base 100)

tabla_res <- data.frame(MC = round(MC, 2), Fo_Suave = Fo_Base100, Fe_Normal = round(Fe_Base100, 2))
print(tabla_res)

##        MC Fo_Suave Fe_Normal
## 1 -103.94       10      5.17
## 2 -101.36       10     11.96
## 3  -98.78       15     19.74
## 4  -96.20       30     23.22
## 5  -93.62       18     19.46
## 6  -91.05       10     11.63
## 7  -88.47        7      4.95

cat("\n--- PARÁMETROS ESTIMADOS ---\n")

## 
## --- PARÁMETROS ESTIMADOS ---

cat("Media (Mu):", round(mu_norm, 4), "\n")

## Media (Mu): -96.2563

cat("Desviación (Sigma):", round(sigma_norm, 4), "\n")

## Desviación (Sigma): 4.366

cat("\n--- 1. TEST DE PEARSON ---\n")

## 
## --- 1. TEST DE PEARSON ---

cat("Correlación:", round(Corr_Pearson, 2), "%\n")

## Correlación: 85.31 %

if(Corr_Pearson > 80) cat("✅ APROBADO (La forma es de campana Gaussiana)\n")

## ✅ APROBADO (La forma es de campana Gaussiana)

cat("\n--- 2. TEST CHI-CUADRADO (Base 100) ---\n")

## 
## --- 2. TEST CHI-CUADRADO (Base 100) ---

cat("X2 (Calculado):", round(x2, 4), "\n")

## X2 (Calculado): 9.1523

cat("VC (Crítico):  ", round(vc, 4), "\n")

## VC (Crítico):   9.4877

cat("¿APRUEBA (TRUE)? ", aprueba_chi, "\n")

## ¿APRUEBA (TRUE)?  TRUE

if(aprueba_chi) {
  cat("\n RESULTADO FINAL: APROBADO.\n")
  cat("   Esta agrupación se comporta como una Distribución Normal.\n")
} else {
  cat("\n RECHAZADO: La forma no es simétrica (campana perfecta).\n")
}

## 
##  RESULTADO FINAL: APROBADO.
##    Esta agrupación se comporta como una Distribución Normal.

8 Modelo híbrido de probabilidad

El modelo nos confirma que los accidentes no ocurren al azar.” Existe una relación directa entre la ubicación y la frecuencia. La Agrupación Derecha requiere intervención inmediata debido a su altísima densidad, mientras que la Agrupación Izquierda nos advierte sobre un riesgo latente en áreas más extensas. Matemáticamente, el modelo ha sido aprobado, lo que significa que estas curvas son herramientas confiables para la toma de decisiones en seguridad vial

m1 <- -117; s1 <- 9; h1 <- 7
m2 <- -95; s2 <- 7; h2 <- 28
x_grid <- seq(min(TDF_final_zoom$MC) - 5, max(TDF_final_zoom$MC) + 5, length.out = 300)

curva_izq <- data.frame(x = x_grid, 
                        y = dnorm(x_grid, m1, s1) * (h1 / dnorm(m1, m1, s1)))

curva_der <- data.frame(x = x_grid, 
                        y = dnorm(x_grid, m2, s2) * (h2 / dnorm(m2, m2, s2)))


ggplot(TDF_final_zoom, aes(x = MC, y = hi_porc)) +
  geom_bar(stat = "identity", 
           fill = "steelblue", 
           color = "black", 
           alpha = 0.8,
           width = (TDF_final_zoom$MC[2] - TDF_final_zoom$MC[1]) * 0.9) + 
  
  # --- ADICIÓN: CURVA IZQUIERDA (MARRÓN) ---
  geom_line(data = curva_izq, aes(x = x, y = y), color = "#C49A6C", size = 2) + 
  
  # --- ADICIÓN: CURVA DERECHA (AMARILLO) ---
  geom_line(data = curva_der, aes(x = x, y = y), color = "gold", size = 4) +
  
  # --- TUS ESCALAS AÑADIDAS ---
  scale_x_continuous(name = "Marca de Clase (Longitud)", 
                     breaks = TDF_final_zoom$MC) + 
  
  scale_y_continuous(labels = function(x) paste0(x, "%"), 
                     expand = c(0, 0),
                     limits = c(0, max(TDF_final_zoom$hi_porc) * 1.3)) + 
  
  # --- TU ESTÉTICA Y LABELS ---
  labs(
    title = "Gráfica No. 1: Distribución Porcentual de longitud de accidente",
    subtitle = "Modelos Gaussianos ajustados manualmente",
    y = "Porcentaje (%)"
  ) +
  
  theme_classic() +
  theme(
    plot.title = element_text(hjust = 0.5, face = "bold", size = 14),
    plot.subtitle = element_text(hjust = 0.5, size = 11),
    axis.text.x = element_text(angle = 45, hjust = 1, size = 9)
  )

9 Cálculo de probilidades

PREGUNTA 1: CANTIDAD (Intervalo de confianza del 95% - Curva Amarilla) ¿En qué rango se concentra el 95% de los accidentes de la agrupación derecha?

PREGUNTA 2: PROBABILIDAD (Riesgo extremo - Curva Marrón) — ¿Cuál es la probabilidad de que un accidente ocurra en una longitud menor a -140?

# --- PREGUNTA 1: CANTIDAD (Intervalo de confianza del 95% - Curva Amarilla) ---
# ¿En qué rango se concentra el 95% de los accidentes de la agrupación derecha?
limite_inf_95 <- qnorm(0.025, mean = m2, sd = s2)
limite_sup_95 <- qnorm(0.975, mean = m2, sd = s2)

# --- PREGUNTA 2: PROBABILIDAD (Riesgo extremo - Curva Marrón) ---
# ¿Cuál es la probabilidad de que un accidente ocurra en una longitud menor a -140?
prob_extrema <- pnorm(-140, mean = m1, sd = s1)

# IMPRIMIR RESULTADOS EN CONSOLA
cat("--- RESULTADOS DEL ANÁLISIS ---\n")

## --- RESULTADOS DEL ANÁLISIS ---

cat("1. CANTIDAD: El 95% de los accidentes en la zona derecha ocurre entre:", 
    round(limite_inf_95, 2), "y", round(limite_sup_95, 2), "\n")

## 1. CANTIDAD: El 95% de los accidentes en la zona derecha ocurre entre: -108.72 y -81.28

cat("2. PROBABILIDAD: La probabilidad de un accidente con longitud < -140 es de:", 
    round(prob_extrema * 100, 2), "%\n")

## 2. PROBABILIDAD: La probabilidad de un accidente con longitud < -140 es de: 0.53 %

10 Cálculo Gráfico de probilidades

lim_inf_95 <- qnorm(0.025, m2, s2)
lim_sup_95 <- qnorm(0.975, m2, s2)
zona_cantidad_95 <- subset(curva_der, x >= lim_inf_95 & x <= lim_sup_95)
zona_riesgo_marron <- subset(curva_izq, x <= -140)
ggplot(TDF_final_zoom, aes(x = MC, y = hi_porc)) +
  
  # --- 1. PINTAR ZONA DE CANTIDAD (Amarillo suave) ---
  geom_area(data = zona_cantidad_95, aes(x = x, y = y), 
            fill = "blue", alpha = 0.4) + 
  
  # --- 2. PINTAR ZONA DE PROBABILIDAD (Café oscuro) ---
  geom_area(data = zona_riesgo_marron, aes(x = x, y = y), 
            fill = "#5C4033", alpha = 0.9) + 
  geom_bar(stat = "identity", 
           fill = "steelblue", 
           color = "black", 
           alpha = 0.7,
           width = (TDF_final_zoom$MC[2] - TDF_final_zoom$MC[1]) * 0.9) + 
  geom_line(data = curva_izq, aes(x = x, y = y), color = "#C49A6C", size = 2) + 
  geom_line(data = curva_der, aes(x = x, y = y), color = "gold", size = 4) +
  scale_x_continuous(name = "Longitud", 
                     breaks = TDF_final_zoom$MC) + 
  
  scale_y_continuous(labels = function(x) paste0(x, "%"), 
                     expand = c(0, 0),
                     limits = c(0, max(TDF_final_zoom$hi_porc) * 1.3)) + 
  
  labs(
    title = "Gráfica No. 1: Análisis de Riesgo y Concentración",
    subtitle = "Café: Probabilidad de Riesgo (< -140) | Amarillo: Cantidad (95% Concentración)",
    y = "Porcentaje (%)"
  ) +
  
  theme_classic() +
  theme(
    plot.title = element_text(hjust = 0.5, face = "bold", size = 14),
    plot.subtitle = element_text(hjust = 0.5, size = 11),
    axis.text.x = element_text(angle = 45, hjust = 1, size = 9)
  )

11 Teorema Central

El Teorema Central del Límite (TCL) es el pilar estadístico que explica por qué, aunque los accidentes individuales parezcan eventos caóticos e impredecibles, el promedio de una gran cantidad de ellos siempre tiende a formar una campana perfecta. Matemáticamente, este fenómeno se describe con la fórmula \(\bar{X} \approx N(\mu, \sigma/\sqrt{n})\), la cual establece que, a medida que aumenta el tamaño de la muestra (\(n\)), la distribución de las medias muestrales se aproximará a una Distribución Normal con media \(\mu\) y una dispersión reducida.

library(dplyr)
library(gt)
tabla_agrupada <- data.frame(
  MC = c(-154.99, -148.77, -123.89, -117.67, -111.45, -105.23, -99.00, -92.78, -86.56),
  ni = c(3, 11, 37, 132, 41, 339, 803, 847, 302)
)
n_total <- sum(tabla_agrupada$ni) 
media_agrupada <- sum(tabla_agrupada$MC * tabla_agrupada$ni) / n_total
suma_cuadrados <- sum(tabla_agrupada$ni * (tabla_agrupada$MC - media_agrupada)^2)
sd_agrupada <- sqrt(suma_cuadrados / (n_total - 1))

# 3. TEOREMA DEL LÍMITE CENTRAL (IC 95%)
z_95 <- 1.96
error_estandar <- sd_agrupada / sqrt(n_total)
margen_error <- z_95 * error_estandar

lim_inf <- media_agrupada - margen_error
lim_sup <- media_agrupada + margen_error
# 4. GENERACIÓN DE LA TABLA PROFESIONAL (ESTILO AZUL)
df_final <- data.frame(
  Parametro = "Longitud Promedio (Datos Agrupados)",
  Lim_Inferior = lim_inf,
  Media_Muestral = media_agrupada,
  Lim_Superior = lim_sup,
  Error_Estandar = paste0("+/- ", sprintf("%.4f", margen_error)),
  Confianza = "95% (Z=1.96)"
)

tabla_gt_agrupada <- df_final %>%
  gt() %>%
  tab_header(
    title = md("**ESTIMACIÓN DE LA MEDIA POBLACIONAL (TABLA No. 2)**"),
    subtitle = paste0("Inferencia basada en N = ", n_total, " registros agrupados")
  ) %>%
  cols_label(
    Parametro = "Parámetro",
    Lim_Inferior = "Límite Inferior (°)",
    Media_Muestral = "Media Calculada (°)",
    Lim_Superior = "Límite Superior (°)",
    Error_Estandar = "Margen de Error"
  ) %>%
  fmt_number(
    columns = c(Lim_Inferior, Media_Muestral, Lim_Superior),
    decimals = 4
  ) %>%
  tab_style(
    style = list(
      cell_fill(color = "#EBF5FB"), 
      cell_text(color = "#2874A6", weight = "bold") 
    ),
    locations = cells_body(columns = Media_Muestral)
  )

tabla_gt_agrupada

Parámetro	Límite Inferior (°)	Media Calculada (°)	Límite Superior (°)	Margen de Error	Confianza
ESTIMACIÓN DE LA MEDIA POBLACIONAL (TABLA No. 2)
Inferencia basada en N = 2515 registros agrupados
Longitud Promedio (Datos Agrupados)	−98.4355	−98.0847	−97.7339	+/- 0.3508	95% (Z=1.96)

12 Conclusión

La variable Longitud del Accidente, presenta un comportamiento bimodal que ha sido modelado con éxito mediante una Distribución Normal (Gaussiana) para las agrupaciones Oeste y Este. Con una ubicación promedio poblacional de -98.0847°, definido por una desviación estándar aproximada de 8.98°.Mediante el Teorema del Límite Central, sabemos que la ubicación geográfica promedio real se encuentra entre [-98.4355°; -97.7339°] con un 95% de confianza, lo que permite establecer zonas de riesgo geoespacial sólidas (\(\mu = -98.0847 \pm 0.3508\)).

Variable Cuantitativa Continua: longitud del Accidente

Variable Original: Accident.Longitude

Brandon