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$Liquid.Subtype

2 Tabla de distribución de frecuencia

Extraemos la tabla de resumen de los Subtipos de Líquido clasificados por Riesgo. Guardamos el conteo en ‘ni’, calculamos la suma total y obtenemos el porcentaje (‘hi’) que representa cada líquido. Finalmente, creamos el dataframe final (TDF_agrupada) con el Nivel de Riesgo, el Subtipo, ni y hi.

datos_liquidos <- datos %>%
  mutate(Subtipo_Clean = case_when(
    is.na(Liquid.Subtype) | Liquid.Subtype == "" ~ "CRUDO / CO2",
    grepl("DIESEL", Liquid.Subtype) ~ "DIESEL / JET FUEL / KEROSENE",
    grepl("GASOLINE", Liquid.Subtype) ~ "GASOLINA",
    grepl("LPG", Liquid.Subtype) ~ "GASES LICUADOS",
    grepl("OTHER HVL", Liquid.Subtype) ~ "LÍQUIDO AlTAMENTE VOLÁTIL",
    TRUE ~ "AMONÍACO, BIODIESEL" 
  )) %>%
  mutate(Nivel_Riesgo = case_when(
    Subtipo_Clean == "CRUDO / CO2" ~ 1,
    Subtipo_Clean %in% c("GASOLINA", "DIESEL / JET FUEL / KEROSENE", "AMONÍACO, BIODIESEL") ~ 2,
    Subtipo_Clean %in% c("GASES LICUADOS", "LÍQUIDO AlTAMENTE VOLÁTIL") ~ 3,
    
    TRUE ~ 0
  ))
TDF_agrupada <- datos_liquidos %>%
  count(Nivel_Riesgo, Subtipo_Clean, name = "ni") %>%
  arrange(Nivel_Riesgo, desc(ni)) 
ni_total <- sum(TDF_agrupada$ni)
TDF_agrupada$hi <- (TDF_agrupada$ni / ni_total) * 100
TDF_agrupada$hi <- sprintf("%.2f", round(TDF_agrupada$hi, 2))
Sumatoria <- data.frame(
  Nivel_Riesgo = "",
  Subtipo_Clean = "TOTAL",
  ni = ni_total,
  hi = "100.00"
)

TDF_final <- rbind(TDF_agrupada, Sumatoria)
colnames(TDF_final) <- c("Nivel Riesgo", "Tipo de Subtipo de Líquido", "ni", "hi (%)")
kable(TDF_final, align = 'c', 
      caption = "Tabla 1: Frecuencia de Líquidos por Riesgo") %>%
  kable_styling(full_width = FALSE, position = "center", 
                bootstrap_options = c("striped", "hover", "condensed")) %>%
  row_spec(nrow(TDF_final), bold = TRUE, background = "#f2f2f2") %>%
  row_spec(which(TDF_final$`Nivel Riesgo` == "3"), bold = TRUE)
Tabla 1: Frecuencia de Líquidos por Riesgo
Nivel Riesgo Tipo de Subtipo de Líquido ni hi (%)
1 CRUDO / CO2 1446 51.74
2 DIESEL / JET FUEL / KEROSENE 410 14.67
2 GASOLINA 376 13.45
2 AMONÍACO, BIODIESEL 204 7.30
3 GASES LICUADOS 188 6.73
3 LÍQUIDO AlTAMENTE VOLÁTIL 171 6.12
TOTAL 2795 100.00

3 Caracterización de los Líquidos por Volumen de Accidentes y Riesgo

Este reporte presenta un análisis estadístico detallado sobre la siniestralidad en la infraestructura de transporte de hidrocarburos, estructurado en un flujo de trabajo que va desde la gestión de datos brutos hasta la interpretación de riesgos operativos. El estudio inicia con la carga y depuración de una base de datos de accidentes (\(N = 2795\)), utilizando herramientas de programación en R para organizar la información en tablas de frecuencia precisas.

datos %>%
  mutate(Subtipo = case_when(
    is.na(Liquid.Subtype) | Liquid.Subtype == "" ~ "CRUDO / CO2 ",
    grepl("DIESEL", Liquid.Subtype) ~ "DIESEL / JET FUEL / KEROSENE",
    grepl("GASOLINE", Liquid.Subtype) ~ "GASOLINA",
    grepl("LPG", Liquid.Subtype) ~ "AMONÍACO, BIODIESEL",
    grepl("OTHER HVL", Liquid.Subtype) ~ "LÍQUIDO ALTAMENTE VOLÁTIL",
    TRUE ~ "GASES LICUADOS"),
  Riesgo = case_when(
    Subtipo == "CRUDO / CO2 " ~ "1. Bajo",
    Subtipo %in% c("GASES LICUADOS", "LÍQUIDO ALTAMENTE VOLÁTIL") ~ "3. Alto",
    TRUE ~ "2. Medio")) %>% 
  count(Riesgo, Subtipo) %>%
  ggplot(aes(x = reorder(Subtipo, -n), y = n, fill = Riesgo)) + 
  geom_col(width = 0.65, color = "black") +
  scale_fill_manual(values = c("lightblue2", "dodgerblue3", "#154360")) +
  labs(title = "Gráfica N°1: Cantidad de Eventos por Líquido y Riesgo", x = "Subtipo", y = "Cantidad") +
  theme_light() + 
  theme(axis.text.x = element_text(angle = 35, hjust = 1), legend.position = "top")

4 Análisis de gráficas por agrupación

Agrupación 1 (Crudo, Diesel, Gasolina): Estos tres subtipos concentran el 79.86% de la frecuencia acumulada total (Principio de Pareto). Se analizan como el “comportamiento estándar” o mayoritario de los accidentes.

Agrupación 2 (Gases, Amoníaco, Volátiles): Representan el 20% restante (“Cola de la distribución”). Se aíslan para evaluar si estos eventos menos frecuentes siguen el mismo modelo matemático (Geométrico) sin que sus probabilidades se vean distorsionadas por el peso estadístico del Grupo 1.

5 Agrupación 1

5.1 Estudio desde crudo hasta gasolina

Para mejorar la interpretación, segmentamos la gráfica. Esta división permite comparar los distintos escenarios de riesgo de forma aislada y mucho más nítida.

datos %>%
  mutate(Subtipo = case_when(
    is.na(Liquid.Subtype) | Liquid.Subtype == "" ~ "CRUDO / CO2 ",
    grepl("DIESEL", Liquid.Subtype) ~ "DIESEL / JET FUEL / KEROSENE",
    grepl("GASOLINE", Liquid.Subtype) ~ "GASOLINA",
    grepl("LPG", Liquid.Subtype) ~ "AMONÍACO, BIODIESEL",
    grepl("OTHER HVL", Liquid.Subtype) ~ "LÍQUIDO ALTAMENTE VOLÁTIL",
    TRUE ~ "GASES LICUADOS"),
  Riesgo = case_when(
    Subtipo == "CRUDO / CO2 " ~ "1. Bajo",
    Subtipo %in% c("GASES LICUADOS", "LÍQUIDO ALTAMENTE VOLÁTIL") ~ "3. Alto",
    TRUE ~ "2. Medio")) %>% 
  filter(Subtipo %in% c("CRUDO / CO2 ", "DIESEL / JET FUEL / KEROSENE", "GASOLINA")) %>%
  count(Riesgo, Subtipo) %>%
  ggplot(aes(x = reorder(Subtipo, -n), y = n, fill = Riesgo)) + 
  geom_col(width = 0.75, color = "black") +
  scale_fill_manual(values = c(
    "1. Bajo" = "#AED6F1", 
    "2. Medio" = "#3498DB", 
    "3. Alto" = "#154360"
  )) +
  
  labs(title = "Gráfica N2: Análisis del agrupación 1", x = "Subtipo", y = "Cantidad") +
  theme_light() + 
  theme(axis.text.x = element_text(angle = 45, hjust = 1), legend.position = "top")

5.2 Cálculo de Frecuencias Relativas para los 3 Primeros Líquidos

Filtramos los datos del data frame TDF_agrupada para seleccionar solo las primeras 3 filas, creamos un nuevo data frame con esa selección y calculamos las frecuencias relativas de la columna ni en ese subconjunto.

Liquid1_3 <- TDF_agrupada[1:3, ]
tdfliquid1_3 <- data.frame(Liquid1_3)
hi1 <- tdfliquid1_3$ni / sum(tdfliquid1_3$ni)
hi1
## [1] 0.6478495 0.1836918 0.1684588
datos %>%
  mutate(Subtipo = case_when(
    is.na(Liquid.Subtype) | Liquid.Subtype == "" ~ "CRUDO / CO2 ",
    grepl("DIESEL", Liquid.Subtype) ~ "DIESEL / JET FUEL / KEROSENE",
    grepl("GASOLINE", Liquid.Subtype) ~ "GASOLINA",
    grepl("LPG", Liquid.Subtype) ~ "AMONÍACO, BIODIESEL",
    grepl("OTHER HVL", Liquid.Subtype) ~ "LÍQUIDO ALTAMENTE VOLÁTIL",
    TRUE ~ "GASES LICUADOS"),
  Riesgo = case_when(
    Subtipo == "CRUDO / CO2 " ~ "1. Bajo",
    Subtipo %in% c("GASES LICUADOS", "LÍQUIDO ALTAMENTE VOLÁTIL") ~ "3. Alto",
    TRUE ~ "2. Medio")) %>% 
  filter(Subtipo %in% c("CRUDO / CO2 ", "DIESEL / JET FUEL / KEROSENE", "GASOLINA")) %>%
  count(Riesgo, Subtipo) %>% mutate(hi = n / sum(n)) %>%
  ggplot(aes(reorder(Subtipo, -hi), hi, fill = Riesgo)) + 
  geom_col(width = 0.75, col = "black") +
  scale_fill_manual(values = c("1. Bajo"="#AED6F1", "2. Medio"="#3498DB", "3. Alto"="#154360")) +
  labs(title="Gráfica N3:Distribución Relativa de Subtipos de líquidos", x="Subtipo", y="Probabilidad") +
  theme_light() + theme(axis.text.x = element_text(angle=45, hjust=1), legend.position="top")

5.3 Conjetura de modelo

Se eligió el Modelo Geométrico porque nuestros datos presentan un patrón de decaimiento rápido. Al observar la gráfica de barras, vemos que la frecuencia de accidentes no es uniforme: hay una categoría dominante (‘Crudo’) seguida de una caída abrupta en las siguientes. Matemáticamente, la Distribución Geométrica es ideal para modelar este tipo de comportamientos donde la probabilidad disminuye drásticamente a medida que avanzamos en el ranking.

Liquid1_3 <- TDF_agrupada[1:3, ]
tdfliquid1_3 <- data.frame(Liquid1_3)
tdfliquid1_3$x <- 1:3 

# 2. Calcular parámetros (Media y p)
media_subset3 <- sum(tdfliquid1_3$x * tdfliquid1_3$ni) / sum(tdfliquid1_3$ni)
p_geo <- 1 / media_subset3

# 3. Calcular Distribución Geométrica
P_Geometrica <- dgeom(tdfliquid1_3$x - 1, prob = p_geo)
data.frame(
  Liquido = tdfliquid1_3$Subtipo_Clean,
  Prob_Geom = P_Geometrica
)
##                        Liquido  Prob_Geom
## 1                  CRUDO / CO2 0.65763111
## 2 DIESEL / JET FUEL / KEROSENE 0.22515243
## 3                     GASOLINA 0.07708519

A continuación, contrastamos gráficamente los datos reales (barras celestes) frente a las predicciones teóricas (barras oscuras). El objetivo es verificar visualmente si el Modelo Geométrico logra replicar con precisión el comportamiento de los principales líquidos, validando su uso para la estimación de riesgos.

Liquid1_3 <- TDF_agrupada[1:3, ]
df_geo <- data.frame(Liquid1_3)
df_geo$x <- 1:3 
df_geo$Real <- df_geo$ni / sum(df_geo$ni)
media_subset3 <- sum(df_geo$x * df_geo$ni) / sum(df_geo$ni)
p_geo <- 1 / media_subset3
df_geo$Geometrica <- dgeom(df_geo$x - 1, prob = p_geo)
df_grafica <- df_geo %>%
  select(Subtipo_Clean, x, Real, Geometrica) %>%
  pivot_longer(cols = c("Real", "Geometrica"), names_to = "Tipo", values_to = "Probabilidad")

# --- 4. GENERAR GRÁFICA ---
ggplot(df_grafica, aes(x = reorder(Subtipo_Clean, x), y = Probabilidad, fill = Tipo)) +
  geom_col(position = "dodge", width = 0.7, color = "black") +
  scale_fill_manual(
    values = c("Real" = "#87CEEB", "Geometrica" = "#2E86C1"),
    labels = c("Real" = "Probabilidad Observada", "Geometrica" = "Modelo Geométrico")
  ) +
  labs(
    title = "Gráfica N4: Comparación Real vs. Modelo Geométrico",
    x = "Subtipo de Líquido",
    y = "Probabilidad"
  ) +
  theme_light() +
  theme(
    plot.title = element_text(face = "bold", hjust = 0.5),
    axis.text.x = element_text(angle = 45, hjust = 1, color = "black"),
    legend.position = "top",
    legend.title = element_blank()
  )

Realizamos esta gráfica para hacer una prueba visual de confianza. Las barras celestes representan la realidad (lo que ocurrió históricamente) y las barras azules oscuras representan lo que nuestro modelo matemático predijo. Al ponerlas una al lado de la otra, podemos confirmar con un solo vistazo que el modelo no está ‘alucinando’, sino que imita casi a la perfección el comportamiento real de los accidentes. Si las barras tienen alturas similares, significa que podemos confiar en este modelo para predecir riesgos futuros.

5.4 Test Pearson

Aunque la gráfica anterior nos mostró visualmente que el modelo se ajusta bien, en ciencia necesitamos pruebas numéricas. El Test de Pearson es nuestra ‘prueba de la verdad’: calcula matemáticamente qué tan fuerte es la relación entre la realidad y la teoría. Si el resultado es alto (cercano al 100%), confirmamos que el modelo es confiable y no una simple coincidencia visual.

Liquid1_3 <- TDF_agrupada[1:3, ]
tdfliquid1_3 <- data.frame(Liquid1_3)
tdfliquid1_3$x <- 1:3 
hi1 <- tdfliquid1_3$ni / sum(tdfliquid1_3$ni)

Fo1 <- hi1
Fo1  
## [1] 0.6478495 0.1836918 0.1684588
media_subset3 <- sum(tdfliquid1_3$x * tdfliquid1_3$ni) / sum(tdfliquid1_3$ni)
p_geo <- 1 / media_subset3

P1 <- dgeom(tdfliquid1_3$x - 1, prob = p_geo)

Fe1 <- P1
Fe1  
## [1] 0.65763111 0.22515243 0.07708519

A continuación, presentamos un gráfico de dispersión para analizar la correlación entre los datos reales y nuestro modelo teórico. En este plano cartesiano, enfrentamos la Frecuencia Observada (\(F_o\)) contra la Frecuencia Esperada (\(F_e\)). La línea diagonal roja representa el ajuste perfecto (\(y=x\)); por lo tanto, cuanto más cerca se encuentren los puntos de esta recta, mayor será la precisión del Modelo Geométrico para predecir el comportamiento de estos líquidos

Fo1 <- tdfliquid1_3$ni / sum(tdfliquid1_3$ni)
media_subset3 <- sum(tdfliquid1_3$x * tdfliquid1_3$ni) / sum(tdfliquid1_3$ni)
p_geo <- 1 / media_subset3
Fe1 <- dgeom(tdfliquid1_3$x - 1, prob = p_geo)
plot(Fo1, Fe1,
     main = "Gráfica N5: Evaluación Visual de la Bondad de Ajuste",
     xlab = "Frecuencia Observada (Fo1)",
     ylab = "Frecuencia Esperada (Fe1)",
     pch = 1,     
     cex = 1.5,     
     xlim = c(0, 1),
     ylim = c(0, 1))
abline(a = 0, b = 1, col = "red", lwd = 2) 
text(Fo1, Fe1, labels = tdfliquid1_3$Subtipo_Clean, pos = 4, cex = 0.7)

Correlacion1 <- cor(Fo1, Fe1) * 100 
Correlacion1
## [1] 97.5898

El resultado del 97.59% confirma que existe una correlación casi perfecta entre la realidad y la teoría. Esto significa que el Modelo Geométrico replica el comportamiento de los accidentes con una precisión extremadamente alta.

5.5 Chi cuadrado

Para validar la bondad de ajuste en este subgrupo de líquidos, aplicamos el test de Chi-Cuadrado configurado con 2 grados de libertad (derivados de las 3 categorías analizadas: \(k-1\)) y un nivel de significancia estándar del 0.05. El criterio de decisión se basa en comparar nuestro estadístico calculado contra el umbral crítico de aceptación (aprox. 5.99); dado que buscamos validar el modelo, si el error calculado resulta inferior a este umbral, aceptamos estadísticamente que no existen diferencias significativas entre la realidad y la teoría, confirmando que el Modelo Geométrico es adecuado para predecir el comportamiento de estos líquidos secundarios.

x2 <- sum(((Fo1 - Fe1)^2) / Fe1)
x2
## [1] 0.1160907
vc <- qchisq(0.95, 2) 
vc
## [1] 5.991465
x2 < vc
## [1] TRUE

El resultado de la prueba lógica (TRUE) confirma que el valor del estadístico Chi-Cuadrado calculado (\(\chi^2 = 0.116\)) se encuentra muy por debajo del valor crítico (\(\chi^2_{crit} = 5.99\)) para un nivel de confianza del 95%. Esto valida estadísticamente nuestra hipótesis: el Modelo Geométrico se ajusta satisfactoriamente a los datos observados y es una herramienta confiable para estimar la probabilidad de accidentes en estos tipos de líquidos.

5.6 Tabla resumen test

Variable <- c("Subtipo de Líquido")
tabla_resumen <- data.frame(
  Variable, 
  round(Correlacion1, 2), 
  round(x2, 2), 
  round(vc, 2)
)
colnames(tabla_resumen) <- c("Variable", "Test Pearson (%)", "Chi Cuadrado", "Umbral de aceptación")

kable(tabla_resumen, 
      format = "markdown", 
      caption = "Tabla Resumen: Test de Bondad de Ajuste")
Tabla Resumen: Test de Bondad de Ajuste
Variable Test Pearson (%) Chi Cuadrado Umbral de aceptación
Subtipo de Líquido 97.59 0.12 5.99

5.7 Cálculo de probabilidades

PREGUNTA N1: ¿Cuál es la probabilidad de que ocurra un accidente de RIESGO BAJO?

PREGUNTA N2: ¿Cuál es la “brecha” o diferencia de cantidad entre el líquido más frecuente y el menos frecuente?

n1 <- sum(tdfliquid1_3$ni)
n1  
## [1] 2232
#PREGUNTA N1: ¿Cuál es la probabilidad de que ocurra un accidente de RIESGO BAJO?
dgeom(1 - 1, prob = p_geo)
## [1] 0.6576311
#PREGUNTA N2 ¿Cuál es la "brecha" o diferencia de cantidad entre el líquido más frecuente y el menos frecuente?

max_acc <- max(tdfliquid1_3$ni)
min_acc <- min(tdfliquid1_3$ni)


diferencia <- max_acc - min_acc


cat("La diferencia entre el mayor y menor número de accidentes es:", diferencia)
## La diferencia entre el mayor y menor número de accidentes es: 1070

6 Agrupación 2

6.1 Estudio desde gases licuados hasta líquido altamente volátil

Repetimos el proceso de aislamiento para los líquidos restantes. Esta división nos permite hacercar más en los datos menos frecuentes y comprobar que la tendencia decreciente del riesgo se mantiene constante, sin importar el volumen total de accidentes

library(dplyr)
library(ggplot2)

datos %>%
  mutate(Subtipo = case_when(
    is.na(Liquid.Subtype) | Liquid.Subtype == "" ~ "CRUDO / CO2 ",
    grepl("DIESEL", Liquid.Subtype) ~ "DIESEL / JET FUEL / KEROSENE",
    grepl("GASOLINE", Liquid.Subtype) ~ "GASOLINA",
    grepl("LPG", Liquid.Subtype) ~ "AMONÍACO, BIODIESEL",
    grepl("OTHER HVL", Liquid.Subtype) ~ "LÍQUIDO ALTAMENTE VOLÁTIL",
    TRUE ~ "GASES LICUADOS"),
  Riesgo = case_when(
    Subtipo == "CRUDO / CO2 " ~ "1. Bajo",
    Subtipo %in% c("GASES LICUADOS", "LÍQUIDO ALTAMENTE VOLÁTIL") ~ "3. Alto",
    TRUE ~ "2. Medio")) %>% 
  filter(Subtipo %in% c("GASES LICUADOS", "AMONÍACO, BIODIESEL", "LÍQUIDO ALTAMENTE VOLÁTIL")) %>%
  count(Riesgo, Subtipo) %>%
  ggplot(aes(x = reorder(Subtipo, -n), y = n, fill = Riesgo)) + 
  geom_col(width = 0.75, color = "black") +
  scale_fill_manual(values = c(
    "1. Bajo" = "#AED6F1", 
    "2. Medio" = "#3498DB", 
    "3. Alto" = "#154360"
  )) +
  
  labs(title = "Gráfica N6: Líquidos y Nivel de Riesgo", x = "Subtipo", y = "Cantidad") +
  theme_light() + 
  theme(axis.text.x = element_text(angle = 45, hjust = 1), legend.position = "top")

6.2 Cálculo de Frecuencias Relativas para los 3 últimos Líquidos

Procedemos a filtrar nuevamente el data frame TDF_agrupada, esta vez seleccionando las filas 4 a 6 que corresponden a los líquidos con menor frecuencia. Generamos un nuevo subconjunto de datos y recalculamos las frecuencias relativas (hi) de la columna ni dentro de este grupo específico, permitiendo un análisis porcentual independiente para la cola de la distribución.

Liquid4_6 <- TDF_agrupada[4:6, ]
tdfliquid4_6 <- data.frame(Liquid4_6)
hi2 <- tdfliquid4_6$ni / sum(tdfliquid4_6$ni)
hi2
## [1] 0.3623446 0.3339254 0.3037300

En este gráfico visualizamos cómo se distribuye la probabilidad interna del segundo grupo. A diferencia de los líquidos de agrupación 1, aquí observamos una mayor presencia de categorías de Riesgo Alto (barras oscuras) a pesar de tener una menor frecuencia de ocurrencia total.

library(dplyr)
library(ggplot2)

datos %>%
  mutate(Subtipo = case_when(
    is.na(Liquid.Subtype) | Liquid.Subtype == "" ~ "CRUDO / CO2 ",
    grepl("DIESEL", Liquid.Subtype) ~ "DIESEL / JET FUEL / KEROSENE",
    grepl("GASOLINE", Liquid.Subtype) ~ "GASOLINA",
    grepl("LPG", Liquid.Subtype) ~ "AMONÍACO, BIODIESEL",
    grepl("OTHER HVL", Liquid.Subtype) ~ "LÍQUIDO ALTAMENTE VOLÁTIL",
    TRUE ~ "GASES LICUADOS"),
  Riesgo = case_when(
    Subtipo == "CRUDO / CO2 " ~ "1. Bajo",
    Subtipo %in% c("GASES LICUADOS", "LÍQUIDO ALTAMENTE VOLÁTIL") ~ "3. Alto",
    TRUE ~ "2. Medio")) %>% 
  filter(Subtipo %in% c("GASES LICUADOS", "AMONÍACO, BIODIESEL", "LÍQUIDO ALTAMENTE VOLÁTIL")) %>%
  count(Riesgo, Subtipo) %>% 
  mutate(hi = n / sum(n)) %>% 
  ggplot(aes(x = reorder(Subtipo, -hi), y = hi, fill = Riesgo)) + 
  geom_col(width = 0.75, col = "black") +
  scale_fill_manual(values = c("1. Bajo"="#AED6F1", "2. Medio"="#3498DB", "3. Alto"="#154360")) +
  labs(title = "Gráfica N7: Perfil de Riesgo del Grupo de Menor Frecuencia (Gases y Volátiles)", 
       x = "Subtipo", 
       y = "Probabilidad") +
  
  theme_light() + 
  theme(axis.text.x = element_text(angle = 45, hjust = 1), legend.position = "top")

6.3 Conjetura del modelo

Para esta segunda agrupación, aplicamos el Modelo Geométrico con el fin de caracterizar los riesgos menos frecuentes. A diferencia del primer grupo, donde la caída era drástica, aquí la gráfica muestra un descenso mucho más suave y gradual. Elegimos este modelo porque, matemáticamente, logra capturar esta estructura escalonada, confirmando que incluso en los líquidos secundarios existe un orden descendente de probabilidad y no una distribución aleatoria.

Liquid4_6 <- TDF_agrupada[4:6, ]
tdfliquid4_6 <- data.frame(Liquid4_6)
media_subset_2 <- sum(seq_along(tdfliquid4_6$ni) * tdfliquid4_6$ni) / sum(tdfliquid4_6$ni)
p_geo_2 <- 1 / media_subset_2
P_Geometrica_2 <- dgeom(seq_along(tdfliquid4_6$ni) - 1, prob = p_geo_2)
data.frame(
  Liquido = tdfliquid4_6$Subtipo_Clean,
  Prob_Geom = P_Geometrica_2
)
##                     Liquido Prob_Geom
## 1       AMONÍACO, BIODIESEL 0.5150961
## 2            GASES LICUADOS 0.2497721
## 3 LÍQUIDO AlTAMENTE VOLÁTIL 0.1211155

A continuación, replicamos la validación visual para el grupo restante (Gases y Volátiles). Enfrentamos la frecuencia real contra la teórica para determinar si el Modelo Geométrico es capaz de simular correctamente la ‘cola de la distribución’. La cercanía entre las barras nos indicará si la teoría de probabilidad sigue siendo válida incluso para los eventos menos comunes.

library(ggplot2)
library(dplyr)
library(tidyr)
Liquid4_6 <- TDF_agrupada[4:6, ]
df_geo_2 <- data.frame(Liquid4_6)
df_geo_2$x <- 1:3 
df_geo_2$Real <- df_geo_2$ni / sum(df_geo_2$ni)
media_subset_2 <- sum(df_geo_2$x * df_geo_2$ni) / sum(df_geo_2$ni)
p_geo_2 <- 1 / media_subset_2
df_geo_2$Geometrica <- dgeom(df_geo_2$x - 1, prob = p_geo_2)
df_grafica_2 <- df_geo_2 %>%
  select(Subtipo_Clean, x, Real, Geometrica) %>%
  pivot_longer(cols = c("Real", "Geometrica"), names_to = "Tipo", values_to = "Probabilidad")

# --- 4. GENERAR GRÁFICA ---
ggplot(df_grafica_2, aes(x = reorder(Subtipo_Clean, x), y = Probabilidad, fill = Tipo)) +
  geom_col(position = "dodge", width = 0.7, color = "black") +
  scale_fill_manual(
    values = c("Real" = "#87CEEB", "Geometrica" = "#2E86C1"),
    labels = c("Real" = "Probabilidad Observada", "Geometrica" = "Modelo Geométrico")
  ) +
  labs(
    title = "Gráfica N8: Comparación Real vs. Modelo (Agrupación 2)",
    x = "Subtipo de Líquido",
    y = "Probabilidad"
  ) +
  theme_light() +
  theme(
    plot.title = element_text(face = "bold", hjust = 0.5),
    axis.text.x = element_text(angle = 45, hjust = 1, color = "black"),
    legend.position = "top",
    legend.title = element_blank()
  )

En este gráfico contrastamos las predicciones del Modelo Geométrico (barras azul oscuro) frente a los datos históricos reales (barras celestes) para los líquidos de menor frecuencia. Visualmente, detectamos una diferencia en el comportamiento: mientras que el modelo matemático proyecta una ‘escalera’ descendente clara, la realidad muestra una distribución mucho más uniforme y equilibrada. Esto nos indica que, a diferencia de los líquidos principales, en este subgrupo (Amoníaco, Gases y Volátiles) el riesgo de accidente tiende a ser casi el mismo para los tres, en lugar de disminuir drásticamente como sugería la teoría.

6.4 Test Pearson

Aunque la comparación gráfica nos dio una primera impresión del comportamiento de estos líquidos secundarios, en ciencia requerimos pruebas numéricas para validar la ‘cola de la distribución’. Aplicamos el Test de Pearson como nuestra ‘prueba de la verdad’ para este subgrupo: calculará qué tan fuerte es la relación entre los datos reales y la proyección geométrica. Si obtenemos un porcentaje alto, confirmaremos que el modelo es confiable para predecir estos riesgos de baja frecuencia, descartando que sea una coincidencia visual.

Liquid4_6 <- TDF_agrupada[4:6, ]
tdfliquid4_6 <- data.frame(Liquid4_6)
tdfliquid4_6$x <- 1:3 
hi2 <- tdfliquid4_6$ni / sum(tdfliquid4_6$ni)
Fo2 <- hi2
Fo2
## [1] 0.3623446 0.3339254 0.3037300
Liquid4_6 <- TDF_agrupada[4:6, ]
tdfliquid4_6 <- data.frame(Liquid4_6)
tdfliquid4_6$x <- 1:3 

# 2. Calcular Media y 'p' para este grupo
media_subset_2 <- sum(tdfliquid4_6$x * tdfliquid4_6$ni) / sum(tdfliquid4_6$ni)
p_geo_2 <- 1 / media_subset_2

# 3. Calcular Probabilidad Teórica (Modelo Geométrico)
P2 <- dgeom(tdfliquid4_6$x - 1, prob = p_geo_2)

# 4. Asignar a Fe2
Fe2 <- P2
Fe2
## [1] 0.5150961 0.2497721 0.1211155

Para corroborar la precisión del modelo en la cola de la distribución, recurrimos al gráfico de dispersión. Al cruzar los valores observados (\(F_o\)) con los esperados (\(F_e\)) para los tres últimos subtipos, buscamos confirmar visualmente la correlación. La proximidad de los puntos a la línea de identidad roja (\(y=x\)) nos indicará si el Modelo Geométrico mantiene su capacidad predictiva incluso en este rango de eventos menos frecuentes.

plot(Fo2, Fe2,
     main = "Gráfica N9: Comparación Observada vs. Esperada (Agrupación 2)",
     xlab = "Frecuencia Observada (Fo2)",
     ylab = "Frecuencia Esperada (Fe2)",
     pch = 1,       
     cex = 1.5,     
     xlim = c(0, 1), 
     ylim = c(0, 1))
abline(a = 0, b = 1, col = "red", lwd = 2) 
text(Fo2, Fe2, labels = tdfliquid4_6$Subtipo_Clean, pos = 4, cex = 0.7)

Correlacion2 <- cor(Fo2, Fe2) * 100 
Correlacion2
## [1] 97.69434

El cálculo nos devuelve un coeficiente de correlación del 97.69%. En estadística, cualquier valor superior al 90% se considera una relación ‘muy fuerte’. Este número nos confirma que las discrepancias que observamos en la gráfica son menores en comparación con el acierto general del modelo: la teoría y la realidad caminan en la misma dirección casi a la perfección.

6.5 Chi cuadrado

Para la validación estadística de la segunda agrupación, el test de Chi-Cuadrado arrojó un valor calculado de 0.349. Al contrastar este resultado con el umbral crítico de aceptación de 5.99 (para 2 grados de libertad y 95% de confianza), observamos que el error se mantiene holgadamente por debajo del límite permitido. Por lo tanto, aceptamos la validez del modelo: aunque visualmente la distribución parecía más uniforme, estadísticamente no hay evidencia suficiente para rechazar el ajuste geométrico, confirmando que el modelo sigue siendo una herramienta predictiva confiable también para estos líquidos.

x2_2 <- sum(((Fo2 - Fe2)^2) / Fe2)
x2_2
## [1] 0.3489924
vc_2 <- qchisq(0.95, 2) 
vc_2
## [1] 5.991465
x2_2 < vc_2
## [1] TRUE

6.6 Cálculo de probabilidades

PREGUNTA N 1: ¿Cuál es la probabilidad de que ocurra un accidente de RIESGO ALTO? (Considerando que la Posición 1 de este grupo es “Gases Licuados”)

PREGUNTA N 2: ¿Cuál es el líquido que presenta la mayor frecuencia de accidentes (el valor máximo) dentro de este grupo de datos y cuál es esa cantidad exacta?

n2 <- sum(tdfliquid4_6$ni)
n2 
## [1] 563
# PREGUNTA N 1: ¿Cuál es la probabilidad de que ocurra un accidente de RIESGO ALTO?
# (Considerando que la Posición 1 de este grupo es "Gases Licuados")


# Usamos 'p_geo_2' que es la probabilidad específica de este grupo
dgeom(1 - 1, prob = p_geo_2)
## [1] 0.5150961
# PREGUNTA N 2: ¿Cuál es el líquido que presenta la mayor frecuencia de accidentes (el valor máximo) dentro de este grupo de datos y cuál es esa cantidad exacta?

max_accidentes <- max(tdfliquid4_6$ni)
liquido_mas_frecuente <- tdfliquid4_6$Liquid.Name[which.max(tdfliquid4_6$ni)]
cat("El líquido con mayor riesgo es:", liquido_mas_frecuente, "\n")
## El líquido con mayor riesgo es:
cat("Cantidad de accidentes registrados:", max_accidentes)
## Cantidad de accidentes registrados: 204

7 Conclusión

En conclusión, el análisis de la variable ‘Subtipo de Líquido’ determina que la siniestralidad del sistema obedece a un patrón de decaimiento geométrico, comportamiento que se mantiene constante tanto en los fluidos de alta demanda como en los de menor frecuencia. La segmentación de los datos permitió validar la robustez del modelo en ambos espectros, obteniendo coeficientes de correlación de Pearson superiores al 97% (\(97.59\%\) y \(97.69\%\)) y superando exitosamente las pruebas de bondad de ajuste de Chi-Cuadrado, donde los errores calculados (0.116 y 0.349) resultaron insignificantes frente al umbral crítico (5.99); esta evidencia estadística permite aceptar la hipótesis de ajuste con un nivel de confianza del 95%, confirmando que el Modelo Geométrico es una herramienta predictiva fiable para estimar el riesgo en la totalidad del inventario de líquidos transportados.