# 1. CARGA DE LIBRERÍAS
library(dplyr)
##
## Adjuntando el paquete: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(ggplot2)
library(knitr)
library(kableExtra)
##
## Adjuntando el paquete: 'kableExtra'
## The following object is masked from 'package:dplyr':
##
## group_rows
library(tidyr)
library(readr)
# 2. CARGA DE DATOS
# Usando la ruta directa de tu carpeta de descargas
database_xlsx_Sheet1 <- read_csv("C:/Users/Usuario/Downloads/database.xlsx - Sheet1.csv")
## Warning: One or more parsing issues, call `problems()` on your data frame for details,
## e.g.:
## dat <- vroom(...)
## problems(dat)
## Rows: 2795 Columns: 36
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (18): Accident Date/Time, Operator Name, Pipeline/Facility Name, Pipelin...
## dbl (18): Report Number, Supplemental Number, Accident Year, Operator ID, Ac...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
# --- ESTO ES LO QUE TE SALÍA AL COMIENZO (VISTA DE VARIABLES) ---
glimpse(database_xlsx_Sheet1)
## Rows: 2,795
## Columns: 36
## $ `Report Number` <dbl> 20100016, 20100254, 20100038, 2…
## $ `Supplemental Number` <dbl> 17305, 17331, 17747, 18574, 162…
## $ `Accident Year` <dbl> 2010, 2010, 2010, 2010, 2010, 2…
## $ `Accident Date/Time` <chr> "1/1/2010 7:15", "1/4/2010 8:30…
## $ `Operator ID` <dbl> 32109, 15786, 20160, 11169, 300…
## $ `Operator Name` <chr> "ONEOK NGL PIPELINE LP", "PORTL…
## $ `Pipeline/Facility Name` <chr> "KINDER MORGAN JCT", "24-INCH M…
## $ `Pipeline Location` <chr> "ONSHORE", "ONSHORE", "ONSHORE"…
## $ `Pipeline Type` <chr> "ABOVEGROUND", "ABOVEGROUND", "…
## $ `Liquid Type` <chr> "HVL OR OTHER FLAMMABLE OR TOXI…
## $ `Liquid Subtype` <chr> "LPG (LIQUEFIED PETROLEUM GAS) …
## $ `Liquid Name` <chr> NA, NA, "ETHANE", NA, NA, NA, N…
## $ `Accident City` <chr> "MCPHERSON", "RAYMOND", "SULPHE…
## $ `Accident County` <chr> "MCPHERSON", "CUMBERLAND", "CAL…
## $ `Accident State` <chr> "KS", "ME", "LA", "WI", "TX", "…
## $ `Accident Latitude` <dbl> 38.67070, 43.94028, 30.18240, 4…
## $ `Accident Longitude` <dbl> -97.78123, -70.49336, -93.35240…
## $ `Cause Category` <chr> "INCORRECT OPERATION", "MATERIA…
## $ `Cause Subcategory` <chr> "PIPELINE/EQUIPMENT OVERPRESSUR…
## $ `Unintentional Release (Barrels)` <dbl> 21.00, 0.12, 2.00, 0.48, 700.00…
## $ `Intentional Release (Barrels)` <dbl> 0.1, 0.0, 0.0, 0.0, NA, 0.0, 0.…
## $ `Liquid Recovery (Barrels)` <dbl> 0.00, 0.12, 0.00, 0.48, 698.00,…
## $ `Net Loss (Barrels)` <dbl> 21.00, 0.00, 2.00, 0.00, 2.00, …
## $ `Liquid Ignition` <chr> "NO", "NO", "NO", "NO", "NO", "…
## $ `Liquid Explosion` <chr> "NO", "NO", "NO", "NO", "NO", "…
## $ `Pipeline Shutdown` <chr> "NO", NA, NA, NA, "NO", "YES", …
## $ `Shutdown Date/Time` <chr> NA, NA, NA, NA, NA, "1/8/2010 2…
## $ `Restart Date/Time` <chr> NA, NA, NA, NA, NA, "1/13/2010 …
## $ `Public Evacuations` <dbl> NA, NA, NA, NA, NA, 0, NA, NA, …
## $ `Property Damage Costs` <dbl> 110, 4000, 0, 200, 20000, 76940…
## $ `Lost Commodity Costs` <dbl> 1517, 8, 200, 40, 150, 167775, …
## $ `Public/Private Property Damage Costs` <dbl> 0, 0, 0, 0, 0, 150000, 0, 0, 0,…
## $ `Emergency Response Costs` <dbl> 0, 0, 0, 11300, 7500, 1800000, …
## $ `Environmental Remediation Costs` <dbl> 0, 0, 0, 0, 2000, 2000000, 7000…
## $ `Other Costs` <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 1000…
## $ `All Costs` <dbl> 1627, 4008, 200, 11540, 29650, …
# 3 TABLA LIMPIA: Sin columnas extra, con TOTAL y guion
TDF <- database_xlsx_Sheet1 %>%
filter(!is.na(`Pipeline Type`)) %>%
count(`Pipeline Type`, name = "ni") %>%
arrange(desc(ni)) %>%
mutate(Nivel = as.character(row_number()), hi = (ni/sum(ni))*100)
# Guardamos el subset de los 4 principales ANTES de agregar el TOTAL
Liquid_4 <- TDF[1:4, ]
hi4 <- Liquid_4$ni / sum(Liquid_4$ni)
# Ahora sí, preparamos TDF con la fila TOTAL para mostrar
TDF_mostrar <- TDF %>%
bind_rows(tibble(`Pipeline Type`="TOTAL", ni=sum(.$ni), Nivel="-", hi=100)) %>%
select(1:4) %>%
mutate(hi = sprintf("%.2f", hi))
# Mostrar tabla formateada
kable(TDF_mostrar, align = 'c', col.names = c("Tipo de Tuberia", "ni", "Nivel", "hi (%)")) %>%
kable_styling(full_width = F, bootstrap_options = c("striped", "hover")) %>%
row_spec(nrow(TDF_mostrar), bold = T, background = "#f2f2f2")
|
Tipo de Tuberia
|
ni
|
Nivel
|
hi (%)
|
|
ABOVEGROUND
|
1475
|
1
|
53.11
|
|
UNDERGROUND
|
985
|
2
|
35.47
|
|
TANK
|
301
|
3
|
10.84
|
|
TRANSITION AREA
|
16
|
4
|
0.58
|
|
TOTAL
|
2777
|
|
100.00
|
# 4 GRÁFICO DE BARRAS: Cantidad de Eventos (ni)
TDF %>%
ggplot(aes(x = reorder(`Pipeline Type`, -ni), y = ni, fill = as.factor(Nivel))) +
geom_col(width = 0.7, color = "black") +
scale_fill_manual(values = c("#AED6F1", "#3498DB", "#2E86C1", "#154360")) +
labs(title = "Grafica N1: Cantidad de Eventos por Tipo de Tuberia",
x = "Tipo de Tuberia", y = "Frecuencia Absoluta (ni)") +
theme_minimal() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 35, hjust = 1))
# 5 Cálculo de Frecuencias Relativas para los 4 Tipos de Tubería
# (Ya definido arriba como Liquid_4 y hi4)
hi4
## [1] 0.531148722 0.354699316 0.108390349 0.005761613
# 5.1 Preparar el dataframe para la grafica
df_grafica_hi <- data.frame(
Tipo = Liquid_4$`Pipeline Type`,
Probabilidad = hi4,
Riesgo = c("1. Bajo", "2. Medio", "2. Medio", "2. Medio")
)
# Generar Grafica N3 corregida
ggplot(df_grafica_hi, aes(x = reorder(Tipo, -Probabilidad), y = Probabilidad, fill = Riesgo)) +
geom_col(color = "black", width = 0.7) +
scale_fill_manual(values = c("1. Bajo" = "#AED6F1", "2. Medio" = "#0099D9")) +
labs(title = "Grafica N3: Distribucion Relativa de Tipos de Tuberia",
x = "Tipo de Tuberia",
y = "Probabilidad",
fill = "Riesgo") +
theme_bw() +
theme(axis.text.x = element_text(angle = 45, hjust = 1),
legend.position = "top")
# --- BLOQUE FUNDAMENTAL: CÁLCULO DE PROB_GEOM ---
x_val <- 1:4
media_subset <- sum(x_val * as.numeric(Liquid_4$ni)) / sum(as.numeric(Liquid_4$ni))
p_geo <- 1 / media_subset
Prob_Geom <- dgeom(x_val - 1, prob = p_geo)
# Crear el data frame de la Conjetura de Modelo
conjetura_modelo <- data.frame(
Tuberia = Liquid_4$`Pipeline Type`,
Prob_Geom = Prob_Geom
)
conjetura_modelo
## Tuberia Prob_Geom
## 1 ABOVEGROUND 0.62941976
## 2 UNDERGROUND 0.23325052
## 3 TANK 0.08643803
## 4 TRANSITION AREA 0.03203223
# 6. Preparar datos (Formato largo para ggplot)
tabla_comparativa <- data.frame(
Tuberia = Liquid_4$`Pipeline Type`,
Prob_Real = as.numeric(hi4),
Prob_Geom = Prob_Geom
)
df_comparativo <- tabla_comparativa %>%
pivot_longer(cols = c(Prob_Real, Prob_Geom),
names_to = "Fuente",
values_to = "Valor")
# 2. Grafico N4 sin tildes para evitar errores
ggplot(df_comparativo, aes(x = Tuberia, y = Valor, fill = Fuente)) +
geom_col(position = "dodge", color = "black", width = 0.7) +
scale_fill_manual(values = c("Prob_Geom" = "#0088C2", "Prob_Real" = "#87D3F2"),
labels = c("Modelo Geometrico", "Probabilidad Observada")) +
labs(title = "Grafica N4: Comparacion Real vs Modelo Geometrico",
x = "Tipo de Tuberia",
y = "Probabilidad",
fill = "") +
theme_bw() +
theme(axis.text.x = element_text(angle = 45, hjust = 1),
legend.position = "top")
# 7 Test Pearson (Tipos de Tuberia)
Fo1 <- as.numeric(hi4)
Fe1 <- Prob_Geom
test_resultado <- data.frame(
Tuberia = Liquid_4$`Pipeline Type`,
Observado = Fo1,
Esperado = Fe1
)
test_resultado
## Tuberia Observado Esperado
## 1 ABOVEGROUND 0.531148722 0.62941976
## 2 UNDERGROUND 0.354699316 0.23325052
## 3 TANK 0.108390349 0.08643803
## 4 TRANSITION AREA 0.005761613 0.03203223
# 8 Calcular la Correlacion entre lo Observado y lo Esperado
Correlacion_Tuberia <- cor(Fo1, Fe1) * 100
Correlacion_Tuberia
## [1] 94.17684
# 8.1 Generar Grafica N5: Evaluacion Visual de la Bondad de Ajuste
plot(Fo1, Fe1,
main = "Grafica N5: Evaluacion Visual de la Bondad de Ajuste",
xlab = "Frecuencia Observada (Fo1)",
ylab = "Frecuencia Esperada (Fe1)",
pch = 1, col = "black",
xlim = c(0, 1), ylim = c(0, 1))
text(Fo1, Fe1, labels = Liquid_4$`Pipeline Type`, pos = 4, cex = 0.7)
abline(a = 0, b = 1, col = "red", lwd = 2)
# 9 Chi cuadrado (Tipos de Tuberia)
x2 <- sum(((Fo1 - Fe1)^2) / Fe1)
vc <- qchisq(0.95, 3)
x2 < vc
## [1] TRUE
# 10 Tabla resumen test (Tipos de Tuberia)
Variable <- c("Tipo de Tuberia")
tabla_resumen <- data.frame(
Variable,
round(Correlacion_Tuberia, 2),
round(x2, 2),
round(vc, 2)
)
colnames(tabla_resumen) <- c("Variable", "Test Pearson (%)", "Chi Cuadrado", "Umbral de aceptacion")
kable(tabla_resumen,
format = "markdown",
caption = "Tabla Resumen: Test de Bondad de Ajuste")
Tabla Resumen: Test de Bondad de Ajuste
| Tipo de Tuberia |
94.18 |
0.11 |
7.81 |
# 5.7 Cálculo de probabilidades (Tipos de Tuberia)
n1 <- sum(as.numeric(Liquid_4$ni))
dgeom(1 - 1, prob = p_geo)
## [1] 0.6294198
# 11. CÁLCULO DE PROBABILIDADES (Tipos de Tuberia)
# 11.1 Definición del espacio muestral
n1 <- sum(as.numeric(Liquid_4$ni))
# PREGUNTA:
# "Si ocurre un nuevo incidente en el sistema de transporte, ¿Cuál es la probabilidad
# de que el fallo se localice en una tubería de tipo ABOVEGROUND (Categoría de mayor frecuencia)?"
# 11.2 Cálculo mediante el Modelo Geométrico
# Usamos dgeom(x-1) donde x=1 es la primera posición (Aboveground)
probabilidad_final <- dgeom(1 - 1, prob = p_geo)
# 11.3 Resultado
cat("Pregunta: ¿Cual es la probabilidad de que el fallo ocurra en ABOVEGROUND?\n")
## Pregunta: ¿Cual es la probabilidad de que el fallo ocurra en ABOVEGROUND?
cat("Respuesta: La probabilidad segun el modelo es de:", round(probabilidad_final * 100, 2), "%\n")
## Respuesta: La probabilidad segun el modelo es de: 62.94 %