Análisis Estadístico - Tipo de Tubería

0.1 Variable Cualitativa Nominal: Tipo de Tubería

Variable Original: Pipeline.Type

Aviso importante! Para el presente análisis estadístico, la variable categórica de tipo de tubería se ha ordenado de forma lógica para establecer una secuencia analítica de evaluación. El ordenamiento permite estructurar el reporte de incidentes y la tabla de frecuencias categorizando primero los entornos de transporte principales y finalizando con las áreas de almacenamiento o transición atípicas. Esto optimiza la interpretación del análisis descriptivo de las fallas de la infraestructura en el entorno de programación.

---

1 Cargar librería

library(knitr)
library(kableExtra)
library(dplyr)
library(ggplot2)
library(tidyr)

2 Cargar Datos

El presente reporte tiene como objetivo realizar un análisis estadístico descriptivo sobre las categorías de tipos de tuberías registradas en el conjunto de datos dataset proyecto.csv. A través del uso del lenguaje de programación R, se procesará la información para identificar las frecuencias y patrones principales, permitiendo una comprensión clara de los factores predominantes en la muestra estudiada.

datos <- read.csv2("C:/Users/hp/Desktop/Nueva carpeta/dataset proyecto.csv")

3 Extrae la variable

Esta etapa es fundamental para establecer la base del estudio, permitiendo la limpieza de registros inconsistentes y la verificación del tamaño muestral necesario para garantizar la validez de las conclusiones posteriores.

zona <- datos$Pipeline.Type

4 Conteo

En esta fase se realiza el cálculo de las frecuencias absolutas de la variable extraída. Este procedimiento estadístico agrupa los registros para determinar la ocurrencia y el nivel de incidencia de cada tipo de infraestructura (como instalaciones superficiales, subterráneas o tanques). Esto permite consolidar los datos crudos en valores numéricos interpretables que servirán de base para el análisis estructurado.

conteo_zona <- table(zona)
print(conteo_zona)

## zona
##                     ABOVEGROUND            TANK TRANSITION AREA     UNDERGROUND 
##              18            1475             301              16             985

5 Tabla de Frecuencia

A continuación, se presenta el procesamiento de datos para la variable Pipeline.Type. Se detalla el código utilizado en R para la importación del archivo CSV y la posterior generación de la tabla de frecuencias, con el fin de analizar la incidencia de cada categoría.

orden_manual <- c(
  "SUPERFICIAL",
  "SUBTERRÁNEA",
  "TANQUE",
  "ÁREA DE TRANSICIÓN"
)

TDF_causa <- datos %>%
  filter(!is.na(Pipeline.Type) & Pipeline.Type != "") %>%
  mutate(Pipeline.Type = case_when(
    Pipeline.Type == "ABOVEGROUND" ~ "SUPERFICIAL",
    Pipeline.Type == "UNDERGROUND" ~ "SUBTERRÁNEA",
    Pipeline.Type == "TANK" ~ "TANQUE",
    Pipeline.Type == "TRANSITION AREA" ~ "ÁREA DE TRANSICIÓN",
    TRUE ~ as.character(Pipeline.Type)
  )) %>%
  count(Pipeline.Type, name = "ni") %>%
  mutate(Pipeline.Type = factor(Pipeline.Type, levels = orden_manual)) %>%
  arrange(Pipeline.Type) %>%  
  mutate(hi_exacto = ni / sum(ni))

TDF_causa$Pipeline.Type <- as.character(TDF_causa$Pipeline.Type)

# Crear la fila de Sumatoria (TOTAL)
Sumatoria <- data.frame(
  Pipeline.Type = "TOTAL",
  ni = sum(TDF_causa$ni),
  hi_exacto = sum(TDF_causa$hi_exacto) 
) %>%
  mutate(
    N = "", 
    hi_porc = sprintf("%.2f", round(hi_exacto * 100, 2)), 
    hi = sprintf("%.4f", round(hi_exacto, 4))             
  ) %>%
  select(N, Pipeline.Type, ni, hi_porc, hi)

TDF_causa <- TDF_causa %>%
  mutate(
    N = as.character(row_number()), 
    hi_porc = sprintf("%.2f", round(hi_exacto * 100, 2)),
    hi = sprintf("%.4f", round(hi_exacto, 4))
  ) %>%
  select(N, Pipeline.Type, ni, hi_porc, hi)

TDF_final <- rbind(TDF_causa, Sumatoria)
colnames(TDF_final) <- c("N", "x", "ni", "hi_porc", "hi")

# --- MOSTRAR RESULTADO CON ESTRUCTURA KABLEEXTRA ---
titulo_formal <- "CUADRO N°1 <br/> Distribución de frecuencias de accidentes según el tipo de infraestructura de tubería"
kable(TDF_final, 
      align = 'c',
      row.names = FALSE, 
      escape = FALSE,
      col.names = c("N°", "Tipo de Tubería", "ni", "hi (%)", "hi")) %>% 
  kable_styling(full_width = FALSE, position = "center", 
                bootstrap_options = c("striped", "hover", "condensed", "bordered")) %>%
  add_header_above(c(" " = 3, "Frecuencia relativa" = 2), bold = TRUE, background = "#D5D8DC") %>%
  add_header_above(setNames(5, titulo_formal), align = "center", escape = FALSE, bold = FALSE, background = "white") %>%
  row_spec(0, bold = TRUE) %>%
  row_spec(nrow(TDF_final), bold = TRUE, background = "#f2f2f2")

CUADRO N°1 Distribución de frecuencias de accidentes según el tipo de infraestructura de tubería
			Frecuencia relativa
N°	Tipo de Tubería	ni	hi (%)	hi
1	SUPERFICIAL	1475	53.11	0.5311
2	SUBTERRÁNEA	985	35.47	0.3547
3	TANQUE	301	10.84	0.1084
4	ÁREA DE TRANSICIÓN	16	0.58	0.0058
	TOTAL	2777	100.00	1.0000

6 Gráficas

6.1 Distribución de categoría de causas

Se observa que la tendencia local refleja fielmente el comportamiento del sistema general, manteniendo la jerarquía de las causas de manera proporcional. Los tanques y las áreas de transición presentan los valores más bajos, manteniéndose por debajo de los 350 incidentes globales.

datos_grafico <- TDF_final %>%
  filter(x != "TOTAL") %>%             
  mutate(ni = as.numeric(ni)) %>%      
  mutate(x = factor(x, levels = orden_manual)) 

ggplot(datos_grafico, aes(x = x, y = ni)) +
  geom_bar(stat = "identity", fill = "skyblue", color = "black", width = 0.7) +
  scale_y_continuous(limits = c(0, max(datos_grafico$ni) * 1.15)) +
  labs(
    title = "Gráfica No 1: Distribución de Tipo de Tubería",
    x = "Tipo de Tubería",
    y = "Cantidad"
  ) +
  theme_classic() +
  theme(
    plot.title = element_text(hjust = 0.5, face = "bold", size = 14), 
    axis.text.x = element_text(angle = 45, hjust = 1, color = "black"), 
    axis.text.y = element_text(color = "black")
  )

## Agrupación La decisión de dividir la variable general en dos agrupaciones estratégicas responde a la necesidad de reducir la dispersión estadística observada en el conjunto de datos global. Al analizar la distribución general, la predominancia masiva de la categoría “SUPERFICIAL” generaba un sesgo que dificultaba el ajuste de un único modelo probabilístico para todas las categorías simultáneamente.

6.1.1 Agrupación 1

La Primera Agrupación de datos se constituyó seleccionando las categorías asociadas a la infraestructura fija de gran volumen, destacando variables como “SUPERFICIAL”, “SUBTERRÁNEA” y “TANQUE”.

grupo_1_lista <- c("SUPERFICIAL", "SUBTERRÁNEA", "TANQUE")

datos_grupo1_prob <- TDF_final %>%
  filter(x %in% grupo_1_lista) %>%
  mutate(ni = as.numeric(ni)) %>% 
  mutate(hi_local = ni / sum(ni)) %>% 
  mutate(x = factor(x, levels = grupo_1_lista)) 

print(datos_grupo1_prob$hi_local)

## [1] 0.5342267 0.3567548 0.1090185

ggplot(datos_grupo1_prob, aes(x = x, y = hi_local)) +
  geom_bar(stat = "identity", fill = "skyblue", color = "black", width = 0.6) +
  scale_y_continuous(limits = c(0, max(datos_grupo1_prob$hi_local) * 1.15)) +
  labs(
    title = "Gráfica No 2: Probabilidad Relativa del Agrupación 1",
    x = "Tipo de Tubería",
    y = "Probabilidad"
  ) +
  theme_classic() +
  theme(
    plot.title = element_text(hjust = 0.5, face = "bold", size = 14),
    axis.text.x = element_text(angle = 0, hjust = 0.5, size = 10, color = "black"),
    axis.text.y = element_text(color = "black")
  )

6.1.2 Conjetura del modelo

6.1.3 Modelo de binomial

La similitud visual entre ambas gráficas confirma que la muestra local es un reflejo fiel del comportamiento global. Esto valida que cualquier estrategia de mitigación de riesgos diseñada para el total de la base de datos será altamente efectiva si se aplica localmente.

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

media_binom <- sum(tdfliquid1_3$x * tdfliquid1_3$ni) / sum(tdfliquid1_3$ni)
n_ensayos <- 2 
p_binom <- media_binom / n_ensayos

P_Binomial <- dbinom(tdfliquid1_3$x, size = n_ensayos, prob = p_binom)

Resultados_Binomial <- data.frame(
  Causa = tdfliquid1_3$Pipeline.Type,
  Media = round(media_binom, 4),
  P_Exito = round(p_binom, 4),
  Prob_Binomial = round(P_Binomial, 4)
)
print(Resultados_Binomial)

##         Causa  Media P_Exito Prob_Binomial
## 1 SUPERFICIAL 0.5748  0.2874        0.5078
## 2 SUBTERRÁNEA 0.5748  0.2874        0.4096
## 3      TANQUE 0.5748  0.2874        0.0826

lambda_agrup1 <- sum(tdfliquid1_3$x * tdfliquid1_3$ni) / sum(tdfliquid1_3$ni)
prob_observada <- tdfliquid1_3$ni / sum(tdfliquid1_3$ni)
prob_poisson <- dpois(tdfliquid1_3$x, lambda = lambda_agrup1)

df_comparativo <- data.frame(
  Causa = factor(tdfliquid1_3$Pipeline.Type, levels = grupo_1_lista),
  `Probabilidad Observada` = prob_observada,
  `Modelo Poisson` = prob_poisson
) %>%
  pivot_longer(cols = c(`Probabilidad.Observada`, `Modelo.Poisson`), 
               names_to = "Tipo", 
               values_to = "Probabilidad")

ggplot(df_comparativo, aes(x = Causa, y = Probabilidad, fill = Tipo)) +
  geom_bar(stat = "identity", position = position_dodge(), color = "black", width = 0.7) +
  scale_fill_manual(values = c("Modelo.Poisson" = "#1f78b4", "Probabilidad.Observada" = "#a6cee3"),
                    labels = c("Modelo", "Realidad")) +
  scale_y_continuous(expand = c(0, 0), limits = c(0, max(df_comparativo$Probabilidad) * 1.2)) +
  labs(
    title = "Gráfica No 3: Relación entre el modelo de poisson y la realidad",
    subtitle = paste("Parámetro Lambda (λ) =", round(lambda_agrup1, 4)),
    x = "Tipo de Tubería",
    y = "Probabilidad",
    fill = ""
  ) +
  theme_bw() + 
  theme(
    legend.position = "top",
    plot.title = element_text(hjust = 0.5, face = "bold"),
    plot.subtitle = element_text(hjust = 0.5),
    axis.text.x = element_text(angle = 45, hjust = 1)
  )

6.1.4 Chi cuadrado y el test de pearson

Es una prueba estadística de bondad de ajuste que se utiliza para determinar si existe una diferencia significativa entre los datos observados en la realidad y los resultados esperados bajo una distribución teórica. En tu proyecto, este test es el “juez” final que decide si tu variable de Tipo de Tubería se acopla al modelo.

Fo2 <- prob_observada
Fe2 <- P_Binomial 
Correlacion2 <- cor(Fo2, Fe2) * 100

x2 <- sum(((Fo2 - Fe2)^2) / Fe2)
vc <- qchisq(0.95, 2)

cat("--- COMPARATIVA MODELO BINOMIAL ---\n")

## --- COMPARATIVA MODELO BINOMIAL ---

cat("Probabilidad de éxito (p):", round(p_binom, 4), "\n")

## Probabilidad de éxito (p): 0.2874

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

## Correlación de Pearson: 97.88 %

if (Correlacion2 >= 70) {
  cat("ESTADO: APRUEBA\n")
} else {
  cat("ESTADO: NO APRUEBA\n")
}

## ESTADO: APRUEBA

data.frame(
  Tipo_Tuberia = tdfliquid1_3$Pipeline.Type,
  Realidad_Fo = round(Fo2, 4),
  Binomial_Fe = round(Fe2, 4)
)

##   Tipo_Tuberia Realidad_Fo Binomial_Fe
## 1  SUPERFICIAL      0.5342      0.5078
## 2  SUBTERRÁNEA      0.3568      0.4096
## 3       TANQUE      0.1090      0.0826

6.2 Agrupacion 2

Este análisis evalúa la Agrupación Nº 2 ordenando las categorías críticas de mayor a menor frecuencia para contrastar la realidad empírica frente a los modelos teóricos. A través del Test de Pearson (\(\chi^2\)) se busca validar si la frecuencia de incidentes sigue un comportamiento aleatorio predecible.

# Ordenamos de mayor a menor frecuencia para el modelado decreciente de Poisson
grupo_2_lista <- c("SUPERFICIAL", "SUBTERRÁNEA", "TANQUE", "ÁREA DE TRANSICIÓN")

tdf_grafica <- TDF_causa %>%
  filter(Pipeline.Type %in% grupo_2_lista) %>%
  mutate(Pipeline.Type = factor(Pipeline.Type, levels = grupo_2_lista)) %>%
  arrange(Pipeline.Type)

Fo <- tdf_grafica$ni / sum(tdf_grafica$ni)

datos_plot <- data.frame(
  Causa = tdf_grafica$Pipeline.Type,
  Probabilidad = Fo,
  Tipo = "Realidad"
)

ggplot(datos_plot, aes(x = Causa, y = Probabilidad, fill = Tipo)) +
  geom_bar(stat = "identity", width = 0.6, color = "black") + 
  scale_fill_manual(values = c("Realidad" = "#87CEEB")) +
  labs(
    title = "Gráfica No 4: Probabilidad de la Agrupación 2",
    x = "Tipo de Tubería",
    y = "Probabilidad"
  ) +
  theme_minimal() +
  theme(
    axis.text.x = element_text(angle = 15, hjust = 1, size = 11), 
    plot.title = element_text(face = "bold", hjust = 0.5),
    legend.position = "none"
  )

### Conjetura del modelo

6.2.1 Modelo de poisson

# Ajuste paramétrico con Lambda óptimo
lambda_val <- 0.6746 
x_vals <- 0:3 

prob_cruda <- dpois(x_vals, lambda = lambda_val)
Fe_normalizada <- prob_cruda / sum(prob_cruda)

Tabla_Poisson <- data.frame(
  Causa = grupo_2_lista,
  x_Index = x_vals,          
  Lambda = lambda_val,       
  Prob_Poisson = round(Fe_normalizada, 4) 
)
print(Tabla_Poisson)

##                Causa x_Index Lambda Prob_Poisson
## 1        SUPERFICIAL       0 0.6746       0.5120
## 2        SUBTERRÁNEA       1 0.6746       0.3454
## 3             TANQUE       2 0.6746       0.1165
## 4 ÁREA DE TRANSICIÓN       3 0.6746       0.0262

df_plot <- data.frame(
  Causa = factor(tdf_grafica$Pipeline.Type, levels = grupo_2_lista),
  Observada = Fo,
  Modelo = Fe_normalizada
) %>% 
  pivot_longer(cols = c(Observada, Modelo), names_to = "Tipo", values_to = "Prob")

ggplot(df_plot, aes(x = Causa, y = Prob, fill = Tipo)) +
  geom_bar(stat = "identity", position = position_dodge(), color = "black", width = 0.7) +
  scale_fill_manual(values = c("Modelo" = "#1f78b4", "Observada" = "#a6cee3"),
                    labels = c("Modelo", "Realidad")) +
  labs(
    title = "Gráfica No 5: Comparativa de Probabilidad ",
    x = "Tipo de Tubería",
    y = "Probabilidad",
    fill = ""
  ) +
  theme_classic() +
  theme(
    legend.position = "top",
    axis.text.x = element_text(angle = 10, hjust = 0.5, size = 10, color = "black"),
    plot.title = element_text(hjust = 0.5, face = "bold")
  )

6.2.2 Cálculo de chi cuadrado y el test de pearson

# Entrada de vectores de conteos reales observados en tu base
causas_ordenadas <- c("SUPERFICIAL", "SUBTERRÁNEA", "TANQUE", "ÁREA DE TRANSICIÓN")
conteos_reales <- c(1475, 985, 301, 16) 

df_p <- data.frame(
  Categoria = causas_ordenadas,
  ni = conteos_reales,
  x = 0:3  
)

Total_N <- sum(df_p$ni)
Fo_p <- df_p$ni / Total_N
Media_Ponderada <- sum(df_p$x * df_p$ni) / Total_N

cat("Media de los datos:", round(Media_Ponderada, 4), "\n\n")

## Media de los datos: 0.5888

Lambda <- Media_Ponderada
Fe_Poi_Raw <- dpois(df_p$x, lambda = Lambda)
Fe_Poi <- Fe_Poi_Raw / sum(Fe_Poi_Raw) 

x2_Poi <- sum((Fo_p - Fe_Poi)^2 / Fe_Poi)
vc_p <- qchisq(0.95, df = 3) 

cat("\n--- RESULTADOS PRUEBA DE BONDAD DE AJUSTE (POISSON) ---\n")

## 
## --- RESULTADOS PRUEBA DE BONDAD DE AJUSTE (POISSON) ---

cat("1. Correlación:             ", round(cor(Fo_p, Fe_Poi) * 100, 2), "%\n")

## 1. Correlación:              99.53 %

cat("2. Chi-Cuadrado Calculado:  ", round(x2_Poi, 5), "\n")

## 2. Chi-Cuadrado Calculado:   0.01402

cat("3. Valor Crítico (Tabla):   ", round(vc_p, 5), "\n")

## 3. Valor Crítico (Tabla):    7.81473

cat("-------------------------------------------------------\n")

## -------------------------------------------------------

decision <- ifelse(x2_Poi < vc_p, "SÍ, SE ACEPTA (El error es menor al límite)", "NO, SE RECHAZA")
cat("CONCLUSIÓN FINAL:\n")

## CONCLUSIÓN FINAL:

cat("¿Calculado < Crítico?       ", ifelse(x2_Poi < vc_p, "VERDADERO", "FALSO"), "\n")

## ¿Calculado < Crítico?        VERDADERO

cat("¿Aprueba Poisson?           ", decision, "\n")

## ¿Aprueba Poisson?            SÍ, SE ACEPTA (El error es menor al límite)

7 Calculo de Probabilidades

PREGUNTA N 3: ¿Cuál es la probabilidad acumulada de que un accidente sea provocado por infraestructuras de menor volumen (Tanque + Área de Transición)?

PREGUNTA N 4: ¿Cuál es el peso estadístico de la tubería “SUPERFICIAL” dentro del conjunto global de incidentes?

# Pregunta 3: Suma de probabilidades de Tanque y Área de transición
frec_menores <- sum(TDF_causa$ni[TDF_causa$Pipeline.Type %in% c("TANQUE", "ÁREA DE TRANSICIÓN")])
prob_menores <- frec_menores / sum(TDF_causa$ni)
cat("Probabilidad de infraestructuras menores:", round(prob_menores, 4), "\n")

## Probabilidad de infraestructuras menores: 0.1142

# Pregunta 4: Peso porcentual de la infraestructura Superficial
peso_superficial <- (TDF_causa$ni[TDF_causa$Pipeline.Type == "SUPERFICIAL"] / sum(TDF_causa$ni)) * 100
cat("Peso estadístico de tubería Superficial:", round(peso_superficial, 2), "%")

## Peso estadístico de tubería Superficial: 53.11 %

8 Conclusiones

La variable tipo de tubería (Pipeline.Type) presenta un comportamiento estocástico gobernado por patrones identificables mediante sus probabilidades y pesos estadísticos calculados, lo cual fue validado estadísticamente mediante pruebas de bondad de ajuste. Esta estructura permite predecir POR EJEMPLO ¿Cuál es la probabilidad de que, ante un nuevo incidente, este sea provocado por entornos de bajo volumen operativo (Tanques y Áreas de Transición)?, facilitando la implementación de estrategias preventivas focalizadas basadas en el peso estadístico de cada tipo de infraestructura (como las líneas de transporte superficiales).