Modelo de Regresión Exponencial
1 CARGAR LIBRERÍAS Y DATOS
library(dplyr)## Warning: package 'dplyr' was built under R version 4.5.2##
## 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 =".")2 Preparación de variables
# Asignación de variables
x_global <- as.numeric(as.character(datos[, 20])) # X: Volumen Derramado_galones## Warning: NAs introducidos por coercióny_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 inicial: Y > 0 y X > 0 para poder aplicar logaritmos sin error
datos_finales <- subset(datos_clean, y > 0 & x > 0)3 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 Volumen Derramado y Respuesta Actual",
xlab = "Volumen Derramado (Galones)",
ylab = "Respuesta Actual (Galones)")
4 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
## -7.5743 -1.6394 -0.0079 1.4052 7.7416
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 7.574e+00 8.150e-02 92.940 < 2e-16 ***
## x 3.442e-05 4.344e-06 7.924 5.62e-15 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.55 on 1095 degrees of freedom
## Multiple R-squared: 0.05424, Adjusted R-squared: 0.05337
## F-statistic: 62.79 on 1 and 1095 DF, p-value: 5.617e-15# Recuperamos los parámetros originales
a_global <- exp(coef(modelo_exp)[1])
b_global <- coef(modelo_exp)[2]5 Gráfica 2: Relación entre Volumen Derramado y Máximo liberación (Modelo)
x_seq_global <- seq(min(datos_finales$x), max(datos_finales$x), length.out = 500)
y_pred_global <- a_global * exp(b_global * x_seq_global)
plot(datos_finales$x, datos_finales$y,
col = rgb(0, 0, 1, 0.5),
pch = 16, cex = 0.8,
main = "Relación entre Volumen Derramado y Respuesta Actual",
xlab = "Volumen Derramado (Galones)",
ylab = "Respuesta Actual (Galones)")
lines(x_seq_global, y_pred_global, col = "red", lwd = 2)
6 Test de Pearson
pearson_global <- 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_global, 4), "\n")## Coeficiente (R): 0.2329if(abs(pearson_global) > 0.7) {
cat("INTERPRETACIÓN: Correlación Fuerte.\n")
} else if(abs(pearson_global) > 0.4) {
cat("INTERPRETACIÓN: Correlación Moderada.\n")
} else {
cat("INTERPRETACIÓN: Correlación Débil.\n")
}## INTERPRETACIÓN: Correlación Débil.7 Relación en el intervalo [10100-15100]
# Filtramos directamente el intervalo óptimo
datos_zoom <- subset(datos_finales, x >= 10100 & x <= 15100)
# Calculamos el modelo para el intervalo
modelo_zoom <- lm(log(y) ~ x, data = datos_zoom)
# Recuperamos parámetros del modelo exponencial
a_zoom <- exp(coef(modelo_zoom)[1])
b_zoom <- coef(modelo_zoom)[2]8 Gráfica 3: Relación en el intervalo [10100-15100]
x_curve <- seq(min(datos_zoom$x), max(datos_zoom$x), length.out = 200)
y_curve <- a_zoom * exp(b_zoom * x_curve)
plot(datos_zoom$x, datos_zoom$y,
col = rgb(0, 0.5, 0, 0.6),
pch = 16, cex = 1.2,
main = "Relación Volumen vs Respuesta actual [10100 - 15100] gal",
xlab = "Volumen Derramado (Galones)",
ylab = "Respuesta Actual (Galones)")
# Dibujamos la curva roja
lines(x_curve, y_curve, col = "red", lwd = 3)
legend("topleft", legend = c("Datos Intervalo", "Curva Exponencial"),
col = c(rgb(0, 0.5, 0, 0.6), "red"), pch = c(16, NA), lty = c(NA, 1), lwd = c(NA, 3), bty="n")
9 Test de Pearson (intervalo)
pearson_zoom <- cor(datos_zoom$x, log(datos_zoom$y), method = "pearson")
cat("=== COMPARACIÓN DE AJUSTE (R) ===\n")## === COMPARACIÓN DE AJUSTE (R) ===cat("Pearson Global:", round(pearson_global, 4), "\n")## Pearson Global: 0.2329cat("Pearson Intervalo [10.1k - 15.1k]:", round(abs(pearson_zoom), 4), "\n\n")## Pearson Intervalo [10.1k - 15.1k]: 0.9489if(abs(pearson_zoom) > abs(pearson_global)) {
cat("CONCLUSIÓN: El ajuste MEJORA notablemente en este intervalo (R ≈ 0.9489).\n")
}## CONCLUSIÓN: El ajuste MEJORA notablemente en este intervalo (R ≈ 0.9489).10 Ecuación del modelo exponencial
\[Y = 4409.4801 \cdot e^{8.158e-05 \cdot X}\]
cat("\n=== ECUACIÓN FINAL (OPTIMIZADA) ===\n")##
## === ECUACIÓN FINAL (OPTIMIZADA) ===# Usamos a_zoom y b_zoom generados en el bloque anterior
cat(paste0("Respuesta = ", round(a_zoom, 4), " * e^(", format(b_zoom, scientific = TRUE, digits=4), " * Volumen)"), "\n")## Respuesta = 4409.4801 * e^(8.158e-05 * Volumen)11 Estimación de un punto
nuevo_volumen <- 13000
# Usamos el modelo optimizado
prediccion <- a_zoom * exp(b_zoom * nuevo_volumen)
cat("\n=== PREDICCIÓN ===\n")##
## === PREDICCIÓN ===cat("Para un derrame de", nuevo_volumen, "galones (dentro del intervalo):\n")## Para un derrame de 13000 galones (dentro del intervalo):cat("Respuesta estimada:", round(prediccion, 2), "galones\n")## Respuesta estimada: 12734.23 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 = 4409.4801 \cdot e^{8.158e-05 \cdot X}\), sujeta a las restricciones de incluir valores de respuesta positivos. El modelo permite realizar una estimación para un derrame de 13000 gal, se estima una recuperación de 12734.23 gal.