Modelo Polinómico
Universidad Central del Ecuador
2026-06-17
1.Librerías
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, unionlibrary(gt)
library(htmltools)2.Leer datos
# -------------------------
# Cargar datos
# -------------------------
datos <- read.csv("waterPollution.csv",
sep = ",",
stringsAsFactors = FALSE)3. Selección (causa y efecto)
# ================================
# SELECCIÓN Y SEPARACIÓN
# ================================
# Justificación de las variables:
# Se seleccionaron estas variables para analizar cómo influye la presencia de residuos verdes (X) en la reducción de contaminantes plásticos (Y) en cuerpos de agua. Evaluando una posible relación polinómica.
datos_modelo <- datos %>%
select(
composition_yard_garden_green_waste_percent,
composition_plastic_percent
) %>%
na.omit() %>%
filter(
composition_yard_garden_green_waste_percent > 0,
composition_plastic_percent > 0
)
# Variable independiente
x <- datos_modelo$composition_yard_garden_green_waste_percent
# Variable dependiente
y <- datos_modelo$composition_plastic_percent4. Tabla de pares de valores
4.1 Tamaño muestral
# 1. Cálculo del tamaño muestral de cada variable
n_x <- length(x)
n_y <- length(y)
# 2. Imprimir los tamaños muestrales
cat("Tamaño muestral de X (Residuos Verdes):", n_x, "observaciones.\n")## Tamaño muestral de X (Residuos Verdes): 5047 observaciones.cat("Tamaño muestral de Y (Plástico):", n_y, "observaciones.\n\n")## Tamaño muestral de Y (Plástico): 5047 observaciones.4.2 Extracto de las variables
# ================================
# TABLA DE PARES DE VALORES
# ================================
tabla_resumen <- data.frame(
Observacion = 1:nrow(datos_modelo),
Residuos_Verdes = datos_modelo$composition_yard_garden_green_waste_percent,
Plastico = datos_modelo$composition_plastic_percent
)
tabla_gt <- gt(tabla_resumen) %>%
tab_header(
title = "Tabla 1. Extracto de pares de valores observados de residuos verdes y plástico"
) %>%
fmt_number(
columns = c(Residuos_Verdes, Plastico),
decimals = 2
) %>%
cols_label(
Observacion = "Observación",
Residuos_Verdes = "(X) Residuos Verdes (%)",
Plastico = "(Y) Plástico (%)"
) %>%
cols_align(
align = "center",
columns = everything()
)
browsable(
div(
style = "height:400px; overflow-y:auto; border:1px solid #ddd;",
HTML(as_raw_html(tabla_gt))
)
)| Tabla 1. Extracto de pares de valores observados de residuos verdes y plástico | ||
| Observación | (X) Residuos Verdes (%) | (Y) Plástico (%) |
|---|---|---|
5.Gráfica de Dispersión
5.1 Gráfica de Dispersión Global
# ------------------------------------------------------------------------------
# 5. GRÁFICA DE DISPERSIÓN
# ------------------------------------------------------------------------------
plot(
x,
y,
main = "Gráfica No. 1. Diagrama de dispersión entre Residuos Verdes\ny Plástico en el estudio de la calidad de agua en Europa",
xlab = "Residuos verdes (%)",
ylab = "Plástico (%)",
pch = 16,
col = rgb(135,206,235,120,maxColorValue = 255),
cex = 0.8,
xlim = c(0, max(x)*1.05),
ylim = c(0, max(y)*1.05)
)
## COMENTARIO:
# Aunque la muestra está conformada por 5047 observaciones, el diagrama de dispersión muestra un número reducido de puntos debido a la superposición de observaciones. Esto ocurre porque las variables presentan pocos valores distintos, compartiendo las mismas coordenadas (X,Y).
# Se utilizó la estrategia de dividir el logaritmo de Y para 100 con el fin de reducir la escala del eje vertical a valores decimales muy pequeños. Al hacer las distancias de Y minúsculas en comparación con X, se suaviza la dispersión de los datos altos. Esto permite hallar el modelo que se adapte mejor a la forma visual de los puntos.5.2 Tratamiento de los datos
# ------------------------------------------------------------------------------
# 5.2 TRATAMIENTO DE LOS DATOS
# ------------------------------------------------------------------------------
datos_modelo <- datos %>%
select(
composition_yard_garden_green_waste_percent,
composition_plastic_percent
) %>%
na.omit() %>%
filter(
composition_yard_garden_green_waste_percent > 0,
composition_plastic_percent > 0
)
# Variable independiente (Escala original)
x <- datos_modelo$composition_yard_garden_green_waste_percent
# Variable dependiente transformada (Logaritmo en Y dividido para 100)
y <- datos_modelo$composition_plastic_percent
log_y <- log(y) / 1005.3 Gráfica de dispersión aplicado el logaritmo en fracción
# ------------------------------------------------------------------------------
# 5.3 GRÁFICA CON EL LOGARITMO (BASE 2000)
# ------------------------------------------------------------------------------
plot(
x,
log_y,
main = "Gráfica No. 2. Diagrama de dispersión\nentre Residuos Verdes y Log(Plástico)/100 en el esudio de la calidad de agua en Europa",
xlab = "Residuos verdes (%)",
ylab = "Log(Plástico %) / 100",
pch = 16,
col = rgb(135, 206, 235, 180, maxColorValue = 255),
cex = 1.2,
xlim = c(0, max(x)*1.05),
ylim = c(min(log_y)*1.05, max(log_y)*0.9) # Escala dinámica adaptada a la división
)
6. Conjetura
#==============================================================================
# 4. CONJETURA (Planteamiento Teórico)
#==============================================================================
# Tras analizar el comportamiento inicial de la dispersión, se plantea como
# conjetura teórica que la relación entre el porcentaje de residuos verdes (X)
# y el logaritmo escalado del porcentaje de plástico (Log Y / 100) sigue una
# tendencia polinómica de tercer grado (cúbica). 7. Cálculo de parámetros
# Ajustamos el modelo de grado 3: [Log(Y)/100] = b0 + b1*X + b2*X^2 + b3*X^3
modelo_definitivo <- lm(log_y ~ x + I(x^2) + I(x^3))
# Extracción individual de coeficientes (Betas)
beta0 <- modelo_definitivo$coefficients[1]
beta1 <- modelo_definitivo$coefficients[2]
beta2 <- modelo_definitivo$coefficients[3]
beta3 <- modelo_definitivo$coefficients[4]
# Impresión limpia uno por uno en la consola (con más decimales por el cambio de escala)
print(paste("Intercepto (beta0):", round(beta0, 4)))## [1] "Intercepto (beta0): 0.0367"print(paste("Coeficiente X (beta1):", round(beta1, 4)))## [1] "Coeficiente X (beta1): -0.003"print(paste("Coeficiente X^2 (beta2):", round(beta2, 6)))## [1] "Coeficiente X^2 (beta2): 0.00021"print(paste("Coeficiente X^3 (beta3):", round(beta3, 6)))## [1] "Coeficiente X^3 (beta3): -5e-06"8. Comparación de la realidad con el modelo
# ==============================================================================
# # 8. Comparación de la realidad con el modelo
# ==============================================================================
# 1. Dibujamos el plano cartesiano con tus puntos adaptados a la nueva escala de Y
plot(
x,
log_y,
main = "Gráfica No. 3.Regresión del Modelo Polinómico Cúbico (Log(Y)/100)\nentre Residuos Verdes y Plástico",
xlab = "Residuos verdes (%)",
ylab = "Log(Plástico %) / 100",
pch = 16,
col = rgb(135, 206, 235, 180, maxColorValue = 255),
cex = 1.3,
xlim = c(0, max(x)*1.05), # Escala horizontal automática basada en tus datos
ylim = c(min(log_y)*1.05, max(log_y)*0.9) # Escala vertical automática basada en la división
)
# 2. Creamos una secuencia matemática de 1000 puntos continuos para la curva suave
x_curva <- seq(min(x), max(x), length.out = 1000)
# 3. Creamos el newdata usando exactamente el nombre de la variable "x"
dataframe_prediccion <- data.frame(x = x_curva)
log_y_curva <- predict(modelo_definitivo, newdata = dataframe_prediccion)
# 4. Trazamos la línea del modelo en color rojo sobre la nube completa de puntos
lines(x_curva, log_y_curva, col = "red", lwd = 3)
9. Test de bondad
# =================
# TEST DE BONDAD
# =================
# Calculamos el coeficiente de correlación de Pearson
r_pearson <- cor(x, log_y, method = "pearson")
cat("--- TEST DE BONDAD DEL AJUSTE ---\n")## --- TEST DE BONDAD DEL AJUSTE ---cat("Coeficiente de Correlación de Pearson (r):", round(r_pearson, 4), "\n")## Coeficiente de Correlación de Pearson (r): -0.854110. Restricciones
# ==============================================================================
# # 10. Restricciones del Modelo
# ==============================================================================
# Dominio [X] - Porcentaje de Residuos Verdes:
# D_x = {x ∈ R | 0 < x ≤ 100}
# Dominio [Y] - Porcentaje de Plástico:
# D_y = {y ∈ R | 0 < y ≤ 100}
# ¿Existe algún valor en el dominio de X que, sustituido en el modelo matemático, genere un valor en Y fuera de su dominio?
# RESPUESTA:
# No. Debido a que el modelo predice en la escala de Log(Y)/100, al realizar el despeje
# algebraico inverso para recuperar el valor real (Y = exp(Prediccion * 100)), la propiedad
# de la función exponencial garantiza matemáticamente que el porcentaje de plástico (Y)
# siempre arrojará valores estrictamente positivos (mayores a 0%).11. Estimaciones
### Pregunta
# ¿Cuál es el porcentaje estimado de residuos plásticos cuando el porcentaje de residuos verdes es del 10 %?
#--------------------------------------------------------------------------
# Valor de X para realizar la estimación
#--------------------------------------------------------------------------
residuos_verdes <- 10
#--------------------------------------------------------------------------
# Estimación exacta usando la función predict
#--------------------------------------------------------------------------
# Predict nos devuelve el valor en la escala modificada: Log(Y)/100
log_plastico_div_estimado <- predict(modelo_definitivo, newdata = data.frame(x = residuos_verdes))
# Operación inversa exacta para regresar al porcentaje real de plástico:
# Primero multiplicamos por 100 para revertir la división, luego aplicamos exp()
plastico_estimado_real <- exp(log_plastico_div_estimado * 100)
# Extracción de coeficientes con formato limpio para la ecuación de la leyenda
b0 <- format(round(coef(modelo_definitivo)[1], 4), nsmall = 4)
b1 <- format(round(coef(modelo_definitivo)[2], 4), nsmall = 4)
b2 <- format(round(coef(modelo_definitivo)[3], 5), nsmall = 5)
b3 <- format(round(coef(modelo_definitivo)[4], 6), nsmall = 6)
#==============================================================================
# CREAR CURVA POLINÓMICA AJUSTADA (GRADO 3)
#==============================================================================
x_curva <- seq(
min(x, na.rm = TRUE) - 1,
max(x, na.rm = TRUE) + 1,
length.out = 1000
)
log_y_curva <- predict(modelo_definitivo, newdata = data.frame(x = x_curva))
#==============================================================================
# GRÁFICA No. 3: MODELO POLINÓMICO CÚBICO CON ESTIMACIÓN (SÓLO LA CURVA)
#==============================================================================
x_min <- 0
x_max <- max(x)*1.05
y_min <- min(log_y_curva)*1.05
y_max <- max(log_y_curva)*0.9
# Creamos el lienzo base vacío adaptado a las nuevas dimensiones
plot(
x,
log_y,
type = "n",
main = "Gráfica No. 4: Modelo Polinómico Cúbico con Estimación",
xlab = "Residuos verdes (%)",
ylab = "Log(Plástico %) / 100",
xlim = c(x_min, x_max),
ylim = c(y_min, y_max)
)
# Dibujar la curva cúbica en color púrpura
lines(x_curva, log_y_curva, col = "purple", lwd = 2)
# Líneas guía discontinuas hacia los ejes (usando la coordenada logarítmica dividida)
segments(x0 = residuos_verdes, y0 = y_min, x1 = residuos_verdes, y1 = log_plastico_div_estimado, col = "gray60", lty = 2)
segments(x0 = x_min, y0 = log_plastico_div_estimado, x1 = residuos_verdes, y1 = log_plastico_div_estimado, col = "gray60", lty = 2)
# Punto de la estimación en color rojo
points(x = residuos_verdes, y = log_plastico_div_estimado, col = "red", pch = 18, cex = 1.6)
# Etiquetas en los ejes para identificar los valores exactos
text(x = residuos_verdes, y = y_min + (y_max-y_min)*0.05, labels = paste0(residuos_verdes, " %"), col = "red", font = 2, cex = 0.8)
text(x = x_min + (x_max-x_min)*0.18, y = log_plastico_div_estimado, labels = paste0(round(plastico_estimado_real, 2), " % (Real)"), col = "red", font = 2, pos = 3, cex = 0.8)
#--------------------------------------------------------------------------
# Leyenda explicativa con la ecuación matemática real e incrustada
#--------------------------------------------------------------------------
txt1 <- paste0("Estimación: X = ", residuos_verdes, "% → Y = ", round(plastico_estimado_real, 2), "%")
ecuacion_txt <- bquote(frac(Log(Y), 100) == .(b0) + (.(b1))*X + (.(b2))*X^2 + (.(b3))*X^3)
legend(
"topright",
legend = as.expression(c(txt1, ecuacion_txt)),
col = c("red", "purple"),
pch = c(18, NA),
lty = c(0, 1),
lwd = c(NA, 2),
bty = "o",
bg = "white",
cex = 0.7
)
12. Conclusión
Entre el porcentaje de residuos verdes y el de plástico dividido para 100 existe una relación polinómica de tercer grado representada por el modelo Log(Y)/100 = 0.0367 + (-0.0030)X + (0.00021)X^2 + (-5e-06)X^3. El modelo no presenta restricciones dentro del dominio observado, mostrando que el plástico disminuye inicialmente, se estabiliza en una meseta intermedia y vuelve a descender notablemente en el extremo superior, logrando comprimir de forma óptima la dispersión de los datos sin excluir ninguna observación.