setwd("D:/Data")
datos <- read.csv("Derrames_globales2.csv", header = TRUE, sep = ";", dec = ".")
x <- as.numeric(gsub(",", ".", gsub("\\.", "", datos$Maximo_liberacion_galones)))
y <- as.numeric(gsub(",", ".", gsub("\\.", "", datos$Respuesta_actual_galones)))
df <- na.omit(data.frame(x, y))
df$x <- scale(df$x)
df$y <- scale(df$y)
modelo <- lm(y ~ poly(x, 3, raw = TRUE), data = df)
summary(modelo)
##
## Call:
## lm(formula = y ~ poly(x, 3, raw = TRUE), data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.4292 -0.0061 -0.0061 -0.0054 3.4262
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -3.079e-02 4.770e-03 -6.455 1.49e-10 ***
## poly(x, 3, raw = TRUE)1 2.675e-01 1.904e-02 14.047 < 2e-16 ***
## poly(x, 3, raw = TRUE)2 4.767e-02 2.353e-03 20.257 < 2e-16 ***
## poly(x, 3, raw = TRUE)3 -6.923e-04 6.331e-05 -10.935 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.1747 on 1388 degrees of freedom
## Multiple R-squared: 0.9696, Adjusted R-squared: 0.9695
## F-statistic: 1.474e+04 on 3 and 1388 DF, p-value: < 2.2e-16
coef <- coef(modelo)
a <- coef[1]; b <- coef[2]; c <- coef[3]; d <- coef[4]
plot(df$x, df$y, col = 4, pch = 7,
main = "Regresión Polinómica: Liberación vs Respuesta",
xlab = "Máximo liberación (galones)",
ylab = "Respuesta actual (galones)")
curve(a + b*x + c*x^2 + d*x^3, add = TRUE, col = "red", lwd = 2)
Test de bondad de ajuste (R²)
r2_polinomica <- summary(modelo)$r.squared * 100
cat("\nCoeficiente de Determinación (R²) Polinómico:", round(r2_polinomica, 2), "%\n")
##
## Coeficiente de Determinación (R²) Polinómico: 96.96 %
cat("\nEcuación del modelo polinómico (grado 3):\n")
##
## Ecuación del modelo polinómico (grado 3):
cat("y =", format(a, scientific = TRUE, digits = 3),
"+", format(b, scientific = TRUE, digits = 3), "* x",
"+", format(c, scientific = TRUE, digits = 3), "* x^2",
"+", format(d, scientific = TRUE, digits = 3), "* x^3\n")
## y = -3.08e-02 + 2.67e-01 * x + 4.77e-02 * x^2 + -6.92e-04 * x^3
x_nueva <- 70
y_pred <- a + b*x_nueva + c*x_nueva^2 + d*x_nueva^3
cat("\nSi la liberación (x) es =", x_nueva,
"=> la respuesta estimada (y) es =", round(y_pred, 3), "\n")
##
## Si la liberación (x) es = 70 => la respuesta estimada (y) es = 14.851
El coeficiente de determinación (R^2) de” 96.96% indica que este modelo polinómico de tercer orden tiene una alta relacion entre las variables Maximo liberación en galones y Respuesta actual en galones Este modelo proporciona una forma de predecir una variable en funcion de otra
library(scatterplot3d)
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, union
library(readr)
y <- as.numeric(gsub(",", ".", gsub("\\.", "", datos$Volumen_derramados_galones)))
x1 <- as.numeric(gsub(",", ".", gsub("\\.", "", datos$Maximo_liberacion_galones)))
x2 <- as.numeric(gsub(",", ".", gsub("\\.", "", datos$Respuesta_actual_galones)))
datos_filtrados <- na.omit(data.frame(y, x1, x2))
RegresionMultiple <- lm(y ~ x1 + x2, data = datos_filtrados)
summary(RegresionMultiple)
##
## Call:
## lm(formula = y ~ x1 + x2, data = datos_filtrados)
##
## Residuals:
## Min 1Q Median 3Q Max
## -144022319 493869 512888 514274 305299683
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -5.147e+05 3.032e+05 -1.697 0.0899 .
## x1 1.485e+00 1.083e-01 13.714 <2e-16 ***
## x2 -5.487e-02 1.154e-01 -0.475 0.6346
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 10450000 on 1208 degrees of freedom
## Multiple R-squared: 0.7247, Adjusted R-squared: 0.7243
## F-statistic: 1590 on 2 and 1208 DF, p-value: < 2.2e-16
grafico <- scatterplot3d(x1, x2, y,
angle = 120,
main = "Plano de Regresión: Volumen Derramado vs Maximo
liberacion y Respuesta actual",
xlab = "Maximo liberacion (galones)",
ylab = "Respuesta actual (galones)",
zlab = "Volumen Derramado (galones)",
color = "blue", pch = 20)
grafico$plane3d(RegresionMultiple, col = "red")
a <- RegresionMultiple$coefficients[2]
b <- RegresionMultiple$coefficients[3]
c <- RegresionMultiple$coefficients[1]
cat(paste0("Volumen = ", round(c, 2), " + ", round(a, 4), "*Liberacion + ", round(b, 4), "*Respuesta\n"))
## Volumen = -514694.74 + 1.485*Liberacion + -0.0549*Respuesta
r1 <- sqrt(summary(RegresionMultiple)$r.squared)
r2 <- summary(RegresionMultiple)$r.squared
cat("Correlación múltiple (R):", round(r1, 4), "\n")
## Correlación múltiple (R): 0.8513
cat("Coeficiente de determinación (R²):", round(r2, 4), "\n")
## Coeficiente de determinación (R²): 0.7247
cat("R² en porcentaje:", round(r2 * 100, 2), "%\n")
## R² en porcentaje: 72.47 %
Ejemplo: ¿Cuál sería el volumen estimado si está entre un maximo liberacion de 500000 (galones) y una respuesta actual de 300000 (galones)?
x1_nueva <- 50000
x2_nueva <- 30000
y_pred <- a * x1_nueva + b * x2_nueva + c
cat("\nVolumen estimado del derrame:", round(y_pred, 2), "galones\n")
##
## Volumen estimado del derrame: -442088.8 galones