Pérdida neta (barriles)
julio jaramilo: Estadística Aplicada
2026-01-29
1. Carga de Dataset
library(moments)
library(readr)
# Carga del archivo
dataset <- read.csv("datasetf.csv", check.names = FALSE)
# Limpieza y preparación
# Comentario: Se limpian los NA para asegurar cálculos exactos;
# la muestra se ajusta de 2795 a 2787 registros válidos.
valor_limpio <- na.omit(dataset$`Net Loss (Barrels)`)
n <- length(valor_limpio)2. Tabla de Distribución de Frecuencias
# Sturges para intervalos (Cálculo con precisión total)
k <- ceiling(1 + 3.322 * log10(n))
limites <- seq(min(valor_limpio), max(valor_limpio), length.out = k + 1)
# Construcción de Frecuencias (Operaciones completas)
ni <- as.vector(table(cut(valor_limpio, breaks = limites, include.lowest = TRUE)))
Li_raw <- limites[1:k]
Ls_raw <- limites[2:(k+1)]
MC_raw <- (Li_raw + Ls_raw) / 2
# Frecuencias relativas y acumuladas con máxima precisión
hi_porc_raw <- (ni / n) * 100
Ni_asc <- cumsum(ni)
Ni_desc <- rev(cumsum(rev(ni)))
Hi_asc_porc_raw <- cumsum(hi_porc_raw)
Hi_desc_porc_raw <- rev(cumsum(rev(hi_porc_raw)))
# Creación de la Tabla Final (Aquí es donde aplicamos el formato visual)
tabla_frecuencias <- data.frame(
Li = round(Li_raw, 2),
Ls = round(Ls_raw, 2),
MC = round(MC_raw, 2),
ni = ni,
hi_porc = round(hi_porc_raw, 2),
Ni_asc = Ni_asc,
Ni_desc = Ni_desc,
Hi_asc_porc = round(Hi_asc_porc_raw, 2),
Hi_desc_porc = round(Hi_desc_porc_raw, 2)
)
# Visualización
print(tabla_frecuencias)## Li Ls MC ni hi_porc Ni_asc Ni_desc Hi_asc_porc
## 1 0.00 2351.15 1175.58 2758 98.68 2758 2795 98.68
## 2 2351.15 4702.31 3526.73 20 0.72 2778 37 99.39
## 3 4702.31 7053.46 5877.88 7 0.25 2785 17 99.64
## 4 7053.46 9404.62 8229.04 2 0.07 2787 10 99.71
## 5 9404.62 11755.77 10580.19 1 0.04 2788 8 99.75
## 6 11755.77 14106.92 12931.35 2 0.07 2790 7 99.82
## 7 14106.92 16458.08 15282.50 1 0.04 2791 5 99.86
## 8 16458.08 18809.23 17633.65 1 0.04 2792 4 99.89
## 9 18809.23 21160.38 19984.81 0 0.00 2792 3 99.89
## 10 21160.38 23511.54 22335.96 0 0.00 2792 3 99.89
## 11 23511.54 25862.69 24687.12 1 0.04 2793 3 99.93
## 12 25862.69 28213.85 27038.27 1 0.04 2794 2 99.96
## 13 28213.85 30565.00 29389.42 1 0.04 2795 1 100.00
## Hi_desc_porc
## 1 100.00
## 2 1.32
## 3 0.61
## 4 0.36
## 5 0.29
## 6 0.25
## 7 0.18
## 8 0.14
## 9 0.11
## 10 0.11
## 11 0.11
## 12 0.07
## 13 0.043. Nueva Tabla de Distribución de Frecuencias(0 A 10 BARRILES)
Filtrar los datos para el nuevo rango, Filtramos la muestra para enfocarnos solo en derrames de 0 a 10 barriles.
datos_zoom <- valor_limpio[valor_limpio >= 0 & valor_limpio <= 10]
n_zoom <- length(datos_zoom)
# Nueva Regla de Sturges para este subconjunto
k_zoom <- ceiling(1 + 3.322 * log10(n_zoom))
# Definir límites exactos de 0 a 10
limites_zoom <- seq(0, 10, length.out = k_zoom + 1)
# 4. Construcción de Frecuencias (Operaciones con precisión total)
ni_z <- as.vector(table(cut(datos_zoom, breaks = limites_zoom, include.lowest = TRUE)))
Li_z_raw <- limites_zoom[1:k_zoom]
Ls_z_raw <- limites_zoom[2:(k_zoom+1)]
MC_z_raw <- (Li_z_raw + Ls_z_raw) / 2
# Porcentajes y acumulados con precisión total
hi_p_z_raw <- (ni_z / n_zoom) * 100
Ni_asc_z <- cumsum(ni_z)
Ni_desc_z <- rev(cumsum(rev(ni_z)))
Hi_asc_z_raw <- cumsum(hi_p_z_raw)
Hi_desc_z_raw <- rev(cumsum(rev(hi_p_z_raw)))
# Tabla Final con formato de 2 decimales
tabla_zoom_10 <- data.frame(
Li = round(Li_z_raw, 2),
Ls = round(Ls_z_raw, 2),
MC = round(MC_z_raw, 2),
ni = ni_z,
hi_porc = round(hi_p_z_raw, 2),
Ni_asc = Ni_asc_z,
Ni_desc = Ni_desc_z,
Hi_asc_porc = round(Hi_asc_z_raw, 2),
Hi_desc_porc = round(Hi_desc_z_raw, 2)
)
# Visualización
print(tabla_zoom_10)## Li Ls MC ni hi_porc Ni_asc Ni_desc Hi_asc_porc Hi_desc_porc
## 1 0.00 0.77 0.38 1890 78.42 1890 2410 78.42 100.00
## 2 0.77 1.54 1.15 165 6.85 2055 520 85.27 21.58
## 3 1.54 2.31 1.92 95 3.94 2150 355 89.21 14.73
## 4 2.31 3.08 2.69 59 2.45 2209 260 91.66 10.79
## 5 3.08 3.85 3.46 19 0.79 2228 201 92.45 8.34
## 6 3.85 4.62 4.23 36 1.49 2264 182 93.94 7.55
## 7 4.62 5.38 5.00 52 2.16 2316 146 96.10 6.06
## 8 5.38 6.15 5.77 18 0.75 2334 94 96.85 3.90
## 9 6.15 6.92 6.54 7 0.29 2341 76 97.14 3.15
## 10 6.92 7.69 7.31 12 0.50 2353 69 97.63 2.86
## 11 7.69 8.46 8.08 11 0.46 2364 57 98.09 2.37
## 12 8.46 9.23 8.85 20 0.83 2384 46 98.92 1.91
## 13 9.23 10.00 9.62 26 1.08 2410 26 100.00 1.084. Graficas de Histogramas
4.1. Histograma Frecuencia Absoluta
#Este muestra todos los datos originales
hist(valor_limpio,
breaks = limites,
main = "Gráfica No. 1: Distribución de Pérdida neta (barriles)",
xlab = "Barriles",
ylab = "Cantidad ",
col = "steelblue",
border = "white",
las = 1)
4.2. Histograma Frecuencia Absoluta (0 A 10 BARRILES)
# Este muestra solo el rango de 0 a 10 barriles
hist(datos_zoom,
breaks = limites_zoom,
main = "Gráfica No. 2: Distribución de Pérdida neta (barriles)",
xlab = "Barriles",
ylab = "Cantidad",
col = "steelblue",
border = "white",
las = 1)
4.3. Histograma Porcentaje
h_global <- hist(valor_limpio,
breaks = limites,
plot = FALSE) # Calculamos sin dibujar primero
# Ajustamos las densidades para que representen el hi_porc de tu tabla
h_global$counts <- (h_global$counts / sum(h_global$counts)) * 100
plot(h_global,
main = "Gráfica No. 3:Distribución Porcentual de Pérdida neta (barriles)",
xlab = "Barriles",
ylab = "Porcentaje (%)",
col = "steelblue",
border = "white",
las = 1)
4.4. Histograma Porcentaje (0 A 10 BARRILES)
h_zoom <- hist(datos_zoom,
breaks = limites_zoom,
plot = FALSE)
# Ajustamos las densidades para que representen el hi_porc de la tabla zoom
h_zoom$counts <- (h_zoom$counts / sum(h_zoom$counts)) * 100
plot(h_zoom,
main = "Gráfica No. 4:Distribución Porcentual de Pérdida neta (barriles)",
xlab = "Barriles",
ylab = "Porcentaje (%)",
col = "steelblue",
border = "white",
las = 1)
5. Grafica de Ojivas
Se observa que las líneas de las ojivas (Ascendente y Descendente) no se cruzan dentro del área visible del gráfico. Esto se justifica porque: 1. Se utilizaron exclusivamente los datos filtrados del intervalo de 0 a 10 barriles. 2. La distribución de los datos es extremadamente asimétrica hacia la izquierda; esto significa que la gran mayoría de los valores son cercanos a 0. 3. Al ser la frecuencia inicial tan alta, el cruce matemático (que representa la mediana) ocurre de forma inmediata en el primer intervalo, pegado al eje Y, lo que impide visualizar la intersección típica en forma de “X”.
plot(tabla_zoom_10$Ls, tabla_zoom_10$Ni_asc, type="b", col="blue", pch=19,
ylim=c(0, n_zoom), # El límite es el tamaño de la muestra
main="Gráfica No 5: Comportamiento de la cantidad Acumulada \n de Pérdida neta (barriles)",
xlab="Barriles", ylab="Cantidad Acumulada")
lines(tabla_zoom_10$Li, tabla_zoom_10$Ni_desc, type="b", col="red", pch=18)
legend("right", legend=c("Ni Ascendente", "Ni Descendente"),
col=c("blue", "red"), pch=c(19, 18), bty="n")
grid()
6. Diagrama de Cajas (0 A 10 BARRILES)
#Se omitieron los valores atípicos (outliers) superiores a 10 barriles
#para permitir una mejor visualización de la dispersión en los incidentes más frecuentes.
boxplot(datos_zoom,
main = "Gráfica No. 6: Distribución de Pérdida neta (barriles)",
ylab = "Barriles",
col = "lightblue",
border = "darkblue",
horizontal = T,
las = 1)
7. Cálculo de Indicadores Estadístocos
Se presentan los indicadores de la variable total para mostrar el impacto de los eventos extremos, y los indicadores del zoom (0-10 barriles) para describir la naturaleza de los incidentes operativos más frecuentes, omitiendo valores atípicos.
# Definir función para la Moda
get_mode <- function(v) {
uniqv <- unique(v)
uniqv[which.max(tabulate(match(v, uniqv)))]
}
# Cálculos para la Variable Total
stats_total <- c(
min(valor_limpio), max(valor_limpio), mean(valor_limpio),
median(valor_limpio), get_mode(valor_limpio), sd(valor_limpio),
(sd(valor_limpio)/mean(valor_limpio))*100, skewness(valor_limpio), kurtosis(valor_limpio)
)
# Cálculos para el Zoom (0-10)
stats_zoom <- c(
min(datos_zoom), max(datos_zoom), mean(datos_zoom),
median(datos_zoom), get_mode(datos_zoom), sd(datos_zoom),
(sd(datos_zoom)/mean(datos_zoom))*100, skewness(datos_zoom), kurtosis(datos_zoom)
)
# Creación de la Tabla Final (Redondeo a 2 decimales solo para visualización)
tabla_indicadores <- data.frame(
Indicador = c("Mínimo", "Máximo", "Media", "Mediana", "Moda",
"SD (Desv. Est.)", "CV (Coef. Var. %)", "As (Asimetría)", "K (Curtosis)"),
Variable_Total = round(stats_total, 2),
Zoom_10_Barriles = round(stats_zoom, 2)
)
# Visualización de resultados
print(tabla_indicadores)## Indicador Variable_Total Zoom_10_Barriles
## 1 Mínimo 0.00 0.00
## 2 Máximo 30565.00 10.00
## 3 Media 132.19 0.78
## 4 Mediana 0.00 0.00
## 5 Moda 0.00 0.00
## 6 SD (Desv. Est.) 1185.02 1.84
## 7 CV (Coef. Var. %) 896.42 236.38
## 8 As (Asimetría) 17.08 3.14
## 9 K (Curtosis) 353.94 13.158. Conclusión
Los indicadores muestran una distribución de asimetría positiva extrema (As = 17.08). La coincidencia de la Moda y la Mediana en 0.00 indica que más de la mitad de los incidentes registrados no presentan pérdida de barriles (o son valores despreciables), mientras que la Media (132.19) se ve fuertemente influenciada por valores atípicos masivos (Máximo de 30,565.00).
Este fenómeno estadístico justifica plenamente el uso del análisis de ‘Zoom’ (0-10), ya que permite entender el comportamiento real y la dispersión de la gran mayoría de los casos, los cuales quedan “ocultos” en el análisis global por el peso de los valores extremos.