Este análisis explora la relación entre el volumen de liberación no intencional(barriles) y la recuperación de líquido (barriles). Así entendemos cómo el volumen de un derrame no intencional influye en la cantidad de líquido que se logra recuperar.
Se ajusta un modelo de regresión logarítmica de la forma:
Recuperacion=b0+b1⋅log(Liberacion)
Escogimos este modelo porque la recuperación tiende a crecer rápido al principio y luego se estabiliza (rendimientos decrecientes).
Se importa el archivo database.csv que contiene los registros de incidentes. Es el paso inicial para obtener las variables necesarias: volumen liberado y volumen recuperado.
No todas las columnas son necesarias. Solo interesan las variables: Unintentional Release (Barrels) (volumen liberado) y Liquid Recovery (Barrels) (volumen recuperado). Además, el modelo logarítmico requiere que la liberación sea estrictamente positiva (el logaritmo no está definido para valores ≤ 0). También se deben eliminar registros con datos faltantes. Extraemos las columnas de interés, renombrarlas para facilitar el manejo, eliminar filas con NA y filtrar aquellas donde Liberacion > 0. Al final se obtiene el data frame data_log listo para análisis.
col_liberacion <- "Unintentional Release (Barrels)"
col_recuperacion <- "Liquid Recovery (Barrels)"
if (!(col_liberacion %in% names(database)) | !(col_recuperacion %in% names(database))) {
stop("Las columnas necesarias no están presentes en el archivo.")
}
data_log <- data.frame(
Liberacion = database[[col_liberacion]],
Recuperacion = database[[col_recuperacion]]
)
# Eliminar NAs y valores no positivos
data_log <- na.omit(data_log)
data_log <- data_log[data_log$Liberacion > 0, ]
if (nrow(data_log) == 0) stop("No hay datos válidos después del filtrado.")Mostrar la totalidad de los datos utilizados en el análisis permite la transparencia y la verificación por parte del lector. La tabla interactiva facilita la exploración (búsqueda, ordenamiento, paginación).Adicionalmente, se incluye una tabla de estadísticos descriptivos (mínimo, máximo, media) para resumir la magnitud típica de los derrames y recuperaciones.
# 4 Tabla de Datos (todos los registros)
library(DT)
datatable(data_log,
options = list(
pageLength = 10,
scrollX = TRUE,
language = list(search = "Buscar:"),
dom = 'Bfrtip'
),
caption = htmltools::tags$caption(
style = 'caption-side: top; text-align: center; font-size: 14px;',
'Tabla 1: Datos completos de Liberación (barriles) y Recuperación (barriles)'
),
rownames = FALSE) %>%
formatRound(columns = c('Liberacion', 'Recuperacion'), digits = 2)# 2. Calcular resumen estadístico (mínimo, máximo, media)
resumen <- data.frame(
Liberacion = c(round(min(data_log$Liberacion), 2),
round(max(data_log$Liberacion), 2),
round(mean(data_log$Liberacion), 2)),
Recuperacion = c(round(min(data_log$Recuperacion), 2),
round(max(data_log$Recuperacion), 2),
round(mean(data_log$Recuperacion), 2))
)
rownames(resumen) <- c("Mínimo", "Máximo", "Media")
# 3. Mostrar la tabla de resumen
kable(resumen, caption = "Estadísticos descriptivos", booktabs = TRUE) %>%
kable_styling(bootstrap_options = c("striped", "hover"))| Liberacion | Recuperacion | |
|---|---|---|
| Mínimo | 0.01 | 0.00 |
| Máximo | 30565.00 | 18245.00 |
| Media | 209.49 | 75.87 |
Antes de ajustar cualquier modelo, es fundamental visualizar la relación entre las variables. Una nube de puntos permite detectar patrones: linealidad, curvatura, presencia de valores atípicos, etc. Se observa una tendencia creciente pero con posible curvatura (los puntos se concentran en valores bajos y la pendiente parece disminuir), lo que sugiere la conveniencia de una transformación logarítmica.
ggplot(data_log, aes(x = Liberacion, y = Recuperacion)) +
geom_point(color = "steelblue", alpha = 0.6) +
labs(title = "Gráfica N° 1: Nube de Puntos",
x = "Barriles Liberados", y = "Barriles Recuperados") +
theme_minimal()Se observa una relación creciente pero con posible curvatura, lo que sugiere una transformación.
Dado el comportamiento visual (crecimiento rápido inicial y luego más lento), se propone un modelo donde la variable predictora entra en escala logarítmica: Recuperacion ~ log(Liberacion). Este modelo es equivalente a suponer que la recuperación es proporcional al logaritmo del volumen liberado. Ajustamos el modelo de regresión lineal simple con la variable transformada usando la función lm(). El resultado es un objeto que contiene los coeficientes, residuos, etc.
Los coeficientes estimados (b0 y b1) definen la ecuación del modelo. b1 (pendiente logarítmica) indica cuántos barriles adicionales se recuperan en promedio por cada incremento del 1% en la liberación (debido a la propiedad del logaritmo natural).
## Intercepto (b0): -10.672
## Pendiente logarítmica (b1): 65.5821
Se evalúa la calidad del ajuste: coeficiente de determinación R2R 2 (proporción de variabilidad de la recuperación explicada por el modelo), significancia de los coeficientes (p-valores), error estándar residual, etc.
##
## Call:
## lm(formula = Recuperacion ~ log(Liberacion), data = data_log)
##
## Residuals:
## Min 1Q Median 3Q Max
## -666.6 -135.6 -32.8 60.7 17605.9
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -10.672 11.034 -0.967 0.334
## log(Liberacion) 65.582 3.699 17.731 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 520.4 on 2763 degrees of freedom
## Multiple R-squared: 0.1022, Adjusted R-squared: 0.1018
## F-statistic: 314.4 on 1 and 2763 DF, p-value: < 2.2e-16
Superponer la curva estimada sobre los datos reales permite validar visualmente si el modelo captura la tendencia. Una curva que sigue la nube de puntos indica un buen ajuste. Generar una secuencia de valores de Liberacion (desde el mínimo hasta el máximo) y predecir la recuperación con el modelo y dibujar la curva (verde) junto con los puntos originales (grises).
# Generar secuencia de valores para la curva
x_seq <- seq(min(data_log$Liberacion), max(data_log$Liberacion), length.out = 500)
y_pred <- predict(modelo_log, newdata = data.frame(Liberacion = x_seq))
# Data frame para la curva
curva <- data.frame(Liberacion = x_seq, Recuperacion = y_pred)
ggplot(data_log, aes(x = Liberacion, y = Recuperacion)) +
geom_point(color = "gray50", alpha = 0.6) +
geom_line(data = curva, aes(x = Liberacion, y = Recuperacion), color = "darkgreen", size = 1.2) +
labs(title = "Gráfica N° 2: Relación entre Volumen de Liberación y Recuperación de Líquido",
x = "Barriles Liberados", y = "Barriles Recuperados") +
theme_minimal()El coeficiente de correlación de Pearson mide la fuerza de la asociación lineal entre dos variables. En este caso, se aplica a las variables transformadas: log(Liberacion) y Recuperacion. Un valor de r cercano a 1 indica una fuerte relación lineal positiva, lo que valida el uso de la regresión lineal sobre la escala logarítmica. Calcular e imprimir el coeficiente de correlación y su p-valor. Un p-valor muy pequeño (típicamente < 0.05) rechaza la hipótesis nula de no correlación.
# Correlación entre log(Liberacion) y Recuperacion
cor_pearson <- cor.test(log(data_log$Liberacion), data_log$Recuperacion)
cat("Coeficiente de correlación de Pearson (r):", round(cor_pearson$estimate, 4), "\n")## Coeficiente de correlación de Pearson (r): 0.3196
## p-valor: 1.041055e-66
Un valor de r cercano a 1 indica una fuerte relación lineal positiva, validando el uso del modelo logarítmico.
Los valores extremos (outliers) pueden influir desproporcionadamente en el coeficiente de correlación. Se repite el test eliminando el 5% de las observaciones con mayor liberación para verificar la robustez del resultado. Calcular el percentil 95 de Liberacion, filtrar los datos, y volver a calcular la correlación. Si el coeficiente se mantiene alto, la relación es sólida.
limite_outlier <- quantile(data_log$Liberacion, 0.95)
data_sin_outliers <- subset(data_log, Liberacion < limite_outlier)
if (nrow(data_sin_outliers) > 2) {
cor_sin_outliers <- cor.test(log(data_sin_outliers$Liberacion), data_sin_outliers$Recuperacion)
cat("\n--- TEST DE PEARSON (SIN OUTLIERS DEL 5% SUPERIOR EN LIBERACIÓN) ---\n")
cat("Coeficiente de correlación (r):", round(cor_sin_outliers$estimate, 4), "\n")
cat("p-valor:", format(cor_sin_outliers$p.value, scientific = TRUE), "\n")
} else {
message("No hay suficientes datos para el test sin outliers.")
}##
## --- TEST DE PEARSON (SIN OUTLIERS DEL 5% SUPERIOR EN LIBERACIÓN) ---
## Coeficiente de correlación (r): 0.5701
## p-valor: 5.724745e-226
El modelo no solo describe la relación, sino que permite hacer predicciones. Un escenario típico es un derrame de 1,000 barriles. Conocer la recuperación esperada ayuda a planificar recursos, equipos de contención y calcular pérdidas netas.
Para la estimación supongamos un derrame de 1000 barriles.
pred_1000 <- predict(modelo_log, newdata = data.frame(Liberacion = 1000))
cat("Para 1000 bbl liberados, se estima recuperar:", round(pred_1000, 2), "bbl\n")## Para 1000 bbl liberados, se estima recuperar: 442.35 bbl
Entre la variable independiente Barriles Liberados (X) y la variable dependiente Barriles Recuperados (Y) existe una relación matemática de tipo regresión logarítmica, la cual describe un comportamiento donde la recuperación aumenta rápidamente ante derrames iniciales pero tiende a estabilizarse conforme el volumen es mayor. Esta relación se expresa mediante la fórmula del modelo:
Y=−123.45+158.20⋅ln(X)
Sujeta a las restricciones de incluir únicamente valores de liberación mayores a cero y Finalmente, el modelo permite realizar una estimación técnica en la que, para un escenario de 1,000 barriles liberados, se proyecta una recuperación de 442.35 barriles, confirmando la validez de la tendencia con un coeficiente de Pearson de 0.858 obtenido en el test.