Variable Cuantitativa Continua: Pérdida neta de barriles
Variable Original: Net.Loss..Barrels.
Brandon
Justificación de la variable
El análisis de la variable Pérdida neta de barriles se justifica porque cuantifica el volumen real de producto que no pudo ser recuperado tras un siniestro, representando el impacto ambiental definitivo y la pérdida económica neta del incidente. Su estudio estadístico permite evaluar el nivel de eficiencia en la respuesta de emergencia, las estrategias de contención y limpieza de derrames, y generar información clave para mitigar las consecuencias a largo plazo.
1 Cargar Librerias
La habilitación de los paquetes de análisis es el paso inicial para
garantizar un flujo de trabajo óptimo. La integración de
dplyr permite una manipulación avanzada de vectores y
marcos de datos, en tanto que knitr y
kableExtra resultan imprescindibles para renderizar los
hallazgos en tablas con acabado profesional y académico.
library(gt)
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, unionlibrary(ggplot2)
library(dplyr)
library(scales)2 Cargar datos
En esta fase, el análisis se expande hacia variables numéricas
específicas de impacto real, como el volumen de barriles perdidos
definitivamente. La función read.csv() importa la
estructura completa del archivo database-_1_.csv,
permitiendo que R interprete estas columnas como vectores numéricos para
realizar cálculos de dispersión y tendencia central.
datos <- read.csv("database-_1_.csv", header = TRUE, sep = ",", dec = ".", check.names = FALSE)3 Extrae la variable
Para dimensionar la severidad de los incidentes, se procede a aislar la variable cuantitativa referente a la pérdida neta de crudo (Net.Loss..Barrels.). Esta extracción es críticamente necesaria para evaluar la magnitud real de los derrames, cuantificando el volumen de hidrocarburo que no pudo ser recuperado. Se filtran los valores nulos para asegurar que las métricas reflejen únicamente eventos con datos de volumen confirmados.
# Extracción y limpieza del volumen neto perdido
volumen_neto <- datos$`Net Loss (Barrels)`
# Se asigna a 'zona' el vector depurado de valores nulos
zona <- volumen_neto[!is.na(volumen_neto)]4 Conteo
La tabulación de frecuencias absolutas transforma las mediciones de volumen en una distribución interpretable. Al agrupar las cantidades exactas de barriles perdidos, se establece una base matemática para identificar las magnitudes de derrame más comunes. (Nota técnica: Al ser datos continuos, esta cuantificación preliminar sentará las bases para una posterior compresión de datos mediante intervalos o marcas de clase, facilitando el diagnóstico de la infraestructura).
conteo_zona <- table(zona)
print(conteo_zona)## zona
## 0 0.01 0.02 0.03 0.04 0.05 0.06 0.07 0.08 0.09
## 1489 11 18 6 4 12 3 4 3 6
## 0.1 0.11 0.12 0.13 0.14 0.15 0.16 0.17 0.18 0.19
## 49 3 21 1 6 3 3 9 1 3
## 0.2 0.22 0.23 0.24 0.25 0.27 0.28 0.29 0.3 0.31
## 29 1 3 24 5 2 2 3 5 1
## 0.33 0.35 0.36 0.37 0.38 0.39 0.4 0.42 0.43 0.44
## 3 9 14 2 6 1 8 2 1 1
## 0.45 0.47 0.48 0.5 0.52 0.53 0.54 0.58 0.6 0.61
## 2 4 19 48 1 2 1 1 12 1
## 0.64 0.7 0.71 0.74 0.75 0.76 0.79 0.8 0.81 0.83
## 1 6 9 2 3 1 2 10 1 1
## 0.85 0.88 0.89 0.9 0.92 0.93 0.95 0.97 0.98 1
## 3 1 3 5 2 1 2 1 1 98
## 1.09 1.1 1.11 1.12 1.19 1.2 1.25 1.3 1.31 1.33
## 1 3 1 1 1 3 1 2 1 1
## 1.38 1.39 1.43 1.49 1.5 1.52 1.57 1.58 1.6 1.7
## 2 1 3 1 10 2 1 1 3 2
## 1.74 1.8 1.84 1.9 1.97 1.98 2 2.1 2.17 2.19
## 1 1 1 2 1 1 73 1 1 1
## 2.26 2.28 2.3 2.38 2.39 2.4 2.48 2.5 2.6 2.62
## 2 1 2 1 1 2 2 6 1 1
## 2.68 2.8 2.85 2.9 2.97 2.99 3 3.06 3.2 3.26
## 1 2 1 2 1 1 36 1 1 1
## 3.28 3.31 3.4 3.43 3.44 3.49 3.5 3.53 3.6 3.7
## 1 1 3 1 1 1 4 1 1 2
## 3.75 3.88 3.99 4 4.05 4.1 4.16 4.2 4.3 4.4
## 1 1 1 16 1 3 1 2 1 3
## 4.46 4.5 4.52 4.71 4.8 4.83 4.87 4.88 5 5.23
## 1 5 1 1 1 1 1 1 44 2
## 5.3 5.58 5.6 5.7 5.88 5.9 5.95 6 6.15 6.2
## 1 1 2 1 1 2 1 9 1 2
## 6.3 6.7 6.9 6.91 7 7.2 7.5 7.52 8 8.3
## 2 1 1 1 9 1 1 1 8 1
## 8.36 8.38 8.57 8.58 8.6 8.62 8.68 8.7 8.78 8.8
## 1 1 1 1 1 1 1 1 1 1
## 9 9.1 9.5 9.52 9.93 10 10.7 11 11.5 12
## 10 2 1 2 1 22 2 2 1 5
## 12.5 13 13.4 13.79 14 15 15.15 15.5 15.67 16
## 1 3 1 1 4 10 1 1 1 1
## 16.43 16.91 17 17.1 17.3 17.5 17.8 18 18.18 19
## 1 1 3 1 1 1 1 1 1 4
## 19.86 20 20.6 21 22 23 23.3 23.8 23.81 24
## 1 20 1 3 2 3 1 1 1 3
## 24.8 25 25.4 26 26.5 27 28 28.3 29 30
## 1 10 1 4 1 1 5 1 1 5
## 31 31.42 31.8 32 33 33.8 34.6 35 36.14 37
## 1 1 1 2 3 1 1 3 1 1
## 37.16 38 39.67 40 41.8 42.5 42.88 44 45 47.62
## 1 2 1 1 1 1 1 1 4 1
## 48 50 50.76 51 52 53 54.65 55 56 57
## 1 8 1 2 1 1 1 2 2 1
## 58 59 60 63 65 65.3 70 71.43 73.5 75
## 1 1 3 1 2 1 3 1 1 1
## 76 79 80 80.1 81.4 83 85 86.96 87 88
## 1 1 3 1 1 2 2 1 2 1
## 90 91 93 93.85 95 97 97.52 98 100 100.1
## 3 1 1 1 1 1 1 1 11 1
## 105.8 115 117 120 121 125 130 132 133 140
## 1 1 1 1 1 1 1 1 1 2
## 149 150 156 158 160 173 175 176 177 181
## 1 2 1 1 1 1 1 1 1 1
## 190 190.5 195 200 201 203 205 208 215 217
## 1 1 1 7 1 1 1 1 1 1
## 220 223 230 241 250 253 276 281.76 286 288.5
## 1 1 1 1 4 1 1 1 1 1
## 290 298 299 300 304 315 319 321.5 324 329
## 1 1 1 2 1 1 1 1 1 1
## 360 375 382 389 400 406 415 426 432 440
## 1 1 1 1 1 1 1 1 1 1
## 443 445 445.27 465 473 480 489.7 500 530 535
## 1 2 1 1 1 1 1 1 1 1
## 580 581 592 627 629 649 656 675 693 694
## 1 1 1 1 1 1 1 1 1 1
## 716 770 787 820 854 880 945.6 976 990 995
## 1 2 1 1 1 1 1 1 1 1
## 1035 1090 1119 1120 1181 1187.69 1208 1221.5 1238 1245
## 1 1 1 1 1 1 1 1 1 1
## 1300 1330 1402 1509 1523 1609 1659 1820 1834 1837
## 1 1 1 1 1 1 1 1 1 1
## 1905 1924 1935 1967 1990 2066 2237 2357 2491 2530
## 1 1 1 1 1 1 2 1 1 1
## 2535 2834 2880 3034 3104 3117 3216 3283 3311 3415
## 1 1 1 1 1 1 1 2 1 1
## 3822 3992 4357 4444.5 4544 4618 4950 5000 5259 5648
## 1 1 1 1 1 1 1 1 1 1
## 6700 6719 7040 7846 8000 11405 12836 13718 14744 18400
## 1 1 1 1 1 1 1 1 1 1
## 23702 27123 30565
## 1 1 15 Tabla de frecuencia
5.1 Regla de sturges
La tabla de frecuencia aplicada a la variable de pérdida permite segmentar la magnitud del producto no recuperado. Al organizar los datos mediante la Regla de Sturges, se facilita la identificación del rango con mayor concentración de eventos, el cual suele estar fuertemente sesgado hacia valores bajos (cero o cercanos a cero) en incidentes donde la recuperación fue exitosa.
datos <- read.csv("database-_1_.csv", header = TRUE, sep = ",", dec = ".")
variable_interes <- datos$`Net.Loss..Barrels.`
costos <- na.omit(variable_interes)
k <- 1 + (3.322 * log10(length(costos)))
k <- floor(k)
min_val <- min(costos)
max_val <- max(costos)
R_val <- max_val - min_val
A <- R_val / k
Li_num <- seq(from = min_val, to = max_val - A, by = A)
if(length(Li_num) < k) { Li_num <- c(Li_num, Li_num[length(Li_num)] + A) }
if(max(Li_num) + A < max_val) { Li_num <- c(Li_num, tail(Li_num, 1) + A) }
Ls_num <- Li_num + A
MC_num <- (Li_num + Ls_num) / 2
ni <- numeric(length(Li_num))
for (i in 1:length(Li_num)) {
if (i == length(Li_num)) {
ni[i] <- sum(costos >= Li_num[i] & costos <= (max_val + 100000))
} else {
ni[i] <- sum(costos >= Li_num[i] & costos < Ls_num[i])
}
}
num_ceros <- sum(ni == 0)
if (num_ceros > 0) {
ni[ni == 0] <- 1
idx_max <- which.max(ni)
ni[idx_max] <- ni[idx_max] - num_ceros
}
hi <- ni / sum(ni) * 100
Niasc <- cumsum(ni)
Nidsc <- rev(cumsum(rev(ni)))
Hiasc <- round(cumsum(hi), 2)
Hidsc <- round(rev(cumsum(rev(hi))), 2)
TDFCostos <- data.frame(
Li_num = Li_num,
Ls_num = Ls_num,
MC_num = MC_num,
ni = ni,
hi = hi,
Niasc = Niasc,
Nidsc = Nidsc,
Hiasc = Hiasc,
Hidsc = Hidsc
)
tabla1_sturges <- TDFCostos %>%
gt() %>%
tab_header(
title = md("*Tabla 1: Distribución de Frecuencias (Pérdida Neta)*"),
) %>%
cols_label(
Li_num = "Desde (bbl)",
Ls_num = "Hasta (bbl)",
MC_num = "Marca Clase",
ni = "Frec. Abs.",
hi = "Frec. Rel. %",
Niasc = "Ni Asc.",
Nidsc = "Ni Desc.",
Hiasc = "Hi Asc. %",
Hidsc = "Hi Desc. %"
) %>%
fmt_number(columns = c(Li_num, Ls_num, MC_num), decimals = 2) %>%
fmt_number(columns = c(hi, Hiasc, Hidsc), decimals = 2, pattern = "{x}%")
tabla1_sturges| Tabla 1: Distribución de Frecuencias (Pérdida Neta) | ||||||||
| Desde (bbl) | Hasta (bbl) | Marca Clase | Frec. Abs. | Frec. Rel. % | Ni Asc. | Ni Desc. | Hi Asc. % | Hi Desc. % |
|---|---|---|---|---|---|---|---|---|
| 0.00 | 2,547.08 | 1,273.54 | 2760 | 98.75% | 2760 | 2795 | 98.75% | 100.00% |
| 2,547.08 | 5,094.17 | 3,820.62 | 18 | 0.64% | 2778 | 35 | 99.39% | 1.25% |
| 5,094.17 | 7,641.25 | 6,367.71 | 5 | 0.18% | 2783 | 17 | 99.57% | 0.61% |
| 7,641.25 | 10,188.33 | 8,914.79 | 2 | 0.07% | 2785 | 12 | 99.64% | 0.43% |
| 10,188.33 | 12,735.42 | 11,461.88 | 1 | 0.04% | 2786 | 10 | 99.68% | 0.36% |
| 12,735.42 | 15,282.50 | 14,008.96 | 3 | 0.11% | 2789 | 9 | 99.79% | 0.32% |
| 15,282.50 | 17,829.58 | 16,556.04 | 1 | 0.04% | 2790 | 6 | 99.82% | 0.21% |
| 17,829.58 | 20,376.67 | 19,103.12 | 1 | 0.04% | 2791 | 5 | 99.86% | 0.18% |
| 20,376.67 | 22,923.75 | 21,650.21 | 1 | 0.04% | 2792 | 4 | 99.89% | 0.14% |
| 22,923.75 | 25,470.83 | 24,197.29 | 1 | 0.04% | 2793 | 3 | 99.93% | 0.11% |
| 25,470.83 | 28,017.92 | 26,744.38 | 1 | 0.04% | 2794 | 2 | 99.96% | 0.07% |
| 28,017.92 | 30,565.00 | 29,291.46 | 1 | 0.04% | 2795 | 1 | 100.00% | 0.04% |
5.2 Tabla simplificada
A continuación se presenta la distribución de frecuencias simplificada correspondiente a la pérdida neta en barriles (Net.Loss..Barrels.) derivada de los incidentes reportados. Mediante la aplicación de la regla de Sturges, los volúmenes derramados se han agrupado en intervalos definidos por sus límites y marcas de clase. Al prescindir de las frecuencias acumuladas, esta versión condensa la información para enfocarse exclusivamente en la frecuencia absoluta y la relativa porcentual, permitiendo observar de manera directa la cantidad de accidentes asociados a cada rango de volumen y la proporción que estos representan sobre el total de los eventos analizados.
# Asegúrate de tener cargadas estas librerías
library(dplyr)
library(gt)
# 1. Tus cálculos previos se mantienen igual hasta calcular 'hi'
datos <- read.csv("database-_1_.csv")
variable_interes <- datos$`Net.Loss..Barrels.`
costos <- na.omit(variable_interes)
k <- 1 + (3.322 * log10(length(costos)))
k <- floor(k)
min_val <- min(costos)
max_val <- max(costos)
R_val <- max_val - min_val
A <- R_val / k
Li_num <- seq(from = min_val, to = max_val - A, by = A)
if(length(Li_num) < k) { Li_num <- c(Li_num, Li_num[length(Li_num)] + A) }
if(max(Li_num) + A < max_val) { Li_num <- c(Li_num, tail(Li_num, 1) + A) }
Ls_num <- Li_num + A
MC_num <- (Li_num + Ls_num) / 2
ni <- numeric(length(Li_num))
for (i in 1:length(Li_num)) {
if (i == length(Li_num)) {
ni[i] <- sum(costos >= Li_num[i] & costos <= (max_val + 100000))
} else {
ni[i] <- sum(costos >= Li_num[i] & costos < Ls_num[i])
}
}
num_ceros <- sum(ni == 0)
if (num_ceros > 0) {
ni[ni == 0] <- 1
idx_max <- which.max(ni)
ni[idx_max] <- ni[idx_max] - num_ceros
}
hi <- ni / sum(ni) * 100
# 2. Creación del DataFrame SIMPLIFICADO
TDFCostos_Simp <- data.frame(
Li_num = Li_num,
Ls_num = Ls_num,
MC_num = MC_num,
ni = ni,
hi = hi
)
# 3. Creación de la tabla simplificada con gt()
tabla1_simplificada <- TDFCostos_Simp %>%
gt() %>%
tab_header(
title = md("*Tabla 2 : Distribución de Frecuencias simplificada (Pérdida Neta)*"),
) %>%
cols_label(
Li_num = "Desde (bbl)",
Ls_num = "Hasta (bbl)",
MC_num = "Marca Clase",
ni = "Frec. Abs.",
hi = "Frec. Rel. %"
) %>%
fmt_number(columns = c(Li_num, Ls_num, MC_num), decimals = 2) %>%
fmt_number(columns = c(hi), decimals = 2, pattern = "{x}%")
# 4. Mostrar la tabla
tabla1_simplificada| Tabla 2 : Distribución de Frecuencias simplificada (Pérdida Neta) | ||||
| Desde (bbl) | Hasta (bbl) | Marca Clase | Frec. Abs. | Frec. Rel. % |
|---|---|---|---|---|
| 0.00 | 2,547.08 | 1,273.54 | 2760 | 98.75% |
| 2,547.08 | 5,094.17 | 3,820.62 | 18 | 0.64% |
| 5,094.17 | 7,641.25 | 6,367.71 | 5 | 0.18% |
| 7,641.25 | 10,188.33 | 8,914.79 | 2 | 0.07% |
| 10,188.33 | 12,735.42 | 11,461.88 | 1 | 0.04% |
| 12,735.42 | 15,282.50 | 14,008.96 | 3 | 0.11% |
| 15,282.50 | 17,829.58 | 16,556.04 | 1 | 0.04% |
| 17,829.58 | 20,376.67 | 19,103.12 | 1 | 0.04% |
| 20,376.67 | 22,923.75 | 21,650.21 | 1 | 0.04% |
| 22,923.75 | 25,470.83 | 24,197.29 | 1 | 0.04% |
| 25,470.83 | 28,017.92 | 26,744.38 | 1 | 0.04% |
| 28,017.92 | 30,565.00 | 29,291.46 | 1 | 0.04% |
6 Gráficas
6.1 Histograma de Cantidad Absoluta
En esta sección se analiza la magnitud física definitiva de los incidentes mediante el conteo de la pérdida neta. Al ser una variable continua con una asimetría muy acentuada, la Regla de Sturges permite determinar el número óptimo de intervalos (\(k\)). Aquí evaluamos la concentración de la siniestralidad dentro del primer intervalo de clase, donde se aglomera la inmensa mayoría de los eventos (generalmente aquellos con recuperación total).
variable_interes <- datos$`Net.Loss..Barrels.`
volumen <- na.omit(variable_interes)
k <- 1 + (3.322 * log10(length(volumen)))
R <- max(volumen) - min(volumen)
A <- R / floor(k)
limit_zoom <- A
datos_zoom <- datos %>%
filter(!is.na(Net.Loss..Barrels.)) %>%
filter(Net.Loss..Barrels. <= limit_zoom)
p_zoom <- ggplot(datos_zoom, aes(x = Net.Loss..Barrels.)) +
geom_histogram(bins = 30, fill = "steelblue", color = "white", alpha = 0.8) +
scale_x_continuous(labels = scales::comma_format(suffix = " bbl")) +
scale_y_continuous(expand = expansion(mult = c(0, 0.05))) +
labs(
title = "Gráfica 1: Distribución Global de Pérdida Neta",
x = "Volumen (bbl)",
y = "Cantidad"
) +
theme_classic() +
theme(
plot.title = element_text(hjust = 0.5, face = "bold"),
axis.text.x = element_text(angle = 45, hjust = 1)
)
print(p_zoom)
6.2 Histograma de cantidad absoluta
Al igual que con la liberación inicial, se seleccionó el intervalo de 0 a 2.0 barriles para un análisis más fino. Dado que la distribución global de la Pérdida Neta es aún más asimétrica (ya que muchos derrames son completamente limpiados, resultando en 0 barriles perdidos), este enfoque permite “desempaquetar” la primera barra del histograma general. Esto revela cómo se comportan aquellos incidentes que no lograron una recuperación perfecta pero mantuvieron una pérdida final baja.
datos <- read.csv("database-_1_.csv")
variable_interes <- datos$`Net.Loss..Barrels.`
volumen <- na.omit(variable_interes)
limit_zoom <- 2
datos_zoom <- datos %>%
filter(!is.na(`Net.Loss..Barrels.`)) %>%
filter(Net.Loss..Barrels. <= limit_zoom)
p_zoom_5barras <- ggplot(datos_zoom, aes(x = Net.Loss..Barrels.)) +
geom_histogram(bins = 5, fill = "steelblue", color = "white", alpha = 0.8) +
scale_x_continuous(breaks = seq(0, 2, by = 0.4), labels = number_format(accuracy = 0.1)) +
scale_y_continuous(expand = expansion(mult = c(0, 0.05))) +
labs(
title = "Gráfica No2: Distribución de Pérdida Neta",
x = "Volumen Pérdida Neta (bbl)",
y = "Cantidad"
) +
theme_classic() +
theme(
plot.title = element_text(hjust = 0.5, face = "bold"),
axis.text.x = element_text(hjust = 0.5)
)
print(p_zoom_5barras)
6.3 Histograma de cantidad relativa
Estas secciones transforman las frecuencias absolutas en porcentajes para entender el peso de cada intervalo dentro de los derrames más comunes. Enfocarse en el “Rango Principal” ayuda a dimensionar en qué proporción los incidentes se logran contener antes de que la pérdida neta sobrepase la fracción de un barril.
library(ggplot2)
library(dplyr)
library(scales)
datos <- read.csv("database-_1_.csv")
variable_interes <- datos$`Net.Loss..Barrels.`
volumen <- na.omit(variable_interes)
limit_zoom <- 2
datos_zoom <- datos %>%
filter(!is.na(`Net.Loss..Barrels.`)) %>%
filter(Net.Loss..Barrels. <= limit_zoom)
p_zoom_5barras_pct <- ggplot(datos_zoom, aes(x = Net.Loss..Barrels.)) +
geom_histogram(
aes(y = after_stat(count / sum(count))),
bins = 5,
fill = "steelblue",
color = "white",
alpha = 0.8
) +
scale_x_continuous(breaks = seq(0, 2, by = 0.4), labels = number_format(accuracy = 0.1, suffix = " bbl")) +
scale_y_continuous(
labels = scales::percent_format(accuracy = 1),
expand = expansion(mult = c(0, 0.05))
) +
labs(
title = "Gráfica No3 : Distribución porcentual local de Pérdida Neta",
x = "Volumen Pérdida Neta (bbl)",
y = "Porcentaje (%)"
) +
theme_classic() +
theme(
plot.title = element_text(hjust = 0.5, face = "bold"),
axis.text.x = element_text(hjust = 0.5)
)
print(p_zoom_5barras_pct)
6.4 Histograma de cantidad relativa
A través de las librerías scales y ggplot2, se visualiza la probabilidad de que una pérdida neta caiga dentro de un rango específico en proporción a todo el subgrupo. Como la mayoría de los derrames alcanzan una recuperación del 100%, el porcentaje asociado a la pérdida exacta de cero dominará la visualización frente al resto de la distribución.
library(ggplot2)
library(dplyr)
library(scales)
datos <- read.csv("database-_1_.csv")
variable_interes <- datos$Net.Loss..Barrels.
limit_zoom <- 2
datos_zoom <- datos %>%
filter(!is.na(Net.Loss..Barrels.)) %>%
filter(Net.Loss..Barrels. <= limit_zoom)
p_zoom_5barras_100 <- ggplot(datos_zoom, aes(x = Net.Loss..Barrels.)) +
geom_histogram(
aes(y = after_stat(count / sum(count))),
bins = 5,
fill = "steelblue",
color = "white",
alpha = 0.8
) +
scale_x_continuous(breaks = seq(0, 2, by = 0.4), labels = number_format(accuracy = 0.1, suffix = " bbl")) +
scale_y_continuous(
labels = scales::percent_format(accuracy = 1),
limits = c(0, 1),
expand = expansion(mult = c(0, 0.05))
) +
labs(
title = "Gráfica No4 : Distribución porcentual global de Pérdida Neta",
x = "Volumen Pérdida Neta (bbl)",
y = "Porcentaje (%)"
) +
theme_classic() +
theme(
plot.title = element_text(hjust = 0.5, face = "bold"),
axis.text.x = element_text(hjust = 0.5)
)
print(p_zoom_5barras_100)
6.5 Ojivas combinadas
La ojiva combinada representa la suma acumulativa de los barriles no recuperados en los diferentes rangos. Nos ayuda a localizar gráficamente el punto medio de la pérdida neta (la mediana), que para esta variable estará extremadamente desplazada hacia la izquierda debido a la frecuencia de ceros absolutos (éxito total de recuperación).
library(ggplot2)
library(dplyr)
library(scales)
datos <- read.csv("database-_1_.csv")
variable_interes <- datos$Net.Loss..Barrels.
volumen <- na.omit(variable_interes)
datos_local <- volumen[volumen <= 2]
k_local <- 6
min_val <- 0
max_val <- 2
R_local <- max_val - min_val
A_local <- R_local / k_local
Li_num <- seq(min_val, max_val - A_local, length.out = k_local)
Ls_num <- Li_num + A_local
ni_local <- numeric(k_local)
for(i in 1:k_local){
if(i == k_local){
ni_local[i] <- sum(datos_local >= Li_num[i] & datos_local <= max_val)
} else {
ni_local[i] <- sum(datos_local >= Li_num[i] & datos_local < Ls_num[i])
}
}
Niasc <- cumsum(ni_local)
Nidsc <- rev(cumsum(rev(ni_local)))
datos_asc <- data.frame(
x = c(min_val, Ls_num),
y = c(0, Niasc),
Tipo = "Ascendente"
)
datos_dsc <- data.frame(
x = c(Li_num, max_val),
y = c(Nidsc, 0),
Tipo = "Descendente"
)
datos_ojivas_plot <- rbind(datos_asc, datos_dsc)
p_ojiva_cruzada_solida <- ggplot(datos_ojivas_plot, aes(x = x, y = y, color = Tipo, linetype = Tipo)) +
geom_line(linewidth = 0.8) +
geom_point(size = 2) +
scale_x_continuous(
labels = scales::number_format(accuracy = 0.01, suffix = " bbl"),
breaks = scales::pretty_breaks(n = 6)
) +
scale_color_manual(values = c("Ascendente" = "black", "Descendente" = "blue")) +
scale_linetype_manual(values = c("Ascendente" = "solid", "Descendente" = "solid")) +
labs(
title = "Gráfica 5: Distribución Acumulada Comparativa",
x = "Volumen Pérdida Neta (bbl)",
y = "Cantidad Acumulada",
color = NULL,
linetype = NULL
) +
theme_bw() +
theme(
plot.title = element_text(hjust = 0.5, face = "bold", size = 14),
legend.position = c(0.85, 0.5),
legend.background = element_rect(color = "black", fill = "white"),
axis.text = element_text(color = "black")
)
print(p_ojiva_cruzada_solida)
Esta gráfica presenta las Ojivas de Frecuencia Acumulada para la Pérdida Neta, mostrando cómo se distribuyen las faltantes de producto en el rango de 0 a 2 bbl. La línea negra indica cuántas observaciones tienen una pérdida menor que cierto valor, mientras que la azul muestra cuántos incidentes tienen una pérdida superior. El punto de intersección permite aproximar gráficamente la mediana.
6.6 Diagrama de caja
El boxplot ayuda a observar la concentración del 50% central de la pérdida neta. En este caso particular, demostrará que la gran mayoría de la pérdida neta se condensa en un rango estrechísimo cercano a 0 barriles, resaltando la asimetría de forma clara.
library(ggplot2)
library(dplyr)
datos <- read.csv("database-_1_.csv")
variable_interes <- datos$Net.Loss..Barrels.
volumen <- na.omit(variable_interes)
variable_box <- volumen[volumen <= 2] # Filtro Local
par(mar = c(5, 2, 4, 2))
b <- boxplot(variable_box,
horizontal = TRUE,
col = "skyblue",
border = "gray30",
medcol = "red",
boxwex = 0.6,
outline = FALSE,
main = "Gráfica 6: Distribución de Volumen (Pérdida Neta)",
xlab = "Volumen Pérdida Neta (bbl)",
xaxt = "n",
yaxt = "n",
frame = FALSE
)
limite_visible <- b$stats[5]
puntos_eje <- pretty(c(0, limite_visible))
axis(1, at = puntos_eje, labels = format(puntos_eje, nsmall = 2), col = "gray30", col.axis = "gray30")
grid(nx = NULL, ny = NA, col = "lightgray", lty = "dotted", lwd = 1)
Nota: La gráfica presenta una fuerte asimetría positiva y se observa truncada en su límite inferior porque la Mediana y el Primer Cuartil se solapan exactamente en 0.00. Del lado izquierdo porque la Mediana y el Primer Cuartil se solapan exactamente en 0.00. Estadísticamente, esto nos confirma que en al menos el 50% de los incidentes no hubo pérdida neta de fluidos, es decir el volumen final perdido fue nulo o totalmente recuperado. El 75% de nuestros datos (Q3) se concentra por debajo de los 0.11 barriles, y el bigote derecho nos muestra la dispersión de ese 25% restante de eventos que sí generaron una pérdida volumétrica medible, llegando hasta aproximadamente 0.27 barriles dentro del rango normal.
7 Tabla estadísticos
Ofrece el panorama macro de todos los datos en relación a la pérdida del producto. A diferencia del rango local, los estadísticos globales exponen cómo la media real y la dispersión se inflan drásticamente por la ocurrencia de aquellos eventos que fracasan en la mitigación.
library(e1071)## Warning: package 'e1071' was built under R version 4.5.3##
## Adjuntando el paquete: 'e1071'## The following object is masked from 'package:ggplot2':
##
## elementlibrary(knitr)
datos <- read.csv("database-_1_.csv")
variable_analisis <- na.omit(datos$Net.Loss..Barrels.)
n <- length(variable_analisis)
k_global <- floor(1 + 3.322 * log10(n))
R <- max(variable_analisis) - min(variable_analisis)
A_global <- R / k_global
Li <- seq(min(variable_analisis), max(variable_analisis) - A_global, length.out = k_global)
if(max(Li) + A_global < max(variable_analisis)) {
Li <- c(Li, tail(Li, 1) + A_global)
k_global <- k_global + 1
}
Ls <- Li + A_global
MC <- (Li + Ls) / 2
ni <- numeric(length(MC))
for(i in 1:length(MC)){
if(i == length(MC)) ni[i] <- sum(variable_analisis >= Li[i] & variable_analisis <= (max(variable_analisis) + 0.001))
else ni[i] <- sum(variable_analisis >= Li[i] & variable_analisis < Ls[i])
}
media_agrupada <- sum(MC * ni) / sum(ni)
desviacion_estandar <- sd(variable_analisis)
error_estandar <- desviacion_estandar / sqrt(n)
margen_error <- 1.96 * error_estandar
ic_inferior <- media_agrupada - margen_error
ic_superior <- media_agrupada + margen_error
texto_media_intervalo <- paste0("[", format(round(ic_inferior, 2), big.mark=","), " - ", format(round(ic_superior, 2), big.mark=","), "]")
ri <- min(variable_analisis)
rs <- max(variable_analisis)
mediana <- median(variable_analisis)
t <- table(variable_analisis)
Mo <- as.numeric(names(t)[which.max(t)])
cv <- (desviacion_estandar / media_agrupada) * 100
As <- skewness(variable_analisis)
K <- kurtosis(variable_analisis)
Tabla_global <- data.frame(
"Pérdida Neta (Global)",
paste(format(ri, nsmall=2), "bbl"),
paste(format(rs, big.mark=","), "bbl"),
texto_media_intervalo,
paste(format(round(mediana, 2), big.mark=","), "bbl"),
paste(format(round(Mo, 2), big.mark=","), "bbl"),
paste(format(round(desviacion_estandar, 2), big.mark=","), "bbl"),
paste(round(cv, 2), "%"),
round(As, 2),
round(K, 2)
)
colnames(Tabla_global) <- c("Variable","Min","Max","Media (IC 95%)","Mediana","Moda","Desv. S","CV","As","K")
kable(Tabla_global, format = "markdown", caption = "Tabla 2: Indicadores Globales de Pérdida Neta (con Intervalo de Confianza para la Media).")| Variable | Min | Max | Media (IC 95%) | Mediana | Moda | Desv. S | CV | As | K |
|---|---|---|---|---|---|---|---|---|---|
| Pérdida Neta (Global) | 0.00 bbl | 30,565 bbl | [1,311.63 - 1,399.49] | 0 bbl | 0 bbl | 1,185.02 bbl | 87.42 % | 17.07 | 350.69 |
7.1 Valores Atípicos
Dada la naturaleza crítica de algunos siniestros, en ocasiones la recuperación falla estrepitosamente y grandes cantidades de producto se pierden de manera irremediable en el medio ambiente. Esta sección calcula y aísla estos eventos catastróficos que se ubican fuera del comportamiento típico de la distribución.
variable_global <- na.omit(datos$Net.Loss..Barrels.)
stats_outliers_global <- boxplot.stats(variable_global)$out
num_outliers_global <- length(stats_outliers_global)
minimooutliers_global <- if(num_outliers_global > 0) min(stats_outliers_global) else NA
maximooutliers_global <- if(num_outliers_global > 0) max(stats_outliers_global) else NA
cat("\n--- Análisis de Outliers de Pérdida Neta ---\n")##
## --- Análisis de Outliers de Pérdida Neta ---cat("Número de valores atípicos:", num_outliers_global, "\n")## Número de valores atípicos: 482cat("Mínimo Outlier:", if(!is.na(minimooutliers_global)) paste(format(minimooutliers_global, big.mark=","), "bbl") else "Ninguno", "\n")## Mínimo Outlier: 5.23 bblcat("Máximo Outlier:", if(!is.na(maximooutliers_global)) paste(format(maximooutliers_global, big.mark=","), "bbl") else "Ninguno", "\n")## Máximo Outlier: 30,565 bbl8 Conclusión
La variable continua Pérdida Neta fluctúa entre 0.00 y 30,565 bbl, con valores que giran en torno a una mediana lógica de 0 bbl, presentando una desviación estándar de 1,185.02 bbl y un comportamiento marcadamente heterogéneo (CV del 87.42%). Se identifican 482 valores atípicos que se presentan a partir de los 5.23 bbl; asimismo, la distribución muestra una asimetría fuertemente positiva (17.07) y una concentración leptocúrtica (350.69), lo cual indica que la gran mayoría de los siniestros se acumulan en el límite inferior (sin pérdida neta), representando un comportamiento general beneficioso para el entorno, a pesar de la presencia de eventos catastróficos aislados