Modelo de Regresión lineal
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
# Asignamos variables según el análisis requerido
x_raw <- as.numeric(as.character(datos$Respuesta_actual_galones)) # X## Warning: NAs introducidos por coercióny_raw <- as.numeric(as.character(datos$Maximo_liberacion_galones)) # Y
datos_raw <- data.frame(x = x_raw, y = y_raw)
datos_clean <- na.omit(datos_raw)
# Filtro global
datos_global <- subset(datos_clean, x > 0 & y > 0)2 Gráfica 1: Relación entre Respuesta actual y Máxima Liberación
plot(datos_global$x, datos_global$y,
col = rgb(0, 0.75, 1, 0.5), pch = 16, cex = 0.8,
main = "Relación Respuesta Actual vs Máxima Liberación (Global)",
xlab = "Respuesta Actual (Galones)",
ylab = "Máxima Liberación (Galones)")
3 Conjetura de modelo lineal
\[ Y = \beta_0 + \beta_1 X \]
# Modelo global
modelo_global <- lm(y ~ x, data = datos_global)
# Resumen estadístico
res_global <- summary(modelo_global)
res_global##
## Call:
## lm(formula = y ~ x, data = datos_global)
##
## Residuals:
## Min 1Q Median 3Q Max
## -22753396 -55313 -54627 -54567 30654398
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.456e+04 5.066e+04 1.077 0.282
## x 1.037e+00 4.333e-03 239.450 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1671000 on 1091 degrees of freedom
## Multiple R-squared: 0.9813, Adjusted R-squared: 0.9813
## F-statistic: 5.734e+04 on 1 and 1091 DF, p-value: < 2.2e-16# Extracción de Coeficientes (Globales)
coef_global <- coef(modelo_global)
a_global <- coef_global[1] # Intercepto (beta 0)
b_global <- coef_global[2] # Pendiente (beta 1)4 Gráfica 2: Relación entre Respuesta actual y Máxima Liberación (Modelo)
plot(datos_global$x, datos_global$y,
col = rgb(0, 0.75, 1, 0.5), pch = 16, cex = 0.8,
main = "Modelo de Regresión Lineal (Global)",
xlab = "Respuesta Actual (Galones)",
ylab = "Máxima Liberación (Galones)")
abline(modelo_global, col = "red", lwd = 2)
5 Test de Pearson
pearson_global <- cor(datos_global$x, datos_global$y, method = "pearson")
r2_global <- pearson_global^2
cat("=== RESULTADO GLOBAL ===\n")## === RESULTADO GLOBAL ===cat("Pearson (R):", round(pearson_global, 4), "\n")## Pearson (R): 0.9906cat("Determinación (R²):", round(r2_global * 100, 2), "%\n")## Determinación (R²): 98.13 %6 Relación en el intervalo [0 - 4000]
# 1. Filtramos por el rango definido
datos_rango <- subset(datos_global, x <= 4000 & y <= 4000)
# 2. Aplicamos la limpieza de duplicados (Evita sobreajuste)
datos_unicos <- datos_rango[!duplicated(datos_rango), ]
datos_int <- datos_unicos[!duplicated(datos_unicos$x) & !duplicated(datos_unicos$y), ]
# 3. Generamos el modelo para el intervalo
modelo_int <- lm(y ~ x, data = datos_int)
summary(modelo_int)##
## Call:
## lm(formula = y ~ x, data = datos_int)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1621.08 -41.67 -27.24 12.60 2155.39
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 45.28181 55.78067 0.812 0.419
## x 0.95489 0.03808 25.073 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 370.6 on 79 degrees of freedom
## Multiple R-squared: 0.8884, Adjusted R-squared: 0.887
## F-statistic: 628.7 on 1 and 79 DF, p-value: < 2.2e-16# Extracción de Coeficientes del intervalo
a_int <- coef(modelo_int)[1] # Intercepto (beta 0)
b_int <- coef(modelo_int)[2] # Pendiente (beta 1)7 Gráfica 3: Relación entre Respuesta Actual y Máxima Liberación (intervalo)
plot(datos_int$x, datos_int$y,
col = rgb(0, 191, 255, 120, maxColorValue = 255), pch = 19, cex = 1.2,
main = "Modelo Lineal [0 - 4000] gal",
xlab = "Respuesta Actual (Galones)",
ylab = "Máxima Liberación (Galones)")
abline(modelo_int, col = "darkgreen", lwd = 3)
legend("topleft", legend = c("Datos Limpios", "Recta Regresión"),
col = c("deepskyblue3", "darkgreen"), pch = c(19, NA), lty = c(NA, 1), lwd = c(NA, 3), bty = "n")
8 Test de Pearson (Intervalo)
pearson_int <- cor(datos_int$x, datos_int$y, method = "pearson")
r2_int <- pearson_int^2
cat("=== COMPARACIÓN DE AJUSTE ===\n")## === COMPARACIÓN DE AJUSTE ===cat("R² Global:", round(r2_global * 100, 2), "%\n")## R² Global: 98.13 %cat("R² Intervalo [0-4000]:", round(r2_int * 100, 2), "%\n\n")## R² Intervalo [0-4000]: 88.84 %if(r2_int > r2_global) {
cat("CONCLUSIÓN: El ajuste MEJORA notablemente aislando el intervalo y limpiando duplicados.\n")
cat("El modelo explica el", round(r2_int * 100, 2), "% de la variabilidad en este rango.\n")
}9 Ecuación del modelo lineal
\[ Y = 45.2818 + 0.9549 X \]
cat("\n=== ECUACIÓN FINAL (INTERVALO) ===\n")##
## === ECUACIÓN FINAL (INTERVALO) ===cat("Y =", round(a_int, 4), "+", round(b_int, 4), "* X\n")## Y = 45.2818 + 0.9549 * X10 Estimación de un punto
x_nueva <- 2500
y_pred_estimada <- a_int + b_int * x_nueva
cat("\n=== PREDICCIÓN ===\n")##
## === PREDICCIÓN ===cat("Para una respuesta actual de", x_nueva, "galones:\n")## Para una respuesta actual de 2500 galones:cat("La máxima liberación estimada es =", round(y_pred_estimada, 2), "galones\n")## La máxima liberación estimada es = 2432.51 galonesConclusiones
Entre la variable independiente respuesta actual (X) y la variable máxima liberación dependiente (Y) existe una relación matemática de tipo regresión lineal simple, la cual indica un comportamiento directamente proporcional entre el la respuesta y la máxima liberación. Esta relación se expresa mediante la fórmula del modelo: \(Y = 45.2818 + 0.9549 X\) . El modelo permite realizar una estimación para una respuesta de 2500 galones, se estima una máxima liberación de 2432.51 galones.