Exponencial, Polinómico, Lineal
Universidad Central del Ecuador
2026-06-17
0. Librerías
# -------------------------
# Cargar librerías
# -------------------------
library(gt)
library(htmltools)
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, union1.Leer datos
# -------------------------
# Cargar datos
# -------------------------
datos <- read.csv("waterPollution.csv",
sep = ",",
stringsAsFactors = FALSE)2. Selección (causa y efecto)
# ================================
# SELECCIÓN Y SEPARACIÓN
# ================================
# JUSTIFICACIÓN DE 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_percent3. Tabla de pares de valores
3.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.3.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 (%) |
|---|---|---|
4.Gráfica de Dispersión
4.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).
Tras analizar la dispersión de los datos decidimos segmentar el análisis para evitar distorsiones globales; se plantea la conjetura de que el comportamiento del fenómeno no es homogéneo y debe ser modelado de forma independiente en tres fases o tramos diferenciados.
4.2 Gráfica segmentada
# ==============================================================================
# 5.1 REGRESIÓN POR PARTES (SEGMENTADA)
# ==============================================================================
# 1. Definición de los subconjuntos de datos según los puntos de corte
tramo1 <- datos_modelo %>% filter(composition_yard_garden_green_waste_percent >= 0 & composition_yard_garden_green_waste_percent <= 10)
tramo2 <- datos_modelo %>% filter(composition_yard_garden_green_waste_percent > 10 & composition_yard_garden_green_waste_percent <= 17)
tramo3 <- datos_modelo %>% filter(composition_yard_garden_green_waste_percent > 17)
# 2. Ajuste de modelos independientes para cada segmento
modelo_tramo1 <- lm(composition_plastic_percent ~ composition_yard_garden_green_waste_percent, data = tramo1)
modelo_tramo2 <- lm(composition_plastic_percent ~ composition_yard_garden_green_waste_percent, data = tramo2)
modelo_tramo3 <- lm(composition_plastic_percent ~ composition_yard_garden_green_waste_percent, data = tramo3)
# 3. Generación de la Gráfica de Dispersión con Regresión Segmentada
plot(
x,
y,
main = "Gráfica No. 2. Gráfica Segmentada por Tramos\nCalidad de Agua en Europa",
xlab = "Residuos verdes (%)",
ylab = "Plástico (%)",
pch = 16,
col = rgb(135, 206, 235, 150, maxColorValue = 255),
cex = 1,
xlim = c(0, max(x) * 1.05),
ylim = c(0, max(y) * 1.05)
)
# Dibujar líneas verticales discontinuas para delimitar los tramos
abline(v = 10, col = "gray40", lty = 2, lwd = 1.5)
abline(v = 17, col = "gray40", lty = 2, lwd = 1.5)
# Añadir texto indicando los límites de los tramos
text(5, max(y)*1.02, "Tramo 1\n(0-10%)", cex = 0.8, col = "gray30")
text(13.5, max(y)*1.02, "Tramo 2\n(10-17%)", cex = 0.8, col = "gray30")
text(24, max(y)*1.02, "Tramo 3\n(>17%)", cex = 0.8, col = "gray30")
5. Conjetura
Planteamiento de la conjetura:
Se evidencia que el fenómeno no es homogéneo a lo largo del dominio. Una única función global resulta insuficiente para capturar las distintas dinámicas presentes. Por lo tanto, se plantea la conjetura de que la relación entre el porcentaje de residuos verdes y plásticos se modela de forma óptima mediante una regresión por partes dividida en tres tramos específicos.
Primer tramo:
En este tramo se visualiza que en la etapa inicial el impacto de los residuos verdes es drástico, generando una caída acelerada del contaminante plástico lo que nos podría indicar un modelo exponencial decreciente, aunque al inicio tiene un pico luego se suaviza.
\(Y = \beta_0 e^{-\beta_1 X}\)
Segundo tramo:
En este tramo se visualiza una zona de amortiguamiento, donde los puntos describen una ligera curvatura cóncava lo que nos indica que el modelo polinómico puede ser el óptimo para este tramo.
\(Y = \beta_0 + \beta_1 X + \beta_2 X^2\)
Tercer tramo:
En este tramo, pasado el umbral crítico del 17 %, el sistema retoma una tendencia decreciente y uniforme, donde el contaminante se reduce de manera constante a medida que los residuos verdes se acercan a su máximo observado lo que nos indica un modelo lineal.
\(Y = \beta_0 + \beta_1 X\)
6. Cálculo de parámetros
6.1 Tramo 1
# ------------------------------------------------------------------------------
# TRAMO 1: De 0% a 10% - Modelo Exponencial Decreciente (Y = beta0 * e^(beta1 * X))
# Se utiliza la transformación logarítmica log(Y) = log(beta0) + beta1 * X
# ------------------------------------------------------------------------------
# Creación de dataframes para facilitar la segmentación
df_tramos <- data.frame(x = x, y = y)
df_t1 <- subset(df_tramos, x >= 0 & x <= 10)
modelo_t1 <- lm(log(y) ~ x, data = df_t1)
# Extracción y transformación inversa para beta0
beta0_t1 <- exp(coef(modelo_t1)[1])
beta1_t1 <- coef(modelo_t1)[2]
cat("--- TRAMO 1: Modelo Exponencial (0% a 10%) ---\n")## --- TRAMO 1: Modelo Exponencial (0% a 10%) ---cat("Parámetro beta0 (Intersección base):", round(beta0_t1, 4), "\n")## Parámetro beta0 (Intersección base): 26.6576cat("Parámetro beta1 (Tasa de caída):", round(beta1_t1, 4), "\n\n")## Parámetro beta1 (Tasa de caída): -0.10556.2 Tramo 2
# ------------------------------------------------------------------------------
# TRAMO 2: De 10% a 17% - Modelo Cuadrático (Y = beta0 + beta1 * X + beta2 * X^2)
# ------------------------------------------------------------------------------
df_t2 <- subset(df_tramos, x > 10 & x <= 17)
modelo_t2 <- lm(y ~ x + I(x^2), data = df_t2)
beta0_t2 <- coef(modelo_t2)[1]
beta1_t2 <- coef(modelo_t2)[2]
beta2_t2 <- coef(modelo_t2)[3]
cat("--- TRAMO 2: Modelo Cuadrático (10% a 17%) ---\n")## --- TRAMO 2: Modelo Cuadrático (10% a 17%) ---cat("Intercepto (beta0):", round(beta0_t2, 4), "\n")## Intercepto (beta0): 665.4842cat("Coeficiente X (beta1):", round(beta1_t2, 4), "\n")## Coeficiente X (beta1): -94.8223cat("Coeficiente X^2 (beta2):", round(beta2_t2, 4), "\n\n")## Coeficiente X^2 (beta2): 3.38176.3 Tramo 3
# ------------------------------------------------------------------------------
# TRAMO 3: Mayor a 17% - Modelo Lineal Simple (Y = beta0 + beta1 * X)
# ------------------------------------------------------------------------------
df_t3 <- subset(df_tramos, x > 17)
modelo_t3 <- lm(y ~ x, data = df_t3)
beta0_t3 <- coef(modelo_t3)[1]
beta1_t3 <- coef(modelo_t3)[2]
cat("--- TRAMO 3: Modelo Lineal (> 17%) ---\n")## --- TRAMO 3: Modelo Lineal (> 17%) ---cat("Intercepto (beta0):", round(beta0_t3, 4), "\n")## Intercepto (beta0): 30.0717cat("Coeficiente de pendiente X (beta1):", round(beta1_t3, 4), "\n")## Coeficiente de pendiente X (beta1): -0.93447. Comparación de la realidad con el modelo
# ==============================================================================
# 8. COMPARACIÓN DE LA REALIDAD CON EL MODELO SEGMENTADO
# ==============================================================================
# 1. Gráfica base con el diagrama de dispersión original
plot(x, y,
main = "Gráfica No 3: Regresión Segmentada por Tramos entre Residuos\nVerdes y Plástico en el estudio de la calidad de agua en Europa",
xlab = "Residuos verdes (%)",
ylab = "Plástico (%)",
col = "#87CEEB90",
pch = 16,
xlim = c(0, max(x) * 1.05),
ylim = c(0, max(y) * 1.05))
# ------------------------------------------------------------------------------
# TRAMO 1 (0% a 10%): Curva Exponencial Ajustada (Color Rojo)
# ------------------------------------------------------------------------------
x_c1 <- seq(0, 10, length.out = 500)
# Para el modelo exponencial predecimos usando el modelo linealizado y aplicamos exp()
y_c1 <- exp(predict(modelo_t1, newdata = data.frame(x = x_c1)))
lines(x_c1, y_c1, col = "firebrick", lwd = 3)
# ------------------------------------------------------------------------------
# TRAMO 2 (10% a 17%): Curva Cuadrática Ajustada (Color Verde)
# ------------------------------------------------------------------------------
x_c2 <- seq(10, 17, length.out = 500)
y_c2 <- predict(modelo_t2, newdata = data.frame(x = x_c2))
lines(x_c2, y_c2, col = "forestgreen", lwd = 3)
# ------------------------------------------------------------------------------
# TRAMO 3 (> 17%): Línea Recta Ajustada (Color Azul)
# ------------------------------------------------------------------------------
x_c3 <- seq(17, max(x), length.out = 500)
y_c3 <- predict(modelo_t3, newdata = data.frame(x = x_c3))
lines(x_c3, y_c3, col = "navyblue", lwd = 3)
# ------------------------------------------------------------------------------
# Leyenda explicativa de los modelos
# ------------------------------------------------------------------------------
legend(
"topright",
legend = c("Tramo 1: Exponencial (0-10%)",
"Tramo 2: Cuadrático (10-17%)",
"Tramo 3: Lineal (>17%)"),
col = c("firebrick", "forestgreen", "navyblue"),
lty = 1,
lwd = 3,
bty = "o",
bg = "white",
cex = 0.8
)
8. Test de bondad
8.1 Tramo 1
# ------------------------------------------------------------------------------
# TRAMO 1: Modelo Exponencial (0% a 10%)
# ------------------------------------------------------------------------------
r_t1 <- cor(df_t1$x, log(df_t1$y)) # Correlación lineal en el espacio transformado
cat("Coeficiente de Correlación (r, espacio log):", r_t1, "\n")## Coeficiente de Correlación (r, espacio log): -0.77558628.2 Tramo 2
# ------------------------------------------------------------------------------
# TRAMO 2: Modelo Cuadrático (10% a 17%)
# ------------------------------------------------------------------------------
# Cálculo de la correlación de Pearson para el tramo cuadrático
r_t2 <- cor(df_t2$x, df_t2$y)
cat("--- TRAMO 2: Modelo Cuadrático (10% a 17%) ---\n")## --- TRAMO 2: Modelo Cuadrático (10% a 17%) ---cat("Coeficiente de Correlación de Pearson (r):", r_t2, "\n")## Coeficiente de Correlación de Pearson (r): -0.89976268.3 Tramo 3
# ------------------------------------------------------------------------------
# TRAMO 3: Modelo Lineal Simple (> 17%)
# ------------------------------------------------------------------------------
r_t3 <- cor(df_t3$x, df_t3$y)
r2_t3 <- summary(modelo_t3)$r.squared
cat("Coeficiente de Correlación de Pearson (r):", r_t3, "\n")## Coeficiente de Correlación de Pearson (r): -1cat("Coeficiente de Determinación (R²):", r2_t3, "\n")## Coeficiente de Determinación (R²): 19. Restricciones
Evaluación de dominios y restricciones del modelo:
Dominio [X]: \(D = \{x \in \mathbb{R} \mid 0 < x \le 100\}\)
Dominio [Y]: \(D = \{y \in \mathbb{R} \mid 0 \le y \le 100\}\)
¿Existe algún valor de \(X\) que reemplazado en el modelo matemático genere un valor fuera del dominio de \(Y\)?
Para el Tramo 1:
La función exponencial base \(Y = \beta_0 e^{-\beta_1 X}\) numéricamente jamás llega a ser negativa ni hereda asíntotas verticales en este rango, por lo que no presenta restricciones. El modelo estima el intercepto superior inicial de contaminación por plástico \(\beta_0\), el cual no supera el \(100\ \%\).
Para el Tramo 2:
Su aplicación queda condicionada rígidamente al intervalo cerrado \(10\% < x < 17\%\). El vértice de la parábola debe caer dentro o muy cerca de estos márgenes para asegurar que la curva describa fielmente el “valle” o meseta de estabilización.
Para el Tramo 3:
La recta de regresión lineal posee una pendiente negativa constante \(\beta_1 < 0\). Si se proyecta indefinidamente en el eje \(X\), eventualmente cruzará el eje horizontal, generando valores de \(Y < 0\). Entonces, sí existe una restricción bastante clara que está en \(17 < x < x_{\text{crítico}}\), donde \(x_{\text{crítico}} = -\beta_0/\beta_1\); luego de este porcentaje el modelo pierde validez.
10. Estimaciones
# ==============================================================================
# 11. ESTIMACIONES CON EL MODELO SEGMENTADO
# ==============================================================================
# Pregunta:
# ¿Cuál es el porcentaje estimado de residuos plásticos en los cuerpos de agua de Europa cuando
# el porcentaje de residuos verdes es del 10 %, evaluado en los límites de la segmentación propuesta?
#--------------------------------------------------------------------------
# Valor de X para realizar la estimación (Punto crítico de empalme)
#--------------------------------------------------------------------------
residuos_verdes <- 10
#--------------------------------------------------------------------------
# Estimación exacta usando el Modelo del Tramo 1 (Exponencial)
#--------------------------------------------------------------------------
# Nota: Como el modelo exponencial se ajustó con log(y), aplicamos exp() para volver a la escala real
plastico_est_t1 <- exp(predict(modelo_t1, newdata = data.frame(x = residuos_verdes)))
#--------------------------------------------------------------------------
# Gráfica No. 3: Modelos Segmentados con Estimación Crítica
#--------------------------------------------------------------------------
x_min <- min(x, na.rm = TRUE) - 1
x_max <- max(x, na.rm = TRUE) + 1
y_min <- 0
y_max <- max(y, na.rm = TRUE) + 2
# Dibujar base vacía con los puntos reales de fondo
plot(
x,
y,
main = "Gráfica No. 4: Modelos Segmentados con Estimación en X = 10%",
xlab = "Residuos verdes (%)",
ylab = "Plástico (%)",
xlim = c(x_min, x_max),
ylim = c(y_min, y_max),
col = "#87CEEB40", # Puntos muy tenues para resaltar las curvas y la estimación
pch = 16
)
# 1. Trazar las curvas de los 3 tramos para dar contexto visual
x_c1 <- seq(0, 10, length.out = 500)
y_c1 <- exp(predict(modelo_t1, newdata = data.frame(x = x_c1)))
lines(x_c1, y_c1, col = "firebrick", lwd = 2)
x_c2 <- seq(10, 17, length.out = 500)
y_c2 <- predict(modelo_t2, newdata = data.frame(x = x_c2))
lines(x_c2, y_c2, col = "forestgreen", lwd = 2)
x_c3 <- seq(17, max(x), length.out = 500)
y_c3 <- predict(modelo_t3, newdata = data.frame(x = x_c3))
lines(x_c3, y_c3, col = "navyblue", lwd = 2)
# 2. Líneas guía discontinuas hacia los ejes desde el punto estimado
segments(
x0 = residuos_verdes, y0 = y_min,
x1 = residuos_verdes, y1 = plastico_est_t1,
col = "gray40", lty = 2, lwd = 1.2
)
segments(
x0 = x_min, y0 = plastico_est_t1,
x1 = residuos_verdes, y1 = plastico_est_t1,
col = "gray40", lty = 2, lwd = 1.2
)
# 3. Punto de la estimación en la frontera (Color Rojo)
points(
x = residuos_verdes,
y = plastico_est_t1,
col = "red",
pch = 18,
cex = 1.8
)
# 4. Etiquetas de los valores exactos en los ejes
text(
x = residuos_verdes,
y = y_min + 0.6,
labels = paste0(residuos_verdes, "%"),
col = "red", font = 2, cex = 0.8
)
text(
x = x_min + 1.5,
y = plastico_est_t1,
labels = paste0(round(plastico_est_t1, 2), "%"),
col = "red", font = 2, pos = 3, cex = 0.8
)
# 5. Leyenda adaptada al nuevo formato por partes
txt_est <- paste0("Estimación (X=10%): Y = ", round(plastico_est_t1, 2), "%")
legend(
"topright",
legend = c(txt_est, "Tramo 1 (Exp)", "Tramo 2 (Cuad)", "Tramo 3 (Lin)"),
col = c("red", "firebrick", "forestgreen", "navyblue"),
pch = c(18, NA, NA, NA),
lty = c(0, 1, 1, 1),
lwd = c(NA, 2, 2, 2),
bty = "o",
bg = "white",
cex = 0.75
)
11. Conclusión
En conclusión:
Entre el porcentaje de residuos verdes (X) y el porcentaje de plástico (Y) en los cuerpos de agua de Europa existe una relación de tipo lineal y no lineal segmentada por tramos, la cual describe una dinámica ambiental multifacética que cambia según la concentración de residuos en el sistema.
El Tramo 1 (0 % a 10 %) queda representado por un modelo exponencial decreciente (\(Y = 26.6576 \, e^{-0.1055 X}\)), indicando que los primeros aportes de residuos verdes generan una remoción drástica y acelerada del contaminante plástico.
El Tramo 2 (10 % a 17 %) se rige bajo un modelo cuadrático (\(Y = 665.4842 - 94.8223 X + 3.3817 X^2\)), el cual modela matemáticamente un “valle” o meseta de estabilización donde la tasa de plástico se ralentiza temporalmente.
El Tramo 3 (> 17 %) se define mediante un modelo lineal simple (\(Y = 30.0717 - 0.9344 X\)) con pendiente negativa, mostrando un descenso final uniforme y constante hacia la desaparición del residuo sintético. Este modelo sí presenta algunas restricciones estrictas en sus extremos superiores e inferiores.