Modelo de Regresión Logarítmica
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
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)
Zoom de la curvatura [0-2000 gal]
# Configuración de límites
limite_zoom_x <- 2000
techo_linea <- predict(modelo_log, newdata = data.frame(x = limite_zoom_x))
limite_zoom_y <- techo_linea * 1.5
# Generar datos para la curva (desde 1)
x_seq_zoom <- seq(1, limite_zoom_x, length.out = 500)
y_pred_zoom <- predict(modelo_log, newdata = data.frame(x = x_seq_zoom))Gráfica 3: Zoom del modelo de regresión [0-2000gal]
plot(datos_finales$x, datos_finales$y,
xlim = c(0, limite_zoom_x),
ylim = c(0, limite_zoom_y),
col = rgb(0, 0, 1, 0.4),
pch = 19, cex = 1.5,
main = "Zoom a la Curvatura del Modelo (0 - 2000 gal)",
xlab = "Volumen Derramado (Galones)",
ylab = "Respuesta (Galones)")
grid(col = "gray", lty = "dotted")
lines(x_seq_zoom, y_pred_zoom, col = "red", lwd = 4)
legend("bottomright",
legend = c("Modelo Logarítmico"),
col = c("red"),
pch = c(19, NA),
lty = c(NA, 1),
lwd = c(NA, 4),
bg = "white")
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 [4000-25000]
datos_filtrados <- data.frame(x = x, y = y)
datos_filtrados <- na.omit(datos_filtrados)
# Filtro de Respuesta (Y) > 2100
datos_filtrados <- subset(datos_filtrados, y > 2100)
# Filtro de Volumen (X) entre 4000 y 25000
datos_intervalo <- subset(datos_filtrados, x >= 4000 & x <= 25000)
# 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
## -11984.2 -1587.1 -730.4 1015.8 20015.8
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -78479 2844 -27.59 <2e-16 ***
## log(x) 9793 315 31.09 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2693 on 231 degrees of freedom
## Multiple R-squared: 0.8071, Adjusted R-squared: 0.8063
## F-statistic: 966.7 on 1 and 231 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 4: Relación entre Volumen Derramado y Respuesta de Recuperación [4000-25000]
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), # Verde para diferenciar del global
pch = 16, cex = 1,
main = "Relación entre Volumen derramado y respuesta actual [4000 - 25000] gal)",
xlab = "Volumen Derramado (Galones)",
ylab = "Respuesta Actual (Galones)")
lines(x_seq_int, y_pred_int, col = "red", lwd = 3)
legend("bottomright", legend = "Modelo Intervalo", col = "red", lwd = 3, bty = "n")
volumen_prueba <- 15000
# Predicción con el modelo del intervalo
prediccion_int <- predict(modelo_intervalo, newdata = data.frame(x = volumen_prueba))
cat("Para un derrame de", volumen_prueba, "galones (dentro del intervalo):\n")## Para un derrame de 15000 galones (dentro del intervalo):cat("Respuesta estimada:", round(prediccion_int, 2), "galones\n")## Respuesta estimada: 15689.15 galones8 Test de Pearson (Intervalo)
# Calculamos Pearson solo para los datos filtrados (log(x) vs y)
pearson_int <- cor(log(datos_intervalo$x), datos_intervalo$y, method = "pearson")
cat("=== COMPARACIÓN DE AJUSTE (R) ===\n")## === COMPARACIÓN DE AJUSTE (R) ===# Asumimos que 'pearson_r' ya existe del bloque anterior global
cat("Global (Todos los datos):", round(pearson_r, 4), "\n") ## Global (Todos los datos): 0.0369cat("Intervalo (4k - 25k): ", round(pearson_int, 4), "\n\n")## Intervalo (4k - 25k): 0.8984if(abs(pearson_int) > abs(pearson_r)) {
cat("CONCLUSIÓN: El ajuste MEJORA notablemente en este intervalo.\n")
} else {
cat("CONCLUSIÓN: El ajuste es similar.\n")
}## CONCLUSIÓN: El ajuste MEJORA notablemente en este intervalo.9 Ecuación del modelo logarítmico
\[ Y = -78479 + 9793 \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 = -78478.5165 + 9793.0083 * ln(Volumen)10 Estimación de un punto
nuevo_volumen <- 40000
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 40000 galones:cat("Respuesta estimada:", round(prediccion, 2), "galones\n")## Respuesta estimada: 25294.42 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 = Y = -78479 + 9793 \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 40000 gal, se estima una recuperación de 25294.42.