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 UN SOLO X Y UN SOLO Y (Limpieza)
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, ]
df_lin <- df_lin[df_lin$Y < (df_lin$X * 100 + 50000), ]
# 2. MEDIA ARITMÉTICA Y EL MÁXIMO
cat("--- ESTADÍSTICA DESCRIPTIVA ---\n")## --- ESTADÍSTICA DESCRIPTIVA ---cat("X (Barriles) -> Media:", round(mean(df_lin$X), 2), "| Máximo:", max(df_lin$X), "\n")## X (Barriles) -> Media: 91.36 | Máximo: 4509cat("Y (Costos) -> Media:", round(mean(df_lin$Y), 2), "| Máximo:", max(df_lin$Y), "\n\n")## Y (Costos) -> Media: 64.68 | Máximo: 4069# 3. TRABAJAR POR PARTES: Linealización y Variables Temporales
X_lineal <- log(df_lin$X)
Y_lineal <- log(df_lin$Y)
# 4. TEST DE PEARSON (Con las variables lineales temporales)
pearson_val <- cor(X_lineal, Y_lineal, method = "pearson")
cat("--- VALIDACIÓN DEL MODELO ---\n")## --- VALIDACIÓN DEL MODELO ---cat("Test de Pearson (r) sobre relación lineal:", round(pearson_val, 4), "\n")## Test de Pearson (r) sobre relación lineal: 0.979# Si Pearson es cercano a 1 (o -1), da como bueno generar la curva
# 5. VER PARÁMETROS PARA LA RELACIÓN LINEAL
modelo_linealizado <- lm(Y_lineal ~ X_lineal)
cat("Parámetros Lineales -> Intersección (a):", round(coef(modelo_linealizado)[1], 4),
"| Pendiente (b):", round(coef(modelo_linealizado)[2], 4), "\n\n")## Parámetros Lineales -> Intersección (a): -0.1091 | Pendiente (b): 0.9492# Recuperamos los parámetros de la linealización para la fórmula original (Y = a * X^b)
a_potencial <- exp(coef(modelo_linealizado)[1])
b_potencial <- coef(modelo_linealizado)[2]# Cargar la librería para dar formato a la tabla
library(knitr)
# 1. FILTRAR Y LIMPIAR DATOS (Tu estructura base)
df_log <- data.frame(
X = database$`Unintentional Release (Barrels)`,
Y = database$`Liquid Recovery (Barrels)`
)
df_log <- na.omit(df_log)
df_log <- df_log[df_log$X > 0 & df_log$X < 5000, ]
df_log <- df_log[df_log$Y > 0, ]
# 2. LINEALIZACIÓN PARA MODELO LOGARÍTMICO
# Ecuación: Y = b0 + b1 * ln(X)
# Solo transformamos X. Y se queda en su estado original.
X_lineal <- log(df_log$X)
Y_original <- df_log$Y
# 3. TEST DE PEARSON (Sobre la relación linealizada)
pearson_val <- cor(X_lineal, Y_original, method = "pearson")
# 4. AJUSTE DEL MODELO LOGARÍTMICO
modelo_logaritmico <- lm(Y_original ~ X_lineal)
# 5. EXTRACCIÓN Y REDONDEO DE VALORES PARA LA TABLA
r_pearson <- round(pearson_val, 2)
r_cuadrado <- round(summary(modelo_logaritmico)$r.squared, 2)
param_b0 <- round(coef(modelo_logaritmico)[1], 4)
param_b1 <- round(coef(modelo_logaritmico)[2], 4)
# Formatear la ecuación de forma idéntica a la imagen
ecuacion_modelo <- paste0("Y = ", param_b0, " + ", param_b1, " * ln(X)")
# 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", "R2", "Parámetro b0", "Parámetro b1", "Ecuación"),
caption = "Tabla N°1 del Resumen del Modelo Logarítmico")| Variable | Tipo | R | R2 | Parámetro b0 | Parámetro b1 | Ecuación | |
|---|---|---|---|---|---|---|---|
| liberación involuntaria | Independiente (X) | ||||||
| (Intercept) | Recuperación de líquidos | Dependiente (Y) | 0.52 | 0.27 | -5.9272 | 51.466 | Y = -5.9272 + 51.466 * ln(X) |
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 variable independiente Volumen de Liberación Involuntaria (\(X\)) y la variable dependiente Recuperación de Líquidos (\(Y\)) existe una relación matemática validada mediante un modelo de regresión logarítmica. Este modelo describe un comportamiento operativo empírico: la capacidad de recuperación de líquidos aumenta de forma acelerada durante los derrames de menor magnitud, pero tiende a estabilizarse (mostrando rendimientos decrecientes) conforme el volumen del incidente se hace más grande, reflejando los límites físicos y logísticos de los equipos de contención.Esta relación se expresa matemáticamente mediante la siguiente fórmula:
Y = -5.9272 + 51.466 * ln(X)Este modelo está sujeto a las restricciones operativas de la base de datos, incluyendo únicamente valores de liberación mayores a cero y menores a 5,000 barriles. Finalmente, el modelo permite realizar estimaciones técnicas precisas; por ejemplo, para un escenario de 1,000 barriles liberados, se proyecta una recuperación de r round(param_b0 + param_b1 * log(1000), 2) barriles. Esta proyección confirma la validez y utilidad de la tendencia, respaldada por un coeficiente de correlación de Pearson de r round(pearson_val, 3) obtenido en la evaluación del ajuste.