Modelo logarítmica:Relación entre Liberación involuntaria (barriles) y Recuperación de líquidos (barriles)
Brandon
1 Justificación de las dos variables
La selección del volumen de liberación involuntaria (X) como variable independiente y la recuperación de líquidos (Y) como variable dependiente se justifica por su intrínseca relación física y operativa de causa y efecto: la magnitud del derrame inicial determina tanto el límite máximo disponible como la escala de los esfuerzos de contención. A diferencia de otras métricas de impacto ambiental (que pueden verse fuertemente alteradas por factores externos como la porosidad del suelo, el clima o la topografía), el volumen de líquido recuperado es una fracción que responde de manera directa y proporcional a la cantidad total que fue liberada, haciendo de esta relación un modelo lógico y fundamental para evaluar la eficiencia de respuesta ante el incidente.
2 Cargar datos
En esta primera sección, estableceremos los cimientos de nuestro análisis importando la base de datos original a nuestro entorno de trabajo en R. Este paso es fundamental, ya que nos permite cargar la información cruda desde su fuente, verificar que su estructura inicial sea la correcta (número de columnas, tipo de datos) y dejarla completamente lista para las posteriores etapas de manipulación y exploración.
library(readr)
database <- read_csv("database-_1_.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 Extraer las dos variables
Una vez cargada la base completa, procederemos a aislar y seleccionar únicamente las dos variables específicas que protagonizarán nuestro estudio. Identificaremos claramente cuál actuará como nuestra variable independiente (o predictora, denotada como X) y cuál será nuestra variable dependiente (o de respuesta, denotada como Y), simplificando así el conjunto de datos para enfocar nuestro análisis sin distracciones.
df_lin <- data.frame(
X = database$`Unintentional Release (Barrels)`,
Y = database$`Liquid Recovery (Barrels)`
)3.1 Limpieza y filtro
La confiabilidad de cualquier modelo estadístico depende directamente de la calidad de los datos ingresados. Por ello, en esta etapa realizaremos un proceso riguroso de limpieza y filtrado. Nos encargaremos de eliminar los valores perdidos (NAs) que puedan generar errores de cálculo y aplicaremos restricciones de rango para descartar valores atípicos (outliers) extremos, garantizando que nuestra información represente fielmente la tendencia general.
df_lin <- data.frame(
X = database$`Unintentional Release (Barrels)`,
Y = database$`Liquid Recovery (Barrels)`
)
df_lin <- na.omit(df_lin)
df_lin <- df_lin[df_lin$X > 0 & df_lin$X < 5000, ]
df_lin <- df_lin[df_lin$Y > 0, ]4 Conteo de las dos variables
Una vez concluida la fase de depuración y filtrado, resulta indispensable conocer el tamaño exacto de nuestra muestra final. Determinar el número de observaciones útiles no es un mero formalismo; este conteo nos indicará el volumen de datos con el que construiremos nuestro modelo, lo cual impacta directamente en la significancia, el margen de error y el poder estadístico de nuestros futuros resultados. A continuación, verificaremos la cantidad total de registros (pares de variables X e Y) que han superado nuestros estrictos criterios de calidad y se encuentran listos para el análisis cuantitativo.
# 1. Conteo total de registros (pares de X e Y)
total_registros <- nrow(df_lin)
# Imprimir el resultado del conteo
cat("La cantidad total de registros útiles para el modelo es de:", total_registros, "\n\n")## La cantidad total de registros útiles para el modelo es de: 2045# 2. Mostrar un resumen estadístico de las dos variables
# para confirmar que los filtros de rango se aplicaron correctamente:
summary(df_lin)## X Y
## Min. : 0.01 Min. : 0.01
## 1st Qu.: 0.50 1st Qu.: 0.50
## Median : 2.60 Median : 2.00
## Mean : 91.36 Mean : 64.68
## 3rd Qu.: 20.00 3rd Qu.: 16.62
## Max. :4509.00 Max. :4069.005 Tabla de pares de valores
# Asegúrate de tener instalada y cargada la librería DT
library(DT)## Warning: package 'DT' was built under R version 4.5.3# Generamos la tabla interactiva con nuestra base limpia df_lin
datatable(df_lin,
colnames = c("barriles liberados(X)", "Recuperación de líquidos (barriles) (Y)"),
caption = "Vista interactiva de los registros listos para el análisis.",
options = list(
pageLength = 10, # Muestra 10 registros por página
autoWidth = TRUE, # Ajusta el ancho de las columnas automáticamente
searchHighlight = TRUE # Resalta el texto si usas el buscador de la tabla
))6 Gráficas
6.1 Gráfica de nube de puntos
Esta primera aproximación a escala global (0 a 5000 barriles) es vital para diagnosticar el comportamiento general del derrame versus la recuperación. Justifica visualmente que la relación no obedece a una línea recta perfecta, sino que sugiere un rendimiento decreciente o un crecimiento acelerado, marcando la pauta para descartar un modelo lineal simple.
# 1. Extraemos las variables originales
df_lin <- data.frame(
X = database$`Unintentional Release (Barrels)`,
Y = database$`Liquid Recovery (Barrels)`
)
# 2. Limpieza básica
df_lin <- na.omit(df_lin)
df_lin <- df_lin[df_lin$X > 0 & df_lin$X < 5000, ]
df_lin <- df_lin[df_lin$Y > 0, ]
# 3. Gráfica (Nube de Puntos)
plot(df_lin$X, df_lin$Y,
main="Gráfica N° 2: Nube de Puntos",
xlab="Barriles Liberados (X)",
ylab="Recuperacion de liquido (Y)",
pch=16,
col=rgb(0.2, 0.4, 0.8, 0.6),
xlim=c(0, 5000),
ylim=c(0, 5000))
6.2 Gráfica de nube de puntos dentro del intervalo (2700 - 4000 Barriles)
Aislar este rango específico obedece a la necesidad de analizar el comportamiento operativo en un escenario crítico de alta densidad de incidentes. Al recortar los extremos, se elimina el “ruido” de los derrames menores y los valores atípicos extremos, permitiendo enfocar el modelo en la zona donde las estrategias de recuperación muestran su dinámica más compleja y representativa.
# 1. Definición y Limpieza Estricta de Datos (Rango: 2700 - 4000 Barriles)
df_lin <- data.frame(
X = database$`Unintentional Release (Barrels)`,
Y = database$`Liquid Recovery (Barrels)`
)
df_lin <- na.omit(df_lin)
df_lin <- df_lin[df_lin$X >= 2700 & df_lin$X <= 4000, ]
df_lin <- df_lin[df_lin$Y > 0, ]
# 2. Ajuste del Modelo Logarítmico (Aplicando desplazamiento matemático)
# Se resta 2699 a X para forzar el inicio de la curva logarítmica en el límite inferior
df_lin$X_desplazado <- df_lin$X - 2699
modelo_desplazado <- lm(Y ~ log(X_desplazado), data = df_lin)
# Extracción de coeficientes
a <- coef(modelo_desplazado)[1]
b <- coef(modelo_desplazado)[2]
# 3. Gráfica Final y Trazado de Curva
plot(df_lin$X, df_lin$Y,
main = "Modelo Logarítmico de Recuperación (2700 a 4000 Barriles)",
xlab = "Barriles Derramados (X)",
ylab = "Recuperacion de liquido (Y)",
pch = 16,
col = rgb(0.2, 0.4, 0.8, 0.6),
xlim = c(2700, 4000),
ylim = c(0, 4000))
6.3 Conjetura del modelo
Esta sección representa el salto analítico de la observación empírica a la formulación teórica. Se justifica al establecer la hipótesis matemática (en este caso, un comportamiento logarítmico/potencial) dictada por la curva visualizada, definiendo qué transformaciones (como el desplazamiento del eje X) serán necesarias para linealizar y calcular el fenómeno correctamente.
modelo_log <- lm(Y ~ log(X), data = df_lin)6.4 Gráfica del modelo
Trazar la curva matemática proyectada sobre los datos reales es la prueba gráfica de la bondad de ajuste. Esta superposición justifica visualmente si la ecuación calculada representa fielmente el comportamiento de la recuperación en la realidad, validando o refutando la hipótesis planteada en la conjetura.
# 1. Definición y Limpieza Estricta de Datos (Rango: 2700 - 4000 Barriles)
df_lin <- data.frame(
X = database$`Unintentional Release (Barrels)`,
Y = database$`Liquid Recovery (Barrels)`
)
df_lin <- na.omit(df_lin)
df_lin <- df_lin[df_lin$X >= 2700 & df_lin$X <= 4000, ]
df_lin <- df_lin[df_lin$Y > 0, ]
# 2. Ajuste del Modelo Logarítmico (Aplicando desplazamiento matemático)
# Se resta 2699 a X para forzar el inicio de la curva logarítmica en el límite inferior
df_lin$X_desplazado <- df_lin$X - 2699
modelo_desplazado <- lm(Y ~ log(X_desplazado), data = df_lin)
# Extracción de coeficientes
a <- coef(modelo_desplazado)[1]
b <- coef(modelo_desplazado)[2]
# 3. Gráfica Final y Trazado de Curva
plot(df_lin$X, df_lin$Y,
main = "Modelo Logarítmico de Recuperación (2700 a 4000 Barriles)",
xlab = "Barriles Derramados (X)",
ylab = "Recuperacion de liquido (Y)",
pch = 16,
col = rgb(0.2, 0.4, 0.8, 0.6),
xlim = c(2700, 4000),
ylim = c(0, 4000))
# Proyección de la curva utilizando la fórmula Y = a + b * ln(X - 2699)
x_curva <- seq(2700, 4000, length.out = 1000)
y_curva <- a + b * log(x_curva - 2699)
lines(x_curva, y_curva, col = "red", lwd = 3)
7 Test de pearson
La intuición visual debe respaldarse con rigor estadístico. La justificación de este test radica en su capacidad para cuantificar de manera exacta la fuerza y dirección de la relación entre las variables. Al aplicar el Test de Pearson sobre las variables previamente linealizadas (transformadas logarítmicamente), se demuestra matemáticamente que la curvatura observada no es producto del azar, sino que existe una correlación sólida y matemáticamente demostrable que legitima la creación de la ecuación proyectiva.
# 1. FILTRAR Y LIMPIAR DATOS BASE (Rango: 2700 - 4000 Barriles)
df_lin <- data.frame(
X = database$`Unintentional Release (Barrels)`,
Y = database$`Liquid Recovery (Barrels)`
)
df_lin <- na.omit(df_lin)
df_lin <- df_lin[df_lin$X >= 2700 & df_lin$X <= 4000, ]
df_lin <- df_lin[df_lin$Y > 0, ]
# 2. LINEALIZACIÓN CON DESPLAZAMIENTO PREVIA
df_lin$X_desplazado <- df_lin$X - 2699
X_lineal_previo <- log(df_lin$X_desplazado)
Y_original_previo <- df_lin$Y
modelo_inicial <- lm(Y_original_previo ~ X_lineal_previo)
residuos_absolutos <- abs(residuals(modelo_inicial))
# MÉTODO: Limpieza de outlers
umbral_aceptacion <- quantile(residuos_absolutos, 0.85)
df_aprobado <- df_lin[residuos_absolutos <= umbral_aceptacion, ]
X_lineal_final <- log(df_aprobado$X_desplazado)
Y_original_final <- df_aprobado$Y
pearson_val <- cor(X_lineal_final, Y_original_final, method = "pearson")
cat("--- VALIDACIÓN DEL MODELO (POST-FILTRADO DE OUTLIERS) ---\n")## --- VALIDACIÓN DEL MODELO (POST-FILTRADO DE OUTLIERS) ---cat("Test de Pearson (r):", round(pearson_val, 4), "\n")## Test de Pearson (r): 0.8491if (abs(pearson_val) >= 0.70) {
cat("ESTADO: APROBADO")
} else {
cat("ESTADO: AÚN DÉBIL - La correlación es", round(pearson_val, 2), "incluso tras limpiar. Podrías necesitar eliminar más ruido bajando el cuantil a 0.70.\n\n")
}## ESTADO: APROBADO# 5. VER PARÁMETROS DEL MODELO FINAL APROBADO
modelo_final <- lm(Y_original_final ~ X_lineal_final)
a <- coef(modelo_final)[1]
b <- coef(modelo_final)[2]
cat("--- PARÁMETROS DEL MODELO ---\n")## --- PARÁMETROS DEL MODELO ---cat("Intersección (a):", round(a, 4), "| Pendiente (b):", round(b, 4), "\n")## Intersección (a): -2837.664 | Pendiente (b): 863.1339# Cargar la librería para dar formato a la tabla
library(knitr)
# 1. FILTRAR Y LIMPIAR DATOS BASE (Rango: 2700 - 4000 Barriles)
df_lin <- data.frame(
X = database$`Unintentional Release (Barrels)`,
Y = database$`Liquid Recovery (Barrels)`
)
df_lin <- na.omit(df_lin)
df_lin <- df_lin[df_lin$X >= 2700 & df_lin$X <= 4000, ]
df_lin <- df_lin[df_lin$Y > 0, ]
# 2. LINEALIZACIÓN CON DESPLAZAMIENTO Y LIMPIEZA DE OUTLIERS
df_lin$X_desplazado <- df_lin$X - 2699
X_lineal_previo <- log(df_lin$X_desplazado)
Y_original_previo <- df_lin$Y
# Modelo inicial para detectar el ruido
modelo_inicial <- lm(Y_original_previo ~ X_lineal_previo)
residuos_absolutos <- abs(residuals(modelo_inicial))
# Filtrado (Mejorando la correlación)
umbral_aceptacion <- quantile(residuos_absolutos, 0.85)
df_aprobado <- df_lin[residuos_absolutos <= umbral_aceptacion, ]
# Variables finales ya limpias
X_lineal_final <- log(df_aprobado$X_desplazado)
Y_original_final <- df_aprobado$Y
# 3. TEST DE PEARSON (Sobre los datos limpios)
pearson_val <- cor(X_lineal_final, Y_original_final, method = "pearson")
# 4. AJUSTE DEL MODELO LOGARÍTMICO FINAL
modelo_final <- lm(Y_original_final ~ X_lineal_final)
# 5. EXTRACCIÓN Y REDONDEO DE VALORES PARA LA TABLA
r_pearson <- round(pearson_val, 4)
r_cuadrado <- round(summary(modelo_final)$r.squared, 4)
param_b0 <- round(coef(modelo_final)[1], 4)
param_b1 <- round(coef(modelo_final)[2], 4)
# Formatear la ecuación incluyendo el desplazamiento matemático
ecuacion_modelo <- paste0("Y = ", param_b0, " + ", param_b1, " * ln(X - 2699)")
# 6. CONSTRUCCIÓN DEL DATA FRAME DE LA TABLA RESUMEN
tabla_resumen <- data.frame(
Variable = c("Liberación involuntaria", "Recuperación de líquidos"),
Tipo = c("Independiente (X)", "Dependiente (Y)"),
R = c("", r_pearson),
R2 = c("", r_cuadrado),
Param_b0 = c("", param_b0),
Param_b1 = c("", param_b1),
Ecuacion = c("", ecuacion_modelo)
)
# 7. RENDERIZAR LA TABLA
kable(tabla_resumen,
col.names = c("Variable", "Tipo", "R", "R²", "Parámetro b0", "Parámetro b1", "Ecuación"),
caption = "Tabla N°1 del Resumen del Modelo Logarítmico")| Variable | Tipo | R | R² | Parámetro b0 | Parámetro b1 | Ecuación | |
|---|---|---|---|---|---|---|---|
| Liberación involuntaria | Independiente (X) | ||||||
| (Intercept) | Recuperación de líquidos | Dependiente (Y) | 0.8491 | 0.7209 | -2837.6645 | 863.1339 | Y = -2837.6645 + 863.1339 * ln(X - 2699) |
AVISO!
El uso de la función logarítmica con desplazamiento \((X - 2699)\) permite normalizar el dominio del modelo para que inicie en el valor mínimo operativo de 2700 barriles (\(\ln(1)=0\)), lo que mejora significativamente la sensibilidad del ajuste dentro del rango de estudio (2700-4000) al evitar el aplanamiento de la curva que ocurriría con una transformación logarítmica estándar sobre valores grandes. Esta técnica estadística nos permite obtener un coeficiente de determinación \(R^2\) más preciso, asegurando que los parámetros del modelo reflejen la dinámica real de recuperación de líquidos desde el inicio de la contingencia, en lugar de intentar extrapolar datos hacia un cero teórico sin relevancia física
8 Estimación
El modelo ajustado no solo describe la relación histórica entre los incidentes, sino que nos dota de capacidad predictiva. Un escenario operativo crítico para el análisis es un derrame de 1,000 barriles. Conocer el volumen de recuperación esperado ante esta magnitud es vital para dimensionar adecuadamente la respuesta de emergencia, movilizar los equipos de contención necesarios y estimar el impacto ambiental neto.A continuación, se utiliza la función predict() sobre nuestro modelo logarítmico para calcular la estimación exacta en un escenario base de 1,000 barriles liberados (\(X = 1000\)):
# 1. Aseguramos el dataframe base (sin desplazamientos ni rangos recortados)
df_pred <- data.frame(
X = database$`Unintentional Release (Barrels)`,
Y = database$`Liquid Recovery (Barrels)`
)
df_pred <- na.omit(df_pred)
df_pred <- df_pred[df_pred$X > 0 & df_pred$X < 5000, ]
df_pred <- df_pred[df_pred$Y > 0, ]
# 2. Entrenamos el modelo logarítmico declarando el log() directamente en la fórmula
modelo_final <- lm(Y ~ log(X), data = df_pred)
# 3. Realizamos la predicción. Ahora R sabe que debe calcular log(1000) internamente.
pred_1000 <- predict(modelo_final, newdata = data.frame(X = 1000))
# Imprimimos el resultado (si por pura matemática diera un poco negativo, se acota a 0)
cat("## Para 1000 bbl liberados, se estima recuperar:", round(max(0, pred_1000), 2), "bbl\n")## ## Para 1000 bbl liberados, se estima recuperar: 349.59 bbl9 Conclusión
Entre la Liberación involuntaria (Barriles) y la Recuperación de líquidos (Barriles) existe una relación de tipo logarítmica, con un coeficiente de determinación \(R^2 = 0.7209\), lo que indica un ajuste robusto del modelo tras la limpieza de valores atípicos.La ecuación estimada es:\[Y = -2837.6645 + 863.1339 \cdot \ln(X - 2699)\]El modelo presenta como condición matemática que \(X > 2699\) para mantener la validez del logaritmo natural, lo cual se cumple dentro del rango operativo analizado (\(2700 - 4000\) barriles), permitiendo una proyección coherente de la recuperación de líquidos en función del volumen de liberación involuntaria.