1 Justificación de las dos variables

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).

2 Carga de Datos

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.

library(readr)
database <- read_delim("C:/Users/dougl/OneDrive/Escritorio/Proyecto Estadistica 2/database.csv",
                       delim = ";",
                       escape_double = TRUE,
                       trim_ws = TRUE)

3 Seleccionar dos variables

Se aíslan las columnas: “Unintentional Release (Barrels)” y “Liquid Recovery (Barrels)”

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(
  X = database[[col_liberacion]],   # Barriles Liberados
  Y = database[[col_recuperacion]]  # Barriles Recuperados
  )

3.1 Limpieza crítica

Eliminamos NAs y valores no positivos en X (el logaritmo requiere X > 0)

data_log <- na.omit(data_log)
data_log <- data_log[data_log$X > 0, ]

# (Opcional: filtrar valores atípicos extremos para mejorar el ajuste)
# Se conserva el 95% de los datos, eliminando el 5% superior de X
limite_outlier <- quantile(data_log$X, 0.95)
data_log <- data_log[data_log$X < limite_outlier, ]

4 Conteo de las dos variables

Tras limpiar la base de datos, el siguiente paso es verificar cuántas observaciones válidas quedaron disponibles. Confirmar la dimensión final de las variables (X,Y) nos asegura que la muestra es lo suficientemente sólida y confiable. Esto valida el análisis estadístico posterior, donde se modelará y graficará la relación entre el volumen de liberación no intencional(barriles) y la recuperación de líquido (barriles).

total_registros <- nrow(data_log)

cat("Total de incidentes válidos (pares X e Y) tras la limpieza:", total_registros, "\n")
## Total de incidentes válidos (pares X e Y) tras la limpieza: 2623
cat("Datos en la variable X (Barriles Liberados):", length(data_log$X), "\n")
## Datos en la variable X (Barriles Liberados): 2623
cat("Datos en la variable Y (Barriles Recuperados):", length(data_log$Y), "\n")
## Datos en la variable Y (Barriles Recuperados): 2623
summary(data_log)
##        X                Y         
##  Min.   :  0.01   Min.   :  0.00  
##  1st Qu.:  0.48   1st Qu.:  0.00  
##  Median :  2.00   Median :  0.71  
##  Mean   : 31.00   Mean   : 21.36  
##  3rd Qu.: 13.00   3rd Qu.:  6.00  
##  Max.   :595.00   Max.   :575.00

5 Tabla de valores

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.

#  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('X', 'Y'), 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"))
Estadísticos descriptivos
Liberacion Recuperacion
Mínimo Inf Inf
Máximo -Inf -Inf
Media NA NA

6 Gráficas

6.1 Gráfica de nube de puntos

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.

library(ggplot2)

ggplot(data_log, aes(x = X, y = Y)) +
  geom_point(color = "steelblue", alpha = 0.6) +
  labs(title = "Gráfica N° 1: Nube de Puntos",
       x = "Barriles Liberados", y = "Barriles Recuperados") +
  theme_minimal()

6.2 Conjetura del modelo

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.

Se conjetura un modelo logarítmico:

Y = b0 + b1 * log(X)

modelo_log <- lm(Y ~ log(X), data = data_log)

6.3 Gráfica de modelo

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).

x_seq <- seq(min(data_log$X), max(data_log$X), length.out = 500)
y_pred <- predict(modelo_log, newdata = data.frame(X = x_seq))
curva <- data.frame(X = x_seq, Y = y_pred)

ggplot(data_log, aes(x = X, y = Y)) +
  geom_point(color = "gray50", alpha = 0.6) +
  geom_line(data = curva, aes(x = X, y = Y), color = "darkgreen", size = 1.2) +
  labs(title = "Gráfica N° 2: Relación entre Volumen de Liberación y Recuperación",
       x = "Barriles Liberados", y = "Barriles Recuperados") +
  theme_minimal()

7 Test de Pearson

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

pearson_val <- cor(log(data_log$X), data_log$Y)
r2_val <- summary(modelo_log)$r.squared

7.1 Test de pearson sin outliers

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$X, 0.95)
data_sin_outliers <- subset(data_log, X < limite_outlier)

if (nrow(data_sin_outliers) > 2) {
  cor_sin_outliers <- cor.test(log(data_sin_outliers$X), data_sin_outliers$Y)
  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.604 
## p-valor: 4.664562e-247

7.2 Coeficiente correlación Pearson

cat("Coeficiente de Pearson (r):", round(pearson_val, 4), "\n")
## Coeficiente de Pearson (r): 0.5701

7.3 Coeficiente de determinación

cat("Coeficiente de Determinación (R²):", round(r2_val, 4), "\n")
## Coeficiente de Determinación (R²): 0.325

Parámetros del modelo

b0 <- coef(modelo_log)[1]  # Intercepto
b1 <- coef(modelo_log)[2]  # Pendiente logarítmica
cat("Parámetro b0 (Intersección):", round(b0, 4), "\n")
## Parámetro b0 (Intersección): 4.9537
cat("Parámetro b1 (Pendiente logarítmica):", round(b1, 4), "\n")
## Parámetro b1 (Pendiente logarítmica): 16.7416
cat("\nLa ecuación del modelo logarítmico es: Y =", round(b0, 4), "+", round(b1, 4), "* ln(X)\n")
## 
## La ecuación del modelo logarítmico es: Y = 4.9537 + 16.7416 * ln(X)

Tabla resumen del modelo

library(knitr)
tabla_resumen <- data.frame(
  Variable = c("Barriles Liberados", "Barriles Recuperados"),
  Tipo = c("Independiente (X)", "Dependiente (Y)"),
  R = c("", round(pearson_val, 2)),
  R2 = c("", round(r2_val, 2)),
  Parametro_b0 = c("", round(b0, 4)),
  Parametro_b1 = c("", round(b1, 4)),
  Ecuacion = c("", paste0("Y = ", round(b0, 4), " + ", round(b1, 4), " * ln(X)"))
)
colnames(tabla_resumen) <- c("Variable", "Tipo", "R", "R2", "Parámetro b0", "Parámetro b1", "Ecuación")
kable(tabla_resumen, caption = "Tabla N°1 del Resumen del Modelo Logarítmico", align = "c")
Tabla N°1 del Resumen del Modelo Logarítmico
Variable Tipo R R2 Parámetro b0 Parámetro b1 Ecuación
Barriles Liberados Independiente (X)
(Intercept) Barriles Recuperados Dependiente (Y) 0.57 0.32 4.9537 16.7416 Y = 4.9537 + 16.7416 * ln(X)

8 Estimación

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(X = 1000))
cat("Para 1000 bbl liberados, se estima recuperar:", round(pred_1000, 2), "bbl\n")
## Para 1000 bbl liberados, se estima recuperar: 120.6 bbl

9 Conclución

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.