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 es drástico, generando una caída acelerada del contaminante plástico lo que nos podria indicar un modelo exponencial decreciente aunque al inicio tiene un pico luego se suaviza.
#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 optimo para este tramo.
#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
# ==============================================================================
# Creación de dataframes para facilitar la segmentación
df_tramos <- data.frame(x = x, y = y)
# ------------------------------------------------------------------------------
# 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
# ------------------------------------------------------------------------------
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.1055# ------------------------------------------------------------------------------
# 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.3817# ------------------------------------------------------------------------------
# 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.93448. 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
)
9. Test de bondad
# ==============================================================================
# 9. TEST DE BONDAD DE AJUSTE POR TRAMOS
# ==============================================================================
cat("========================================================\n")## ========================================================cat(" EVALUACIÓN DE BONDAD DE AJUSTE\n")## EVALUACIÓN DE BONDAD DE AJUSTEcat("========================================================\n\n")## ========================================================# ------------------------------------------------------------------------------
# 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("--- TRAMO 1: Modelo Exponencial (0% a 10%) ---\n")## --- TRAMO 1: Modelo Exponencial (0% a 10%) ---cat("Coeficiente de Correlación (r, espacio log):", round(r_t1 * 100, 2), "%\n")## Coeficiente de Correlación (r, espacio log): -77.56 %# ------------------------------------------------------------------------------
# TRAMO 2: Modelo Cuadrático (10% a 17%)
# ------------------------------------------------------------------------------
# Al ser una regresión polinómica múltiple, se utiliza el R² múltiple del modelo
r2_t2 <- summary(modelo_t2)$r.squared
cat("--- TRAMO 2: Modelo Cuadrático (10% a 17%) ---\n")## --- TRAMO 2: Modelo Cuadrático (10% a 17%) ---cat("Coeficiente de Determinación (R² Múltiple):", round(r2_t2 * 100, 2), "%\n")## Coeficiente de Determinación (R² Múltiple): 100 %cat("Explicación: La curvatura parabólica explica el", round(r2_t2 * 100, 2),
"% de la variabilidad del plástico en la zona de estabilización.\n\n")## Explicación: La curvatura parabólica explica el 100 % de la variabilidad del plástico en la zona de estabilización.# ------------------------------------------------------------------------------
# TRAMO 3: Modelo Lineal Simple (> 17%)
# ------------------------------------------------------------------------------
# Al ser un modelo lineal simple clásico, podemos usar Pearson directamente
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):", round(r_t3 * 100, 2), "%\n")## Coeficiente de Correlación de Pearson (r): -100 %cat("Coeficiente de Determinación (R²):", round(r2_t3 * 100, 2), "%\n")## Coeficiente de Determinación (R²): 100 %cat("Explicación: La tendencia lineal decreciente explica el", round(r2_t3 * 100, 2),
"% de la variabilidad del plástico en el descenso final.\n")## Explicación: La tendencia lineal decreciente explica el 100 % de la variabilidad del plástico en el descenso final.cat("========================================================\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
# La función exponencial base Y = B0 e^-B1 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 B0, 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 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 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
)
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 exponencial decreciente (\(Y = \beta_0 e^{-\beta_1 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 = \beta_0 + \beta_1 X + \beta_2 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 = \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 si presenta algunas restricciones estrictas en sus extremos superiores e inferiores.