# ==============================================================================
# 1. CARGA DE DATOS
# ==============================================================================
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)
# Carga de datos con tu ruta específica
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.
# ==============================================================================
# 2. TABLA DE DISTRIBUCIÓN DE FRECUENCIAS
# ==============================================================================
TDF <- database_xlsx_Sheet1 %>%
filter(!is.na(`Pipeline Type`)) %>%
count(`Pipeline Type`, name = "ni") %>%
mutate(Tipo_Tuberia = case_when(
`Pipeline Type` == "ABOVEGROUND" ~ "SOBRE EL SUELO",
`Pipeline Type` == "UNDERGROUND" ~ "SUBTERRÁNEA",
`Pipeline Type` == "TANK" ~ "TANQUE",
`Pipeline Type` == "TRANSITION AREA" ~ "ÁREA DE TRANSICIÓN",
TRUE ~ `Pipeline Type`
)) %>%
arrange(desc(ni)) %>%
mutate(Posicion_Riesgo = as.character(row_number()),
hi = (ni/sum(ni))*100,
Nivel_Riesgo = c("Riesgo Alto", "Riesgo Medio", "Riesgo Bajo", "Riesgo Muy Bajo"))
TDF_con_Total <- TDF %>%
select(Posicion_Riesgo, Tipo_Tuberia, ni, hi) %>%
bind_rows(tibble(
Posicion_Riesgo = "-",
Tipo_Tuberia = "TOTAL",
ni = sum(.$ni),
hi = 100.00
)) %>%
mutate(hi = sprintf("%.2f", as.numeric(hi)))
# Renderizado de la tabla
kable(TDF_con_Total, align = 'c',
col.names = c("Posición Riesgo", "Tipo de Tubería", "ni (Accidentes)", "hi (%)"),
caption = "Tabla 1: Tabla de Riesgo por Tipo de Tubería") %>%
kable_styling(full_width = F, bootstrap_options = c("striped", "hover", "bordered")) %>%
row_spec(nrow(TDF_con_Total), bold = T, background = "#F2F2F2")
Tabla 1: Tabla de Riesgo por Tipo de Tubería
|
Posición Riesgo
|
Tipo de Tubería
|
ni (Accidentes)
|
hi (%)
|
|
1
|
SOBRE EL SUELO
|
1475
|
53.11
|
|
2
|
SUBTERRÁNEA
|
985
|
35.47
|
|
3
|
TANQUE
|
301
|
10.84
|
|
4
|
ÁREA DE TRANSICIÓN
|
16
|
0.58
|
|
|
TOTAL
|
2777
|
100.00
|
"Nota: De los 2,795 registros iniciales, se procesaron 2,777. Se descartaron 18 filas por contener valores nulos (NA) que impedían su clasificación."
## [1] "Nota: De los 2,795 registros iniciales, se procesaron 2,777. Se descartaron 18 filas por contener valores nulos (NA) que impedían su clasificación."
# ==============================================================================
# 3. GRÁFICA DE PROBABILIDAD
# ==============================================================================
niveles_riesgo <- TDF$Tipo_Tuberia
TDF$Tipo_Tuberia <- factor(TDF$Tipo_Tuberia, levels = niveles_riesgo, ordered = TRUE)
TDF$Nivel_Riesgo <- factor(TDF$Nivel_Riesgo, levels = c("Riesgo Alto", "Riesgo Medio", "Riesgo Bajo", "Riesgo Muy Bajo"))
ggplot(TDF, aes(x = Tipo_Tuberia, y = as.numeric(hi), fill = Nivel_Riesgo)) +
geom_col(color = "white", width = 0.7) +
scale_fill_manual(values = c("Riesgo Alto" = "#4292C6",
"Riesgo Medio" = "#9ECAE1",
"Riesgo Bajo" = "#C6DBEF",
"Riesgo Muy Bajo" = "#DEEBF7")) +
labs(title = "Gráfica N1: Probabilidad de Accidentes por Categoría",
x = "Tipo de Tubería",
y = "Probabilidad (%)",
fill = "Nivel de Riesgo") +
theme_minimal() +
theme(legend.position = "top",
panel.grid.minor = element_blank())
# ==============================================================================
# 4. CONJETURA DEL MODELO (Realidad vs Modelo)
# ==============================================================================
tdf_all <- data.frame(TDF)
tdf_all$x <- 1:nrow(tdf_all)
Fo1 <- tdf_all$ni / sum(tdf_all$ni)
media_p <- sum(tdf_all$x * tdf_all$ni) / sum(tdf_all$ni)
p_geo <- 1 / media_p
Fe1 <- dgeom(tdf_all$x - 1, prob = p_geo)
df_comp <- data.frame(
Tipo = factor(tdf_all$Tipo_Tuberia, levels = niveles_riesgo),
Observada = Fo1,
Esperada = Fe1
) %>% pivot_longer(cols = c(Observada, Esperada), names_to = "Fuente", values_to = "Val")
ggplot(df_comp, aes(x = Tipo, y = Val, fill = Fuente)) +
geom_bar(stat = "identity", position = "dodge", color = "black") +
scale_fill_manual(values = c("Observada" = "#B3DDF2", "Esperada" = "#4292C6"),
labels = c("Realidad (Fo)", "Modelo (Fe)")) +
labs(title = "Gráfica N4: Comparación Realidad vs Modelo Geométrico",
x = "Tipo de Tubería", y = "Frecuencia Relativa") +
theme_minimal() + theme(legend.position = "top")
"Seleccionamos el modelo geométrico debido a la jerarquía de los accidentes. Al concentrarse el 53.11% en el primer nivel y disminuir drásticamente en los siguientes, el modelo se acopla a nuestros resultados"
## [1] "Seleccionamos el modelo geométrico debido a la jerarquía de los accidentes. Al concentrarse el 53.11% en el primer nivel y disminuir drásticamente en los siguientes, el modelo se acopla a nuestros resultados"
# ==============================================================================
# 5. TEST DE PEARSON
# ==============================================================================
plot(Fo1, Fe1,
main = "Gráfica N5: Evaluación Visual de la Bondad de Ajuste",
xlab = "Frecuencia Observada (Fo1)", ylab = "Frecuencia Esperada (Fe1)",
pch = 19, col = "#4292C6", cex = 1.5, xlim = c(0, 1), ylim = c(0, 1))
abline(a = 0, b = 1, col = "red", lwd = 2)
text(Fo1, Fe1, labels = tdf_all$Tipo_Tuberia, pos = 4, cex = 0.8)
Correlacion1 <- cor(Fo1, Fe1) * 100
cat("--- RESULTADOS TEST DE PEARSON ---\n")
## --- RESULTADOS TEST DE PEARSON ---
cat("Coeficiente de Correlación:", round(Correlacion1, 2), "%\n\n")
## Coeficiente de Correlación: 94.18 %
# ==============================================================================
# 6. TEST DE CHI CUADRADO
# ==============================================================================
x2 <- sum(((Fo1 - Fe1)^2) / Fe1)
vc <- qchisq(0.95, 3)
cat("--- RESULTADOS TEST DE CHI CUADRADO ---\n")
## --- RESULTADOS TEST DE CHI CUADRADO ---
cat("Estadístico Calculado (x2):", round(x2, 4), "\n")
## Estadístico Calculado (x2): 0.1057
cat("Valor Crítico (vc):", round(vc, 4), "\n")
## Valor Crítico (vc): 7.8147
cat("Resultado de la Conjetura:", ifelse(x2 < vc, "ACEPTADA", "RECHAZADA"), "\n\n")
## Resultado de la Conjetura: ACEPTADA
# ==============================================================================
# 7. TABLA RESUMEN
# ==============================================================================
tabla_resumen <- data.frame(
Prueba = c("Pearson", "Chi-Cuadrado"),
Resultado = c(paste0(round(Correlacion1, 2), "%"), round(x2, 4)),
Estado = c("Excelente", ifelse(x2 < vc, "ACEPTADO", "RECHAZADO"))
)
kable(tabla_resumen, format = "markdown", align = 'c')
| Pearson |
94.18% |
Excelente |
| Chi-Cuadrado |
0.1057 |
ACEPTADO |
# ==============================================================================
# 8. PREGUNTA DE PROBABILIDAD
# ==============================================================================
prob_subterranea <- dgeom(2 - 1, prob = p_geo)
cat("\n--- PREGUNTA DE INVESTIGACIÓN ---\n")
##
## --- PREGUNTA DE INVESTIGACIÓN ---
cat("¿Cuál es la probabilidad de que ocurra un accidente en la tubería subterránea?\n")
## ¿Cuál es la probabilidad de que ocurra un accidente en la tubería subterránea?
cat("Respuesta:", round(prob_subterranea * 100, 2), "%\n")
## Respuesta: 23.33 %
# ==============================================================================
# 9. CONCLUSIONES
# ==============================================================================
"El modelo nos confirma que el peligro real se concentra en un solo lugar y cae rápido después de ahí. Esto nos permite ser más inteligentes con los recursos: en lugar de gastar tiempo y dinero revisando todo por igual, podemos enfocarnos donde realmente importa, evitando accidentes donde el riesgo es mayor y ahorrando esfuerzos donde la probabilidad es mínima."
## [1] "El modelo nos confirma que el peligro real se concentra en un solo lugar y cae rápido después de ahí. Esto nos permite ser más inteligentes con los recursos: en lugar de gastar tiempo y dinero revisando todo por igual, podemos enfocarnos donde realmente importa, evitando accidentes donde el riesgo es mayor y ahorrando esfuerzos donde la probabilidad es mínima."