Polinómico.R

#------------------ UNIVERSIDAD CENTRAL DEL ECUADOR
##-----Facultad de Ingeniería en Geología, Minas, Petróleo y Ambiental 
###-----------------Carrera de Ingeniería Ambiental

# Proyecto: Estudio de Residuos y Reciclaje en la India
# Etapa: Estadística Inferencial
# Integrantes: Jazmin Guañuna, Nayely Perugachi, Helen Taipe, Gabriela Usiña
# Fecha: 12/7/2025

library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

datos <- read.csv("Residuos (1).csv",header = TRUE, sep = ";", dec = ".")


# Filtrar datos del año 2023
datos_2023 <- datos %>% 
  filter(Year == 2023)

# 1. Selección de 2 variables 
# Calcular promedios por ciudad
promedios_ciudad <- datos_2023 %>%
  group_by(City.District) %>%
  summarise(
    x = mean(Population.Density..People.km.., na.rm = TRUE),
    y = mean(Recycling.Rate...., na.rm = TRUE)
  )

# 4. Gráfica
plot(promedios_ciudad$x, promedios_ciudad$y,
     main = "Gráfica No.131: Diagrama de Dispersión entre Densidad Poblacional y 
     Tasa de Reciclaje en el 2023",
     ylab = "Tasa de reciclaje (%)",
     pch = 19, col = "darkgreen")

subset_5000 <- promedios_ciudad %>% 
  filter(x <= 5500)

# 6. Cálculo de parámetros
regresionPolinomica <- lm(y ~ poly(x, 2, raw = TRUE), data = subset_5000)
regresionPolinomica

## 
## Call:
## lm(formula = y ~ poly(x, 2, raw = TRUE), data = subset_5000)
## 
## Coefficients:
##             (Intercept)  poly(x, 2, raw = TRUE)1  poly(x, 2, raw = TRUE)2  
##               6.267e+01                3.621e-04               -3.809e-07

summary(regresionPolinomica)

## 
## Call:
## lm(formula = y ~ poly(x, 2, raw = TRUE), data = subset_5000)
## 
## Residuals:
##       1       2       3       4       5 
## -0.3886  0.7645  2.3333  0.3575 -3.0667 
## 
## Coefficients:
##                           Estimate Std. Error t value Pr(>|t|)
## (Intercept)              6.267e+01  3.051e+01   2.054    0.176
## poly(x, 2, raw = TRUE)1  3.621e-04  1.823e-02   0.020    0.986
## poly(x, 2, raw = TRUE)2 -3.809e-07  2.585e-06  -0.147    0.896
## 
## Residual standard error: 2.803 on 2 degrees of freedom
## Multiple R-squared:  0.5491, Adjusted R-squared:  0.09825 
## F-statistic: 1.218 on 2 and 2 DF,  p-value: 0.4509

a <- regresionPolinomica$coefficients[1]
b <- regresionPolinomica$coefficients[2]
c <- regresionPolinomica$coefficients[3]
# Ecuación
cat("Modelo polinómico: y =", round(a, 3), "+", b, "* x", "+",c, "* x^2")

## Modelo polinómico: y = 62.674 + 0.0003620521 * x + -3.808613e-07 * x^2

plot(subset_5000$x, subset_5000$y,
     main = "Gráfica No.132: Dispersión de Pares de Puntos en el Intervalo 
     Definido entre Densidad Poblacional y Tasa de Reciclaje",
     xlab = "Densidad poblacional (hab/km²)",
     ylab = "Tasa de reciclaje (%)",
     pch = 19, col = "darkgreen", ylim = c(50, 68), xlim =c(2000,5000))

# 7. Graficar la curva
plot(subset_5000$x, subset_5000$y,
     main = "Gráfica No.133: Modelo y Realidad en el Intervalo Definido entre 
     Densidad Poblacional y Tasa de Reciclaje",
     xlab = "Densidad poblacional (hab/km²)",
     ylab = "Tasa de reciclaje (%)",
     pch = 19, col = "darkgreen", ylim = c(50, 68), xlim =c(2000,5000))
curve(a+(b*x)+(c*x^2), add = T, col="red")

# 8. Tests - Pearson
r <- cor(subset_5000$x, subset_5000$y, method = "pearson", use = "complete.obs")
cat("Coeficiente de correlación de Pearson:", round(r, 4), "\n")

## Coeficiente de correlación de Pearson: -0.7377

# 10. Restricciones- Cálculo de raices
# x=(-b ± sqrt(b^2 - 4*a*c))/2*a
x1=(-b + sqrt(b^2 - 4*a*c))/2*a
x1

## poly(x, 2, raw = TRUE)1 
##               0.2950685

x2=(-b - sqrt(b^2 - 4*a*c))/2*a
x2

## poly(x, 2, raw = TRUE)1 
##              -0.3177597

cat("Las restricciones son:",x1,"y",x2)

## Las restricciones son: 0.2950685 y -0.3177597

# Pero no aplica ya que uno es un valor fuera del dominio y el otro esta fuera 
# del intervalo de 2000 a 5000

# 11. Estimaciones 
yEst <- 62.674 + 3.621e-04 * (10000) - 3.809e-07*(10000)^2
yEst

## [1] 28.205

# 12. Conclusión
# "En el intervalo entre la densidad poblacional y la tasa de reciclaje de la 
# India existe una relación de tipo polinomica, representado por:

#       ŷ = 62.674 + 3.621e-04 * x - 3.809e-07 * x^2

# Siendo x la densidad poblacional en personas por km^2 y ŷ la tasa de reciclje 
# en porcentaje. 
# Dentro del intervalo seleccionado no existen restricciones.
# Se espera que, cuando se tengan 1000 toneladas/día se obtenga una tasa de 
# reciclaje de 28.21 %.")