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(readr)
datasetf <- read_csv("datasetf.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.
# 1. Preparación y limpieza
datos_cont <- datasetf %>% filter(!is.na(`Net Loss (Barrels)`))
n <- nrow(datos_cont)
# 2. Parámetros de Sturges
k <- ceiling(1 + 3.322 * log10(n))
min_v <- min(datos_cont$`Net Loss (Barrels)`)
max_v <- max(datos_cont$`Net Loss (Barrels)`)
amplitud <- (max_v - min_v) / k
# 3. Creación de límites y Tabla
cortes <- seq(min_v, max_v + amplitud, by = amplitud)
tabla_completa <- datos_cont %>%
mutate(Intervalos = cut(`Net Loss (Barrels)`,
breaks = cortes,
right = FALSE,
include.lowest = TRUE)) %>%
group_by(Intervalos) %>%
summarise(ni = n()) %>%
mutate(
`Desde (bbl)` = round(cortes[1:n()], 2),
`Hasta (bbl)` = round(cortes[2:(n()+1)], 2),
`Marca Clase` = round((`Desde (bbl)` + `Hasta (bbl)`) / 2, 2),
`Frec. Rel. %` = round((ni / sum(ni)) * 100, 2),
# Frecuencias Acumuladas
`Ni Asc.` = cumsum(ni),
`Ni Desc.` = sum(ni) - cumsum(ni) + ni,
`Hi Asc. %` = round(cumsum(`Frec. Rel. %`), 2),
`Hi Desc. %` = round(sum(`Frec. Rel. %`) - cumsum(`Frec. Rel. %`) + `Frec. Rel. %`, 2)
) %>%
# Seleccionar y reordenar columnas según tu pedido
select(`Desde (bbl)`, `Hasta (bbl)`, `Marca Clase`, `Frec. Abs.` = ni,
`Frec. Rel. %`, `Ni Asc.`, `Ni Desc.`, `Hi Asc. %`, `Hi Desc. %`)
# 4. Resultado
print(as.data.frame(tabla_completa))
## Desde (bbl) Hasta (bbl) Marca Clase Frec. Abs. Frec. Rel. % Ni Asc. Ni Desc.
## 1 0.00 2351.15 1175.58 2758 98.68 2758 2795
## 2 2351.15 4702.31 3526.73 20 0.72 2778 37
## 3 4702.31 7053.46 5877.88 7 0.25 2785 17
## 4 7053.46 9404.62 8229.04 2 0.07 2787 10
## 5 9404.62 11755.77 10580.19 1 0.04 2788 8
## 6 11755.77 14106.92 12931.35 2 0.07 2790 7
## 7 14106.92 16458.08 15282.50 1 0.04 2791 5
## 8 16458.08 18809.23 17633.65 1 0.04 2792 4
## 9 18809.23 21160.38 19984.80 1 0.04 2793 3
## 10 21160.38 23511.54 22335.96 1 0.04 2794 2
## 11 23511.54 25862.69 24687.11 1 0.04 2795 1
## Hi Asc. % Hi Desc. %
## 1 98.68 100.03
## 2 99.40 1.35
## 3 99.65 0.63
## 4 99.72 0.38
## 5 99.76 0.31
## 6 99.83 0.27
## 7 99.87 0.20
## 8 99.91 0.16
## 9 99.95 0.12
## 10 99.99 0.08
## 11 100.03 0.04
# --- JUSTIFICACIÓN TÉCNICA DE LA VISUALIZACIÓN ---
# Se toma la decisión de MANTENER los Outliers (valores atípicos) en el análisis.
# Aunque estos datos "estiran" la escala de las gráficas (Net Loss hasta >30,000 bbl),
# su presencia es vital para la Gestión de Riesgos.
# Omitirlos ocultaría el 'Evento Máximo Posible', distorsionando la realidad
# de los impactos catastróficos que la infraestructura puede enfrentar.
# Crear la gráfica de distribución ni
grafica_dist_ni <- ggplot(tabla_completa, aes(x = `Marca Clase`, y = `Frec. Abs.`)) +
geom_bar(stat = "identity", fill = "#2c3e50", color = "white") +
# Añadimos etiquetas de texto sobre las barras para ver los valores pequeños
geom_text(aes(label = `Frec. Abs.`), vjust = -0.5, size = 3, color = "#2c3e50") +
labs(title = "Gráfica 1: Distribución de Pérdida Neta en Barriles)",
subtitle = "Variable: Net Loss (Barrels) - Intervalos según Sturges",
x = "Marca de Clase (Barriles)",
y = "Cantidad") +
theme_minimal() +
# Ajustamos el eje Y para que las etiquetas de texto no se corten
scale_y_continuous(expand = expansion(mult = c(0, 0.1)))
# Mostrar la gráfica
print(grafica_dist_ni)
# Gráfico Porcentual Global
ggplot(tabla_completa, aes(x = `Marca Clase`, y = `Frec. Rel. %`)) +
geom_bar(stat = "identity", fill = "#2c3e50", color = "white") +
geom_text(aes(label = paste0(`Frec. Rel. %`, "%")), vjust = -0.5, size = 3) +
labs(title = "Gráfica 2:Distribución Porcentual Pérdida Neta en Barriles)",
subtitle = "Incluye todos los eventos, evidenciando la concentración en el rango mínimo",
x = "Marca de Clase (Volumen en Barriles)",
y = "Porcentaje(%)") +
theme_minimal()
# Gráfico de Ojivas Ascendente y Descendente
ggplot(tabla_completa) +
geom_line(aes(x = `Hasta (bbl)`, y = `Hi Asc. %`, color = "Ascendente (Acumulado)"), size = 1) +
geom_line(aes(x = `Hasta (bbl)`, y = `Hi Desc. %`, color = "Descendente (Restante)"), size = 1, linetype = "dashed") +
geom_point(aes(x = `Hasta (bbl)`, y = `Hi Asc. %`, color = "Ascendente (Acumulado)")) +
scale_color_manual(values = c("Ascendente (Acumulado)" = "#2980b9", "Descendente (Restante)" = "#c0392b")) +
labs(title = "Gráfica 3:Diagrama de Ojivas: Variable Pérdida Neta en Barriles",
x = "Barriles Perdidos",
y = "Porcentaje Acumulado (%)",
color = "Tipo de Ojiva") +
theme_minimal()
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
# Boxplot Global con Identificación de Outliers
ggplot(datos_cont, aes(x = "", y = `Net Loss (Barrels)`)) +
geom_boxplot(fill = "#95a5a6", color = "#2c3e50", outlier.colour = "#e74c3c", outlier.alpha = 0.6) +
annotate("text", x = 1.1, y = max(datos_cont$`Net Loss (Barrels)`),
label = paste("Máximo:", max(datos_cont$`Net Loss (Barrels)`), "bbl"), color = "#c0392b", fontface = "bold") +
labs(title = "Gráfica 4:Diagrama de Cajas: Siniestralidad Total",
subtitle = "La dispersión de los puntos rojos representa los eventos de mayor pérdida",
x = "",
y = "Barriles Perdidos") +
theme_minimal() +
coord_flip()
# --- GRÁFICA EXTRA: BOXPLOT ZOOM (0-500) ---
ggplot(datos_cont %>% filter(`Net Loss (Barrels)` <= 500), aes(x = "", y = `Net Loss (Barrels)`)) +
geom_boxplot(fill = "#5DADE2", color = "#2E4053", outlier.color = "red") +
stat_summary(fun = mean, geom = "point", shape = 18, size = 3, color = "darkred") +
labs(title = "Gráfica 5: Zoom Operativo (0-500 bbl)",
subtitle = "Visualización detallada de la caja sin outliers extremos",
y = "Barriles Perdidos") +
theme_minimal() +
coord_flip()
# --- CÁLCULO DE INDICADORES ESTADÍSTICOS DESCRIPTIVOS ---
# Usamos 'datos_cont' que es el objeto que ya tienes cargado y filtrado
resumen_estadistico <- datos_cont %>%
summarise(
n = n(),
Minimo = min(`Net Loss (Barrels)`, na.rm = TRUE),
Q1 = quantile(`Net Loss (Barrels)`, 0.25, na.rm = TRUE),
Mediana = median(`Net Loss (Barrels)`, na.rm = TRUE),
Media = mean(`Net Loss (Barrels)`, na.rm = TRUE),
Q3 = quantile(`Net Loss (Barrels)`, 0.75, na.rm = TRUE),
Maximo = max(`Net Loss (Barrels)`, na.rm = TRUE),
Desv_Estandar = sd(`Net Loss (Barrels)`, na.rm = TRUE),
Rango = Maximo - Minimo
)
# Ver resultados en consola
print(resumen_estadistico)
## # A tibble: 1 × 9
## n Minimo Q1 Mediana Media Q3 Maximo Desv_Estandar Rango
## <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2795 0 0 0 132. 2 30565 1185. 30565
# --- CONCLUSIÓN ---
# La variable presenta una asimetría positiva extrema. La gran distancia entre la Mediana
# (valor típico) y el Máximo (evento catastrófico) confirma que la mayoría de los incidentes
# son fugas menores, pero la integridad financiera de la operación depende de la gestión de
# los outliers identificados en el extremo derecho de la distribución.