1. Carga de Datos

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, union
datos <- read.csv("china_water_pollution_data.csv",
                  header = TRUE,
                  sep = ",",
                  dec = ".")

# Crear variable Carga Contaminante
datos <- datos %>%
  mutate(
    Carga_Contaminante =
      BOD_mg_L +
      COD_mg_L +
      Ammonia_N_mg_L +
      Total_Nitrogen_mg_L +
      Total_Phosphorus_mg_L +
      Turbidity_NTU +
      Coliform_Count_CFU_100mL / 1000
  )

datos_sel <- datos %>%
  select(Carga_Contaminante, Water_Quality_Index)

2. Gráfica

datos_sel <- datos %>%
  select(Carga_Contaminante, Water_Quality_Index)

plot(
  datos_sel$Carga_Contaminante,
  datos_sel$Water_Quality_Index,
  pch = 19,
  col = "lightblue",
  xlab = "Carga contaminante (mg/L)",
  ylab = "Índice de calidad del agua",
  main = "Relación entre Carga Contaminante y WQI"
)

Esta gráfica muestra todas las observaciones, incluyendo valores atípicos y NA.Se observa dispersión y posibles puntos extremos que podrían distorsionar la regresión.

3. Limpieza de datos y eliminación de valores atípicos

Se eliminan valores faltantes y atípicos para evitar que distorsionen la estimación de la regresión. La limpieza mejora la representación de la tendencia general, manteniendo la variabilidad natural.

datos_sel <- datos_sel %>%
  filter(!is.na(Carga_Contaminante),
         !is.na(Water_Quality_Index),
         Carga_Contaminante > 0)

quitar_atipicos_IQR <- function(x) {
  Q1 <- quantile(x, 0.25, na.rm = TRUE)
  Q3 <- quantile(x, 0.75, na.rm = TRUE)
  IQR <- Q3 - Q1
  x >= (Q1 - 1.5 * IQR) & x <= (Q3 + 1.5 * IQR)
}

datos_limpios <- datos_sel[
  quitar_atipicos_IQR(datos_sel$Carga_Contaminante) &
  quitar_atipicos_IQR(datos_sel$Water_Quality_Index),
]

4. Agrupación por intervalos (Bins) y resumen

bin_width <- 10

datos_binned <- datos_limpios %>%
  mutate(
    CARGA_BIN = cut(
      Carga_Contaminante,
      breaks = seq(
        floor(min(Carga_Contaminante)),
        ceiling(max(Carga_Contaminante)),
        by = bin_width
      ),
      include.lowest = TRUE
    )
  )

datos_resumen <- datos_binned %>%
  group_by(CARGA_BIN) %>%
  summarise(
    Carga_mediana = median(Carga_Contaminante, na.rm = TRUE),
    WQI_mediana   = median(Water_Quality_Index, na.rm = TRUE),
    n = n(),
    .groups = "drop"
  ) %>%
  filter(n >= 20)

datos_resumen
## # A tibble: 4 × 4
##   CARGA_BIN Carga_mediana WQI_mediana     n
##   <fct>             <dbl>       <dbl> <int>
## 1 [13,23]            21.2        48.1   204
## 2 (23,33]            28.8        51.0  1446
## 3 (33,43]            36.5        50.4  1115
## 4 <NA>               45.7        52.1   178

5. Definir Variable

x <- datos_resumen$Carga_mediana
y <- datos_resumen$WQI_mediana

6. Conjetura

plot(x, y,
     pch = 19,
     xlab = "Carga contaminante (mg/L)",
     ylab = "Índice de calidad del agua",
     main = "Gráfica Nº1: Diagrama de dispersión\nCarga contaminante y WQI")

7. Parámetros del modelo

x1 <- log(x)
modelo_log <- lm(y ~ x1)

a <- coef(modelo_log)[1]
b <- coef(modelo_log)[2]

a
## (Intercept) 
##    34.26208
b
##       x1 
## 4.672847

7.1 Ecuación del modelo

plot(1, type = "n", axes = FALSE, xlab = "", ylab = "")

text(1, 1.1,
     "Ecuación Logarítmica",
     col = "blue",
     cex = 2,
     font = 2)

text(1, 1,
     "y = a + b · ln(x)",
     col = "blue",
     cex = 1.8,
     font = 2)

text(1, 0.85,
     paste0(
       "y = ",
       round(a, 5),
       " + ",
       round(b, 6),
       " · ln(x)"
     ),
     col = "blue",
     cex = 1.8,
     font = 2)

7.2 Gráfico con recta de regresión

plot(x, y,
     col = "grey",
     pch = 16,
     xlab = "Carga contaminante (mg/L)",
     ylab = "Índice de calidad del agua",
     main = "Gráfica Nº2: Ajuste logarítmico\nCarga contaminante y WQI")

curve(a + b * log(x),
      from = min(x),
      to = max(x),
      add = TRUE,
      col = "red",
      lwd = 2)

8. Correlación y coeficiente de determinación

r <- cor(x1, y)
r2 <- r^2 * 100

cat("Coeficiente de correlación de Pearson:", round(r, 4), "\n")
## Coeficiente de correlación de Pearson: 0.8947
cat("Coeficiente de determinación (R²) =", round(r2, 2), "%\n")
## Coeficiente de determinación (R²) = 80.04 %

9. Restricciones del modelo

cat("Restricciones del modelo logarítmico:\n")
## Restricciones del modelo logarítmico:
cat("- Dominio: x > 0 (debido al logaritmo natural)\n")
## - Dominio: x > 0 (debido al logaritmo natural)
cat("- Rango teórico del WQI: 0 ≤ y ≤ 100\n")
## - Rango teórico del WQI: 0 ≤ y ≤ 100
cat("- Aplicación válida solo dentro del rango observado:\n")
## - Aplicación válida solo dentro del rango observado:
cat("Rango experimental de x: ", range(x), "\n")
## Rango experimental de x:  21.185 45.671
cat("Rango experimental de y: ", range(y), "\n")
## Rango experimental de y:  48.07 52.14

10. Estimación

carga_objetivo <- median(x, na.rm = TRUE)

if(carga_objetivo <= 0){
  stop("La carga debe ser > 0 para usar ln(x)")
}

wqi_est <- a + b * log(carga_objetivo)

plot(1, type = "n", axes = FALSE, xlab = "", ylab = "")
text(
  1, 1,
  labels = paste(
    "Pregunta:\n¿Cuál es el índice de calidad del agua\n",
    "cuando la carga contaminante es",
    round(carga_objetivo, 3), "?\n\n",
    "Resultado estimado:",
    round(wqi_est, 3)
  ),
  cex = 1.2,
  col = "blue",
  font = 2
)

11. Conclusiones

Entre la carga de contaminante y el índice de calidad del agua existe una relación logarítmica dada por: y=34.26208+4.672847ln(x) El modelo explica el 80.04% de la variabilidad del índice de calidad del agua.Es válido únicamente para cargas contaminantes mayores que cero y dentro del intervalo observado: 21.185 ≤ x ≤ 45.671 Fuera de este rango el modelo pierde validez estadística debido a extrapolación.