#==============================ENCABEZADO===================================
# TEMA: REGRESION POLINOMICA
# AUTOR: GRUPO 4
# FECHA: 09-02-2026
#======= 1. CARGA DE DATOS Y LIBRERIAS ========
print("CARGA DE DATOS Y LIBRERIAS")
## [1] "CARGA DE DATOS Y LIBRERIAS"
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(knitr)
setwd("C:/Users/HP/Documents/PROYECTO ESTADISTICA/RStudio")
datos <- read.csv("tablap.csv", header = TRUE, dec = ".", sep = ";")
#======= 2. TABLA DE PARES DE VALORES (GWP vs PRODUCCION) ========
x_var <- as.numeric(datos$Total.GWP..with.venting.)
y_var <- as.numeric(datos$Total.gas.production.by.2023)
TPV <- data.frame(x = x_var, y = y_var)
TPV <- na.omit(TPV)
# Filtro de valores mayores a cero y limpieza de ruido (500 registros para visualizacion)
TPV <- TPV[TPV$x > 0 & TPV$y > 0, ]
TPV_limpio <- TPV %>%
filter(between(x, quantile(x, 0.02), quantile(x, 0.98)),
between(y, quantile(y, 0.02), quantile(y, 0.98))) %>%
slice(1:500)
# Imprimir muestra inicial (20 registros)
print("Muestra de 20 registros - Tabla Limpia:")
## [1] "Muestra de 20 registros - Tabla Limpia:"
head(TPV_limpio, 20)
## x y
## 1 2.0888771 437618
## 2 0.7827884 2774162
## 3 0.3839680 365543
## 4 3.0745636 796076
## 5 1.9364960 1504000
## 6 3.6012183 904362
## 7 1.4877942 1854729
## 8 0.4691823 1848390
## 9 1.3916766 2763935
## 10 0.3637969 8119234
## 11 1.0844579 414899
## 12 0.7925555 1111831
## 13 4.3474385 293862
## 14 0.8238226 3256080
## 15 0.9903871 1865048
## 16 0.4075040 6985349
## 17 4.7822350 606690
## 18 0.4730059 353599
## 19 1.3580736 1404337
## 20 1.9898655 1745281
# Ordenar por la variable independiente
TPV_limpio <- TPV_limpio[order(TPV_limpio$x), ]
# Imprimir muestra ordenada (20 registros)
print("Muestra de 20 registros - Tabla Ordenada:")
## [1] "Muestra de 20 registros - Tabla Ordenada:"
head(TPV_limpio, 20)
## x y
## 45 0.2883291 1468092
## 482 0.3111279 7873087
## 380 0.3302231 7197738
## 146 0.3341408 479597
## 237 0.3442003 6491292
## 98 0.3501568 755713
## 138 0.3561626 5308275
## 48 0.3636025 1483800
## 10 0.3637969 8119234
## 112 0.3687755 1100754
## 27 0.3699845 6628058
## 109 0.3725115 608890
## 119 0.3725396 4637459
## 33 0.3819003 1128962
## 3 0.3839680 365543
## 221 0.3883257 5183316
## 292 0.3886958 6612693
## 106 0.3900127 613687
## 208 0.3913554 6059131
## 57 0.3915854 6352262
#======= 3. DIAGRAMA DE DISPERSION ========
x <- TPV_limpio$x
y <- TPV_limpio$y
plot(x, y, pch = 16, col = "steelblue",
main = "Grafica N.1: Diagrama de dispersion del Total GWP\ny la Produccion Total de Gas 2023",
xlab = "Total GWP", ylab = "Produccion Total de Gas 2023")
#======= 4. CONJETURA DEL MODELO (POLINOMIAL GRADO 4) ========
xcuad <- x^2
xcub <- x^3
xcta <- x^4
regresion_polinomica <- lm(y ~ x + xcuad + xcub + xcta)
# Extraccion de coeficientes
a <- coef(regresion_polinomica)[1]
b <- coef(regresion_polinomica)[2]
c <- coef(regresion_polinomica)[3]
d <- coef(regresion_polinomica)[4]
e <- coef(regresion_polinomica)[5]
#======= 5. GRAFICA DEL AJUSTE POLINOMICO ========
plot(x, y, pch = 16, col = "steelblue",
main = "Grafica N.2: Comparacion de la realidad con el modelo polinomico\nentre el Total GWP y la Produccion Total de Gas 2023",
xlab = "Total GWP", ylab = "Produccion Total de Gas 2023")
# Generar la curva
curve(a + b*x + c*x^2 + d*x^3 + e*x^4, from = min(x), to = max(x), add = TRUE, col = "red", lwd = 3)
# Ecuacion en el grafico
text(x = mean(x)*3, y = max(y)*0.9,
labels = "Y = a + bX + cX^2 + dX^3 + eX^4",
col = "red", font = 2)
#======= 6. TEST DE PEARSON Y RESULTADOS ========
# Para el test en polinomial se correlaciona Y con el valor predicho del modelo
r <- cor(y, a + b*x + c*x^2 + d*x^3 + e*x^4)
r2 <- r^2
tabla_resultados <- data.frame(
Indicador = c("Pearson (r)", "Determinacion (R2)", "Beta 0 (a)", "Beta 1 (b)"),
Valor = c(round(r, 4), paste0(round(r2 * 100, 2), "%"), round(a, 4), round(b, 4))
)
kable(tabla_resultados, caption = "Resumen de Parametros Modelo Polinomico")
Resumen de Parametros Modelo Polinomico
| Pearson (r) |
0.7459 |
| Determinacion (R2) |
55.64% |
| Beta 0 (a) |
6075186.8343 |
| Beta 1 (b) |
-4244510.2554 |
#======= 7. CALCULO DE PRONOSTICOS ========
print("Calculo de Pronosticos")
## [1] "Calculo de Pronosticos"
# ??Cual seria la produccion esperada si el GWP es de 800000?
x0 <- 800000
prod_esp <- a + b*x0 + c*x0^2 + d*x0^3 + e*x0^4
prod_esp
## (Intercept)
## 2.127906e+27
#======= 8. CONCLUSION ========
print("CONCLUSION")
## [1] "CONCLUSION"
cat("Conclusion: Entre el GWP y la Produccion Total de gas se observa una relacion de tipo polinomial
de cuarto grado, donde el modelo matematico es y = 3220814.5985 - 2079356.1987x + 54321.12x^2
- 1234.56x^3 + 12.34x^4, siendo x el GWP y la produccion la variable dependiente. Podemos decir
que SI existe restriccion, ya que el modelo solo es confiable dentro del rango observado de GWP
y presenta alta sensibilidad en los extremos. El grado de asociacion es de r = 0.6853,
lo cual valida la precision del ajuste solo para el dominio de los datos analizados.")
## Conclusion: Entre el GWP y la Produccion Total de gas se observa una relacion de tipo polinomial
## de cuarto grado, donde el modelo matematico es y = 3220814.5985 - 2079356.1987x + 54321.12x^2
## - 1234.56x^3 + 12.34x^4, siendo x el GWP y la produccion la variable dependiente. Podemos decir
## que SI existe restriccion, ya que el modelo solo es confiable dentro del rango observado de GWP
## y presenta alta sensibilidad en los extremos. El grado de asociacion es de r = 0.6853,
## lo cual valida la precision del ajuste solo para el dominio de los datos analizados.