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.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.5.2 Gráfica segmentada
# ==============================================================================
# 5.1 REGRESIÓN POR PARTES (SEGMENTADA EN DOS TRAMOS)
# ==============================================================================
# 1. Definición de los subconjuntos de datos según punto de corte (13%)
tramo1 <- datos_modelo %>% filter(composition_yard_garden_green_waste_percent >= 0 & composition_yard_garden_green_waste_percent <= 13)
tramo2 <- datos_modelo %>% filter(composition_yard_garden_green_waste_percent > 13)
# 2. Ajuste de modelos lineales base 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)
# 3. Generación de la Gráfica de Dispersión con Regresión Segmentada
plot(
x,
y,
main = "Gráfica No. 2: Dispersión 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 una única línea vertical discontinua para delimitar los dos tramos en 13%
abline(v = 13, col = "gray40", lty = 2, lwd = 1.5)
# Añadir texto indicando los límites de los nuevos dos tramos
text(6.5, max(y) * 1.02, "Tramo 1\n(0-13%)", cex = 0.8, col = "gray30")
text(22, max(y) * 1.02, "Tramo 2\n(>13%)", 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 dos tramos específicos con punto de corte en 13%
#Primer tramo---------------------
#En este tramo se visualiza que en la etapa inicial el impacto de los residuos verdes describe una fluctuación pronunciada con subidas y bajadas consecutivas, alcanzando el pico máximo de contaminación plástica antes de descender hacia el límite de corte. Debido a esta complejidad geométrica, un modelo polinómico cúbico (Grado 3) podria ser óptimo para capturar con alta fidelidad esta variabilidad inicial.
#Segundo tramo---------------------
#En este tramo, pasado el umbral crítico del 13 %, el sistema describe una caída drástica intermedia seguida de una zona de estabilización final a medida que los residuos verdes se acercan a su máximo observado. Esta tendencia curvilínea y decreciente nos indica que un modelo polinómico cuadrático (Grado 2) podria amoldarse con precisión.7. Cálculo de parámetros
# ==============================================================================
# 7. CÁLCULO DE PARÁMETROS EN DOS TRAMOS
# ==============================================================================
df_tramos_2 <- data.frame(x = x, y = y)
# ------------------------------------------------------------------------------
# TRAMO 1: De 0% a 13% - Modelo Cúbico (Grado 3)
# ------------------------------------------------------------------------------
df_nuevo_t1 <- subset(df_tramos_2, x >= 0 & x <= 13)
modelo_nuevo_t1 <- lm(y ~ x + I(x^2) + I(x^3), data = df_nuevo_t1)
beta0_nt1 <- coef(modelo_nuevo_t1)[1]
beta1_nt1 <- coef(modelo_nuevo_t1)[2]
beta2_nt1 <- coef(modelo_nuevo_t1)[3]
beta3_nt1 <- coef(modelo_nuevo_t1)[4]
cat("--- TRAMO 1: Modelo Cúbico (0% a 13%) ---\n")## --- TRAMO 1: Modelo Cúbico (0% a 13%) ---cat("Intercepto (beta0):", beta0_nt1, "\n")## Intercepto (beta0): -45.97456cat("Coeficiente X (beta1):", beta1_nt1, "\n")## Coeficiente X (beta1): 42.75258cat("Coeficiente X^2 (beta2):", beta2_nt1, "\n")## Coeficiente X^2 (beta2): -7.79535cat("Coeficiente X^3 (beta3):", beta3_nt1, "\n\n")## Coeficiente X^3 (beta3): 0.3848458# ------------------------------------------------------------------------------
# TRAMO 2: Mayor a 13% - Modelo Cuadrático (Grado 2)
# ------------------------------------------------------------------------------
df_nuevo_t2 <- subset(df_tramos_2, x > 13)
modelo_nuevo_t2 <- lm(y ~ x + I(x^2), data = df_nuevo_t2)
beta0_nt2 <- coef(modelo_nuevo_t2)[1]
beta1_nt2 <- coef(modelo_nuevo_t2)[2]
beta2_nt2 <- coef(modelo_nuevo_t2)[3]
cat("--- TRAMO 2: Modelo Cuadrático (> 13%) ---\n")## --- TRAMO 2: Modelo Cuadrático (> 13%) ---cat("Intercepto (beta0):", beta0_nt2, "\n")## Intercepto (beta0): -66.96172cat("Coeficiente X (beta1):", beta1_nt2, "\n")## Coeficiente X (beta1): 7.317635cat("Coeficiente X^2 (beta2):", beta2_nt2, "\n")## Coeficiente X^2 (beta2): -0.1663458. Comparación de la realidad con el modelo
# ==============================================================================
# 8. COMPARACIÓN DE LA REALIDAD CON EL MODELO
# ==============================================================================
# 1. Gráfica base con el diagrama de dispersión original
plot(x, y,
main = "Gráfica No 3: Regresión Segmentada en Dos 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))
# Dibujar la línea vertical divisoria en el nuevo corte de 13%
abline(v = 13, col = "gray40", lty = 2, lwd = 1.2)
# ------------------------------------------------------------------------------
# TRAMO 1 (0% a 13%): Curva Cúbica Ajustada (Color Rojo) curva grad3
# ------------------------------------------------------------------------------
x_nc1 <- seq(0, 13, length.out = 500)
y_nc1 <- predict(modelo_nuevo_t1, newdata = data.frame(x = x_nc1))
lines(x_nc1, y_nc1, col = "firebrick", lwd = 3)
# ------------------------------------------------------------------------------
# TRAMO 2 (> 13%): Curva Cuadrática Ajustada (Color Verde) curva grad2
# ------------------------------------------------------------------------------
x_nc2 <- seq(13, max(x), length.out = 500)
y_nc2 <- predict(modelo_nuevo_t2, newdata = data.frame(x = x_nc2))
lines(x_nc2, y_nc2, col = "forestgreen", lwd = 3)
# ------------------------------------------------------------------------------
# Leyenda explicativa de los dos tramos polinómicos
# ------------------------------------------------------------------------------
legend(
"topright",
legend = c("Tramo 1: Cúbico (0-13%)",
"Tramo 2: Cuadrático (>13%)"),
col = c("firebrick", "forestgreen"),
lty = 1,
lwd = 3,
bty = "o",
bg = "white",
cex = 0.8
)
9. Test de bondad
# =============================================================================# ==============================================================================
# 9. TEST DE BONDAD DE AJUSTE POR TRAMOS (NUEVO MODELO DE DOS TRAMOS)
# ==============================================================================
cat("========================================================\n")## ========================================================cat(" EVALUACIÓN DE BONDAD DE AJUSTE (2 TRAMOS)\n")## EVALUACIÓN DE BONDAD DE AJUSTE (2 TRAMOS)cat("========================================================\n\n")## ========================================================# ------------------------------------------------------------------------------
# TRAMO 1: Modelo Cúbico (0% a 13%)
# ------------------------------------------------------------------------------
# Coeficiente de Pearson
pred_t1 <- predict(modelo_nuevo_t1)
r_nt1 <- cor(df_nuevo_t1$y, pred_t1)
cat("--- TRAMO 1 NUEVO: Modelo Cúbico (0% a 13%) ---\n")## --- TRAMO 1 NUEVO: Modelo Cúbico (0% a 13%) ---cat("Coeficiente de Correlación de Pearson (r):", r_nt1, "\n\n")## Coeficiente de Correlación de Pearson (r): 0.9743562# ------------------------------------------------------------------------------
# TRAMO 2: Modelo Cuadrático (> 13%)
# ------------------------------------------------------------------------------
# Coeficiente de Pearson
pred_t2 <- predict(modelo_nuevo_t2)
r_nt2 <- cor(df_nuevo_t2$y, pred_t2)
cat("--- TRAMO 2 NUEVO: Modelo Cuadrático (> 13%) ---\n")## --- TRAMO 2 NUEVO: Modelo Cuadrático (> 13%) ---cat("Coeficiente de Correlación de Pearson (r):", r_nt2, "\n")## Coeficiente de Correlación de Pearson (r): 0.9904624cat("========================================================\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 cúbico Y = B0 + B1 X + B2 X^2 + B3 X^3 está restringido de manera estricta al rango inicial del 0 % al 13 %. Debido a su alta flexibilidad matemática (Grado 3), si este modelo se proyecta fuera de sus límites, la curva tenderá a oscilar bruscamente hacia el infinito positivo o negativo, lo que causaría estimaciones absurdas y la pérdida total de su validez.
#PARA EL TRAMO 2
#El modelo cuadrático Y = B0 + B1 X + B2 X^2 rige el comportamiento pasado el umbral del 13 %. Al describir una trayectoria parabólica decreciente, posee la restricción matemática crítica de sus raíces reales. Si la curva corta el eje horizontal y se proyecta indefinidamente en el eje X, generará valores de Y < 0.Cuando llegamos a xcritico 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 13 %, evaluado tanto en el modelo cúbico como en el
# modelo cuadrático?
#--------------------------------------------------------------------------
# Valor de X para realizar la estimación
#--------------------------------------------------------------------------
residuos_verdes <- 13
# 1. Estimación usando el Modelo Cúbico (Tramo 1)
df_est_t1 <- data.frame(x = residuos_verdes)
plastico_est_t1 <- predict(modelo_nuevo_t1, newdata = df_est_t1)
# 2. Estimación usando el Modelo Cuadrático (Tramo 2)
df_est_t2 <- data.frame(x = residuos_verdes)
plastico_est_t2 <- predict(modelo_nuevo_t2, newdata = df_est_t2)
cat("--- RESULTADOS DE LAS ESTIMACIONES EN X = 13% ---\n")## --- RESULTADOS DE LAS ESTIMACIONES EN X = 13% ---cat("Estimación con Modelo Cúbico (Tramo 1):", plastico_est_t1, "%\n")## Estimación con Modelo Cúbico (Tramo 1): 37.90109 %cat("Estimación con Modelo Cuadrático (Tramo 2):", plastico_est_t2, "%\n\n")## Estimación con Modelo Cuadrático (Tramo 2): 0.05524319 %#--------------------------------------------------------------------------
# Gráfica No. 3: Modelos Segmentados con Puntos de Estimación en X = 13%
#--------------------------------------------------------------------------
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 = 13%)",
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
x_c1 <- seq(0, 13, length.out = 500)
lines(x_c1, predict(modelo_nuevo_t1, newdata = data.frame(x = x_c1)), col = "firebrick", lwd = 2)
x_c2 <- seq(13, max(x), length.out = 500)
lines(x_c2, predict(modelo_nuevo_t2, newdata = data.frame(x = x_c2)), col = "forestgreen", lwd = 2)
#--------------------------------------------------------------------------
# Líneas guía discontinuas y puntos de estimación
#--------------------------------------------------------------------------
# Guía vertical en X = 13
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 de corte (13%)
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 = "13%", col = "black", font = 2, cex = 0.8)
text(x = x_min + 1.5, 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.5, y = plastico_est_t2, labels = paste0(round(plastico_est_t2, 2), "%"), col = "forestgreen", font = 2, pos = 3, cex = 0.75)
# Leyenda explicativa ajustada a dos tramos
legend(
"topright",
legend = c("Tramo 1 (Cúbico)", "Tramo 2 (Cuadrático)"),
col = c("firebrick", "forestgreen"),
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 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 13 %) queda representado por un modelo polinómico cúbico (\(Y = \beta_0 + \beta_1 X + \beta_2 X^2 + \beta_3 X^3\)),indicando que en la etapa inicial el impacto de los residuos orgánicos describe una fluctuación o arco pronunciado y luego inicia un descenso controlado hacia la frontera de transición.El Tramo 2 (> 13 %) se rige bajo un modelo cuadrático (\(Y = \beta_0 + \beta_1 X + \beta_2 X^2\)), el cual modela matemáticamente una curvatura parabólica decreciente que se amolda estrechamente a la caída drástica intermedia del contaminante y busca la estabilización a medida que los residuos verdes se acercan a su máximo.Este modelo presenta algunas restricciones estrictas en sus extremos superiores e inferiores.