# 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
# Asegúrate de que el archivo esté en esta ruta
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.
# 3. TABLA LIMPIA Y ORDENAMIENTO (MAYOR A MENOR)
TDF <- database_xlsx_Sheet1 %>%
  filter(!is.na(`Pipeline Type`)) %>%
  count(`Pipeline Type`, name = "ni") %>%
  arrange(desc(ni)) %>% # Orden descendente fundamental
  mutate(Nivel = as.character(row_number()), 
         hi_porc = (ni/sum(ni))*100)

# Guardamos el subset de los 4 principales para el modelo
Liquid_4 <- TDF[1:4, ]
hi4 <- Liquid_4$ni / sum(Liquid_4$ni)

# Preparar TDF_mostrar con fila TOTAL para la visualización
TDF_mostrar <- TDF %>%
  bind_rows(tibble(`Pipeline Type`="TOTAL", ni=sum(.$ni), Nivel="-", hi_porc=100)) %>%
  select(1:4) %>% 
  mutate(hi_porc = sprintf("%.2f", hi_porc))

# 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 N1 (Ordenado)
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. GRÁFICA N3: DISTRIBUCIÓN RELATIVA
df_grafica_hi <- data.frame(
  Tipo = factor(Liquid_4$`Pipeline Type`, levels = Liquid_4$`Pipeline Type`),
  Probabilidad = hi4,
  Riesgo = c("1. Bajo", "2. Medio", "2. Medio", "2. Medio") 
)

ggplot(df_grafica_hi, aes(x = Tipo, 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")

# 6. CÁLCULO DEL MODELO GEOMÉTRICO (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)

# 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
# 7. GRÁFICA N4: COMPARACIÓN REAL VS MODELO
tabla_comparativa <- data.frame(
  Tuberia = factor(Liquid_4$`Pipeline Type`, levels = 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")

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")

# 8. TEST DE PEARSON
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
# 9. CORRELACIÓN Y GRÁFICA N5 (Bondad de Ajuste)
Correlacion_Tuberia <- cor(Fo1, Fe1) * 100
plot(Fo1, Fe1, main = "Grafica N5: Evaluacion Visual de la Bondad de Ajuste",
     xlab = "Frecuencia Observada (Fo1)", ylab = "Frecuencia Esperada (Fe1)",
     pch = 19, 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)

# 10. CHI CUADRADO Y TABLA RESUMEN
x2 <- sum(((Fo1 - Fe1)^2) / Fe1)
vc <- qchisq(0.95, 3)

tabla_resumen <- data.frame(
  Variable = "Tipo de Tuberia",
  `Test Pearson (%)` = round(Correlacion_Tuberia, 2),
  `Chi Cuadrado` = round(x2, 2),
  `Umbral de aceptacion` = round(vc, 2)
)
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.aceptacion
Tipo de Tuberia 94.18 0.11 7.81 
# 11. CÁLCULO DE PROBABILIDADES (PREGUNTA FINAL)
# Pregunta: ¿Cual es la probabilidad de que el fallo ocurra en ABOVEGROUND?
prob_final <- dgeom(1 - 1, prob = p_geo)

cat("Pregunta: ¿Cual es la probabilidad de que el fallo ocurra en una tuberia de tipo ABOVEGROUND?\n")
## Pregunta: ¿Cual es la probabilidad de que el fallo ocurra en una tuberia de tipo ABOVEGROUND?
cat("Respuesta: Segun el modelo geometrico, la probabilidad es de:", round(prob_final * 100, 2), "%\n")
## Respuesta: Segun el modelo geometrico, la probabilidad es de: 62.94 %