Modelo de Regresión Logarítmica
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 =".")1 Preparación de variables
x <- as.numeric(as.character(datos[, 20])) # Volumen## Warning: NAs introducidos por coercióny <- as.numeric(as.character(datos[, 21])) # Respuesta## Warning: NAs introducidos por coercióndatos_raw <- data.frame(x = x, y = y)
datos_clean <- na.omit(datos_raw)
# Datos>0
datos_finales <- subset(datos_clean, x > 0)2 Gráfica 1: Relación entre Volumen Derramado y Respuesta de Recuperación
plot(datos_finales$x, datos_finales$y,
col = rgb(0, 0, 1, 0.5), # Azul con transparencia para ver densidad
pch = 16, cex = 0.8,
main = "Relación entre Volumen Derramado y Respuesta de Recuperación",
xlab = "Volumen Derramado (Galones)",
ylab = "Respuesta Actual (Galones)")
3 Conjetura de modelo logarítmico
\[ Y = a + b \cdot \ln(X) \]
modelo_log <- lm(y ~ log(x), data = datos_finales)
# Coeficientes
res <- summary(modelo_log)
res##
## Call:
## lm(formula = y ~ log(x), data = datos_finales)
##
## Residuals:
## Min 1Q Median 3Q Max
## -46481 -35359 -33214 -19920 4466540
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 28733.3 5578.8 5.150 2.9e-07 ***
## log(x) 1011.3 668.6 1.513 0.131
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 193000 on 1682 degrees of freedom
## Multiple R-squared: 0.001358, Adjusted R-squared: 0.0007646
## F-statistic: 2.288 on 1 and 1682 DF, p-value: 0.1306a <- coef(modelo_log)[1] # Intercepto
b <- coef(modelo_log)[2] # Pendiente4 Gráfica 2: Relación entre Volumen Derramado y Respuesta de Recuperación (Modelo)
x_seq <- seq(min(datos_finales$x), max(datos_finales$x), length.out = 500)
y_pred <- a + b * log(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 Volumen Derramado y Respuesta de Recuperación",
xlab = "Volumen Derramado (Galones)",
ylab = "Respuesta Actual (Galones)")
# Línea de regresión
lines(x_seq, y_pred, col = "red", lwd = 2)
5 Test de Pearson
# Calculamos la correlación entre log(x) y y
pearson_r <- cor(log(datos_finales$x), datos_finales$y, method = "pearson")
# Imprimimos el resultado en consola
cat("=== RESULTADO TEST DE PEARSON ===\n")## === RESULTADO TEST DE PEARSON ===cat("Coeficiente de Pearson (R):", round(pearson_r, 4), "\n")## Coeficiente de Pearson (R): 0.03696 Relación en el intervalo [9100-14100]
datos_filtrados <- data.frame(x = x, y = y)
datos_filtrados <- na.omit(datos_filtrados)
# Filtro estricto para valores mayores a cero (vital para el logaritmo)
datos_filtrados <- subset(datos_filtrados, y > 0 & x > 0)
# Filtro de Volumen (X) en el nuevo intervalo óptimo
datos_intervalo <- subset(datos_filtrados, x >= 9100 & x <= 14100)
# Modelo Logarítmico para el intervalo: Y = a + b * ln(X)
modelo_intervalo <- lm(y ~ log(x), data = datos_intervalo)
summary(modelo_intervalo)##
## Call:
## lm(formula = y ~ log(x), data = datos_intervalo)
##
## Residuals:
## Min 1Q Median 3Q Max
## -973.05 5.05 61.96 146.33 552.74
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -98317.4 3676.9 -26.74 <2e-16 ***
## log(x) 11744.5 393.2 29.87 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 294.8 on 38 degrees of freedom
## Multiple R-squared: 0.9591, Adjusted R-squared: 0.9581
## F-statistic: 892.1 on 1 and 38 DF, p-value: < 2.2e-16# Coeficientes del nuevo modelo
a_int <- coef(modelo_intervalo)[1]
b_int <- coef(modelo_intervalo)[2]7 Gráfica 3: Relación entre Volumen Derramado y Respuesta de Recuperación [9100-14100]
x_seq_int <- seq(min(datos_intervalo$x), max(datos_intervalo$x), length.out = 500)
y_pred_int <- a_int + b_int * log(x_seq_int)
plot(datos_intervalo$x, datos_intervalo$y,
col = rgb(0, 0.5, 0, 0.6),
pch = 16, cex = 1.2,
main = "Relación Volumen vs Respuesta actual [9100 - 14100] gal",
xlab = "Volumen Derramado (Galones)",
ylab = "Respuesta Actual (Galones)")
lines(x_seq_int, y_pred_int, col = "red", lwd = 3)
legend("bottomright", legend = "Modelo Logarítmico", col = "red", lwd = 3, bty = "n")
# Predicción dentro de la ventana de confiabilidad
volumen_prueba <- 12000
prediccion_int <- predict(modelo_intervalo, newdata = data.frame(x = volumen_prueba))
cat("=== PREDICCIÓN ===\n")## === PREDICCIÓN ===cat("Para un derrame de", volumen_prueba, "galones (dentro del intervalo):\n")## Para un derrame de 12000 galones (dentro del intervalo):cat("Respuesta estimada:", round(prediccion_int, 2), "galones\n")## Respuesta estimada: 11994.95 galones8 Test de Pearson
# Calculamos Pearson
pearson_int <- cor(log(datos_intervalo$x), datos_intervalo$y, method = "pearson")
cat("=== COMPARACIÓN DE AJUSTE (R) ===\n")## === COMPARACIÓN DE AJUSTE (R) ===cat("Global (Todos los datos):", round(pearson_r, 4), "\n") ## Global (Todos los datos): 0.0369cat("Intervalo (9.1k - 14.1k):", round(pearson_int, 4), "\n\n")## Intervalo (9.1k - 14.1k): 0.9794if(abs(pearson_int) > abs(pearson_r)) {
cat("CONCLUSIÓN: El ajuste MEJORA drásticamente en este intervalo (R ≈ 0.9794).\n\n")
}## CONCLUSIÓN: El ajuste MEJORA drásticamente en este intervalo (R ≈ 0.9794).9 Ecuación del modelo logarítmico
\[ Y = -98317.4287 + 11744.5281 \cdot \ln(X) \]
cat("\n=== ECUACIÓN FINAL ===\n")##
## === ECUACIÓN FINAL ===cat(paste0("Respuesta = ", round(a_int, 4), " + ", round(b_int, 4), " * ln(Volumen)"), "\n")## Respuesta = -98317.4287 + 11744.5281 * ln(Volumen)10 Estimación de un punto
nuevo_volumen <- 45000
prediccion <- predict(modelo_intervalo, newdata = data.frame(x = nuevo_volumen))
cat("\n=== PREDICCIÓN ===\n")##
## === PREDICCIÓN ===cat("Para un derrame de", nuevo_volumen, "galones:\n")## Para un derrame de 45000 galones:cat("Respuesta estimada:", round(prediccion, 2), "galones\n")## Respuesta estimada: 27518.35 galonesConclusiones
Entre la variable independiente volumen derramado (X ) y la variable dependiente respuesta actual (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 = -98317.4287 + 11744.5281 \cdot \ln(X)\) , sujeta a las restricciones de incluir únicamente valores de volumen mayores a cero. El modelo permite realizar una estimación para un derrame de 45000 gal, se estima una recuperación de 27518.35.