Modelo de Regresión Exponencial
CARGAR LIBRERÍAS Y DATOS
library(dplyr)##
## Adjuntando el paquete: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionsetwd("D:/Data")
datos <- read.csv("derrames_globales_.csv", header = TRUE, sep = ";", dec =".")1 Preparación de variables
# Asignación correcta de variables
x_global <- as.numeric(as.character(datos[, 17])) # X: Maximo_liberacion_galones
y_global <- as.numeric(as.character(datos[, 21])) # Y: Respuesta_actual_galones## Warning: NAs introducidos por coercióndatos_raw <- data.frame(x = x_global, y = y_global)
datos_clean <- na.omit(datos_raw)
# Filtro: Y debe ser > 0 para aplicar logaritmo en el modelo exponencial
datos_finales <- subset(datos_clean, y > 0)2 Gráfica 1: Relación entre Volumen Derramado y Máximo liberación
plot(datos_finales$x, datos_finales$y,
col = rgb(0, 0, 1, 0.5),
pch = 16, cex = 0.8,
main = "Relación entre Máximo Liberación y Respuesta Actual",
xlab = "Máximo Liberación (Galones)",
ylab = "Respuesta Actual (Galones)")
3 Conjetura de modelo exponencial
\[ Y = a \cdot e^{b \cdot X} \] \[ \ln(Y) = \ln(a) + b \cdot X \]
# Modelo linealizado: log(y) vs x
modelo_exp <- lm(log(y) ~ x, data = datos_finales)
# Cálculo de coeficientes
res <- summary(modelo_exp)
res##
## Call:
## lm(formula = log(y) ~ x, data = datos_finales)
##
## Residuals:
## Min 1Q Median 3Q Max
## -8.1721 -1.9531 -0.3299 1.7898 11.1831
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 8.162e+00 8.040e-02 101.520 < 2e-16 ***
## x 5.567e-08 7.436e-09 7.486 1.25e-13 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 3.005 on 1401 degrees of freedom
## Multiple R-squared: 0.03847, Adjusted R-squared: 0.03778
## F-statistic: 56.05 on 1 and 1401 DF, p-value: 1.246e-13# Recuperamos los parámetros originales
a_global <- exp(coef(modelo_exp)[1])
b_global <- coef(modelo_exp)[2]4 Gráfica 2: Relación entre Volumen Derramado y Máximo liberación (Modelo)
x_seq <- seq(min(datos_finales$x), max(datos_finales$x), length.out = 500)
y_pred <- a_global * exp(b_global * x_seq)
plot(datos_finales$x, datos_finales$y,
col = rgb(0, 0, 1, 0.5),
pch = 16, cex = 0.8,
main = "Relación entre Máximo Liberación y Respuesta Actual",
xlab = "Máximo Liberación (Galones)",
ylab = "Respuesta Actual (Galones)")
lines(x_seq, y_pred, col = "red", lwd = 2)
5 Test de Pearson
pearson_r <- cor(datos_finales$x, log(datos_finales$y), method = "pearson")
cat("=== RESULTADO TEST DE PEARSON (GLOBAL) ===\n")## === RESULTADO TEST DE PEARSON (GLOBAL) ===cat("Coeficiente (R):", round(pearson_r, 4), "\n")## Coeficiente (R): 0.1961if(abs(pearson_r) > 0.7) {
cat("INTERPRETACIÓN: Correlación Fuerte.\n")
} else if(abs(pearson_r) > 0.4) {
cat("INTERPRETACIÓN: Correlación Moderada.\n")
} else {
cat("INTERPRETACIÓN: Correlación Débil.\n")
}## INTERPRETACIÓN: Correlación Débil.6 Gráfica 3: Relación en el intervalo [0-14000000]
# Eliminamos el 2.5% más bajo y el 2.5% más alto para quitar ruido extremo
limites <- quantile(datos_clean$x, probs = c(0.025, 0.975))
datos_sin_outliers <- subset(datos_clean,
x > limites[1] &
x < limites[2] &
y > 0)
# Aplicación del Límite de Zoom (14 millones)
limite_volumen <- 14000000
datos_zoom <- subset(datos_sin_outliers, x <= limite_volumen)
# Generación del Modelo Optimizado
modelo_zoom <- lm(log(y) ~ x, data = datos_zoom)
a_zoom <- exp(coef(modelo_zoom)[1])
b_zoom <- coef(modelo_zoom)[2]
x_seq_zoom <- seq(0, max(datos_zoom$x), length.out = 500)
y_pred_zoom <- a_zoom * exp(b_zoom * x_seq_zoom)
plot(datos_zoom$x, datos_zoom$y,
col = rgb(0, 0.5, 0, 0.5), # Verde
pch = 16, cex = 0.8,
main = paste("Relación entre Máximo liberación y respuesta actual [0-14000000]"),
xlab = "Volumen Liberado (Galones)",
ylab = "Respuesta Actual (Galones)")
lines(x_seq_zoom, y_pred_zoom, col = "red", lwd = 3)
legend("topright", legend = "Modelo Intervalo", col = "red", lwd = 3, bty = "n")
Test de Pearson intervalo [0-14000000]
pearson_zoom <- cor(datos_zoom$x, log(datos_zoom$y), method = "pearson")
cat("=== COMPARACIÓN DE AJUSTE ===\n")## === COMPARACIÓN DE AJUSTE ===pearson_global <- cor(datos_finales$x, log(datos_finales$y), method = "pearson")
cat("Pearson Global:", round(pearson_global, 4), "\n")## Pearson Global: 0.1961cat("Pearson Intervalo:", round(pearson_zoom, 4), "\n\n")## Pearson Intervalo: 0.4984if(abs(pearson_zoom) > abs(pearson_global)) {
cat("CONCLUSIÓN: La limpieza de outliers y el intervalo MEJORAN el ajuste.\n")
}## CONCLUSIÓN: La limpieza de outliers y el intervalo MEJORAN el ajuste.7 Ecuación del modelo exponencial
\[Y = 2020.527 \cdot e^{5.519e-06 \cdot X}\]
cat("\n=== ECUACIÓN FINAL (OPTIMIZADA) ===\n")##
## === ECUACIÓN FINAL (OPTIMIZADA) ===# Usamos a_zoom y b_zoom que son los del modelo mejorado
cat(paste0("Respuesta = ", round(a_zoom, 4), " * e^(", format(b_zoom, scientific = TRUE, digits=4), " * Volumen)"), "\n")## Respuesta = 2020.527 * e^(5.519e-06 * Volumen)8 Estimación de un punto
nuevo_volumen <- 500000
log_prediccion <- predict(modelo_zoom, newdata = data.frame(x = nuevo_volumen))
prediccion <- exp(log_prediccion)
cat("\n=== PREDICCIÓN ===\n")##
## === PREDICCIÓN ===cat("Para un derrame de", nuevo_volumen, "galones:\n")## Para un derrame de 5e+05 galones:cat("Respuesta estimada:", round(prediccion, 2), "galones\n")## Respuesta estimada: 31902.44 galonesConclusiones Entre la variable independiente volumen liberado (X) y la variable dependiente máximo liberación (Y) se ha modelado una relación matemática de tipo regresión exponencial. Este modelo describe un comportamiento donde la tasa de cambio de la respuesta es proporcional a su valor actual. La relación se expresa mediante la fórmula \(Y = 2020.527 \cdot e^{5.519e-06 \cdot X}\), sujeta a las restricciones de incluir valores de respuesta positivos. El modelo permite realizar una estimación para un derrame de 500000 gal, se estima una recuperación de 31902.44