Variable trabajada por partes
Universidad Central del Ecuador
03/07/2026
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)## Warning: package 'htmltools' was built under R version 4.6.12.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 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.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.5.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")
6. 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 describe una fluctuación en forma de parábola o arco pronunciado antes de estabilizarse, lo que nos podría indicar un modelo cuadrático como el óptimo para capturar este comportamiento inicial.
#Segundo tramo---------------------
#En este tramo se visualiza una zona de transición donde los puntos describen una curvatura convexa en efecto espejo, manteniendo niveles altos al principio para luego acelerar su caída, lo que nos indica que una función exponencial invertida es la adecuada para modelar este descenso acelerado.
#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.7. Cálculo de parámetros
# ==============================================================================
# 7. CÁLCULO DE PARÁMETROS POR TRAMOS (EXPONENCIAL INVERTIDA EN TRAMO 2)
# ==============================================================================
# Creación de dataframe base
df_tramos <- data.frame(x = x, y = y)
# ------------------------------------------------------------------------------
# TRAMO 1: De 0% a 10% - Modelo Cuadrático (Y = beta0 + beta1 * X + beta2 * X^2)
# ------------------------------------------------------------------------------
df_t1 <- subset(df_tramos, x >= 0 & x <= 10)
modelo_t1 <- lm(y ~ x + I(x^2), data = df_t1)
beta0_t1 <- coef(modelo_t1)[1]
beta1_t1 <- coef(modelo_t1)[2]
beta2_t1 <- coef(modelo_t1)[3]
cat("--- TRAMO 1: Modelo Cuadrático (0% a 10%) ---\n")## --- TRAMO 1: Modelo Cuadrático (0% a 10%) ---cat("Intercepto (beta0):", beta0_t1, "\n")## Intercepto (beta0): -32.41049cat("Coeficiente X (beta1):", beta1_t1, "\n")## Coeficiente X (beta1): 29.31075cat("Coeficiente X^2 (beta2):", beta2_t1, "\n\n")## Coeficiente X^2 (beta2): -3.639074# ------------------------------------------------------------------------------
# TRAMO 2: De 10% a 17% - Modelo Exponencial Invertido (Efecto Espejo Convexo)
# ------------------------------------------------------------------------------
df_t2 <- subset(df_tramos, x >= 10 & x <= 17)
modelo_t2 <- lm(y ~ I(exp(x / 10)), data = df_t2)
beta0_t2 <- coef(modelo_t2)[1]
beta1_t2 <- coef(modelo_t2)[2]
cat("--- TRAMO 2: Modelo Exponencial Invertido (10% a 17%) ---\n")## --- TRAMO 2: Modelo Exponencial Invertido (10% a 17%) ---cat("Intercepto base (beta0):", beta0_t2, "\n")## Intercepto base (beta0): 29.86103cat("Coeficiente Exponencial (beta1):", beta1_t2, "\n\n")## Coeficiente Exponencial (beta1): -5.162556# ------------------------------------------------------------------------------
# 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):", beta0_t3, "\n")## Intercepto (beta0): 30.07174cat("Coeficiente de pendiente X (beta1):", beta1_t3, "\n")## Coeficiente de pendiente X (beta1): -0.93439728. 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 Cuadrática Ajustada (Color Rojo)
# ------------------------------------------------------------------------------
x_c1 <- seq(0, 10, length.out = 500)
y_c1 <- predict(modelo_t1, newdata = data.frame(x = x_c1))
lines(x_c1, y_c1, col = "firebrick", lwd = 3)
# ------------------------------------------------------------------------------
# TRAMO 2 (10% a 17%): Curva Exponencial Invertida (Color Verde "Espejo")
# ------------------------------------------------------------------------------
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 independientes
# ------------------------------------------------------------------------------
legend(
"topright",
legend = c("Tramo 1: Cuadrático (0-10%)",
"Tramo 2: Exponencial Invertido (10-17%)",
"Tramo 3: Lineal (>17%)"),
col = c("firebrick", "forestgreen", "navyblue"),
lty = 1,
lwd = 3,
bty = "o",
bg = "white",
cex = 0.8
)
9. Test de bondad
# ==============================================================================
# 9. TEST DE BONDAD DE AJUSTE POR TRAMOS (MODELOS INDEPENDIENTES)
# ==============================================================================
cat("========================================================\n")## ========================================================cat(" EVALUACIÓN DE BONDAD DE AJUSTE\n")## EVALUACIÓN DE BONDAD DE AJUSTEcat("========================================================\n\n")## ========================================================# ------------------------------------------------------------------------------
# TRAMO 1: Modelo Cuadrático (0% a 10%)
# ------------------------------------------------------------------------------
# Coeficiente de Pearson
r_t1 <- cor(df_t1$x, df_t1$y)
cat("--- TRAMO 1: Modelo Cuadrático (0% a 10%) ---\n")## --- TRAMO 1: Modelo Cuadrático (0% a 10%) ---cat("Coeficiente de Correlación de Pearson (r):", r_t1, "\n\n")## Coeficiente de Correlación de Pearson (r): -0.7945385# ------------------------------------------------------------------------------
# TRAMO 2: Modelo Exponencial Invertido (10% a 17%)
# ------------------------------------------------------------------------------
# Coeficiente de Pearson
r_t2 <- cor(exp(df_t2$x / 10), df_t2$y)
cat("--- TRAMO 2: Modelo Exponencial Invertido (10% a 17%) ---\n")## --- TRAMO 2: Modelo Exponencial Invertido (10% a 17%) ---cat("Coeficiente de Correlación de Pearson (r, espacio exp):", r_t2, "\n\n")## Coeficiente de Correlación de Pearson (r, espacio exp): -0.8930088# ------------------------------------------------------------------------------
# TRAMO 3: Modelo Lineal Simple (> 17%)
# ------------------------------------------------------------------------------
# Cálculo de Pearson y R2
r_t3 <- cor(df_t3$x, df_t3$y)
r2_t3 <- summary(modelo_t3)$r.squared
cat("--- TRAMO 3: Modelo Lineal (> 17%) ---\n")## --- TRAMO 3: Modelo Lineal (> 17%) ---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²): 1cat("========================================================\n")## ========================================================10. Restricciones
# Dominio global[X]:
# D = {x ∈ R | 0 < x ≤ 100}
# Dominio global[Y]:
# D = {y ∈ R | 0 ≤ y ≤ 100}
#PARA EL TRAMO 1
#El modelo cuadrático Y = B0 + B1 X + B2 X^2 está acotado estrictamente al intervalo inicial 0 % a 10 %. Pierde total validez física si la parábola se proyecta fuera de estos límites y corta el eje horizontal antes de tiempo, por lo que su aplicación requiere que las raíces matemáticas o el vértice no fuercen valores negativos de plástico dentro de su rango.
#PARA EL TRAMO 2
#Su aplicación queda condicionada rígidamente al intervalo cerrado 10 % < x ≤ 17 %. Al modelarse mediante una función exponencial invertida Y = B0 + B1 e^(X/10), el comportamiento convexo numéricamente jamás hereda asíntotas verticales ni valores negativos, estimando un límite superior controlado que no supera el 100 % de contaminación plástica.
#PARA EL TRAMO 3
# La recta de regresión lineal posee una pendiente negativa constante B1 < 0. Si se proyecta indefinidamente en el eje X, eventualmente cruzará el eje horizontal, generando valores de Y < 0 Entonces si existe una restriccion bastante clara que esta en 17 < x <xcrítico donde xcrítico = -B0/B1 luego de este porcentaje el modelo pierde validez.11. Estimaciones
# ==============================================================================
# 11. ESTIMACIONES CON MODELOS INDEPENDIENTES
# ==============================================================================
### Pregunta
# ¿Cuál es el porcentaje estimado de residuos plásticos cuando el porcentaje de
# residuos verdes es del 10 %, evaluado tanto en el modelo cuadrático como en el
# modelo exponencial invertido?
#--------------------------------------------------------------------------
# Valor de X para realizar la estimación
#--------------------------------------------------------------------------
residuos_verdes <- 10
# 1. Estimación usando el Modelo Cuadrático (Tramo 1)
df_est_t1 <- data.frame(x = residuos_verdes)
plastico_est_t1 <- predict(modelo_t1, newdata = df_est_t1)
# 2. Estimación usando el Modelo Exponencial Invertido (Tramo 2)
df_est_t2 <- data.frame(x = residuos_verdes)
plastico_est_t2 <- predict(modelo_t2, newdata = df_est_t2)
cat("--- RESULTADOS DE LAS ESTIMACIONES EN X = 10% ---\n")## --- RESULTADOS DE LAS ESTIMACIONES EN X = 10% ---cat("Estimación con Modelo Cuadrático (Tramo 1):", plastico_est_t1, "%\n")## Estimación con Modelo Cuadrático (Tramo 1): -103.2104 %cat("Estimación con Modelo Exponencial Invertido (Tramo 2):", plastico_est_t2, "%\n\n")## Estimación con Modelo Exponencial Invertido (Tramo 2): 15.82775 %#--------------------------------------------------------------------------
# Gráfica No. 3: Modelos Segmentados con Puntos de Estimación en X = 10%
#--------------------------------------------------------------------------
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
plot(
x,
y,
main = "Gráfica No. 4: Modelos segmentados con estimación (X = 10%)",
xlab = "Residuos verdes (%)",
ylab = "Plástico (%)",
xlim = c(x_min, x_max),
ylim = c(y_min, y_max),
col = "#87CEEB90",
pch = 16
)
# Trazamos las curvas independientes de fondo para referencia visual
x_c1 <- seq(0, 10, length.out = 500)
lines(x_c1, predict(modelo_t1, newdata = data.frame(x = x_c1)), col = "firebrick", lwd = 2)
x_c2 <- seq(10, 17, length.out = 500)
lines(x_c2, predict(modelo_t2, newdata = data.frame(x = x_c2)), col = "forestgreen", lwd = 2)
x_c3 <- seq(17, max(x), length.out = 500)
lines(x_c3, predict(modelo_t3, newdata = data.frame(x = x_c3)), col = "navyblue", lwd = 2)
#--------------------------------------------------------------------------
# Líneas guía discontinuas y puntos de estimación
#--------------------------------------------------------------------------
# Guía vertical en X = 10
segments(x0 = residuos_verdes, y0 = y_min, x1 = residuos_verdes, y1 = max(plastico_est_t1, plastico_est_t2), col = "gray40", lty = 2)
# Guías horizontales para cada estimación
segments(x0 = x_min, y0 = plastico_est_t1, x1 = residuos_verdes, y1 = plastico_est_t1, col = "firebrick", lty = 3)
segments(x0 = x_min, y0 = plastico_est_t2, x1 = residuos_verdes, y1 = plastico_est_t2, col = "forestgreen", lty = 3)
# Dibujamos los dos puntos estimados en la frontera
points(x = residuos_verdes, y = plastico_est_t1, col = "firebrick", pch = 19, cex = 1.5)
points(x = residuos_verdes, y = plastico_est_t2, col = "forestgreen", pch = 19, cex = 1.5)
# Etiquetas numéricas en la gráfica
text(x = residuos_verdes, y = y_min + 0.5, labels = "10%", col = "black", font = 2, cex = 0.8)
text(x = x_min + 1.2, y = plastico_est_t1, labels = paste0(round(plastico_est_t1, 2), "%"), col = "firebrick", font = 2, pos = 3, cex = 0.75)
text(x = x_min + 1.2, y = plastico_est_t2, labels = paste0(round(plastico_est_t2, 2), "%"), col = "forestgreen", font = 2, pos = 3, cex = 0.75)
# Leyenda explicativa
legend(
"topright",
legend = c("Tramo 1 (Cuadrático)", "Tramo 2 (Exponencial Inv.)", "Tramo 3 (Lineal)"),
col = c("firebrick", "forestgreen", "navyblue"),
lty = 1,
lwd = 2,
bty = "o",
bg = "white",
cex = 0.8
)
12. 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 cuadrático (\(Y = \beta_0 + \beta_1 X + \beta_2 X^2\)), indicando que el nivel de plástico experimenta fluctuaciones marcadas antes de alcanzar la primera frontera de transición en el sistema.El Tramo 2 (10 % a 17 %) se rige bajo un modelo un modelo exponencial invertido (\(Y = \beta_0 + \beta_1 e^{X/10}\)), el cual describe una curvatura convexa en efecto espejo sostiene temporalmente los niveles del contaminante al inicio del intervalo para luego acelerar su caída a medida que se aproxima al límite superior.El Tramo 3 (> 17 %) se define mediante un modelo lineal simple (\(Y = \beta_0 + \beta_1 X\)) con pendiente negativa, mostrando un descenso final uniforme y constante hacia la desaparición del residuo sintético.Este modelo presenta algunas restricciones estrictas en sus extremos superiores e inferiores.