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 = ".")

datos_sel <- datos %>%
  select(Total_Nitrogen_mg_L, Turbidity_NTU)

2. Gráfica

datos_sel <- datos %>%
  select(Total_Nitrogen_mg_L, Turbidity_NTU)

# Gráfica inicial con todos los puntos
plot(
  datos_sel$Total_Nitrogen_mg_L,
  datos_sel$Turbidity_NTU,
  pch = 19,
  col = "lightblue",
  xlab = "Nitrógeno Total (mg/L)",
  ylab = "Turbidez (NTU)",
  main = "Relacion entre Nitrogeno y la Turbidez"
)

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.

# Función para eliminar outliers por IQR
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)
}

# Aplicar a ambas variables y eliminar NA
datos_limpios <- datos_sel[
  quitar_atipicos_IQR(datos_sel$Total_Nitrogen_mg_L) &
    quitar_atipicos_IQR(datos_sel$Turbidity_NTU),
]

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

# Crear bins de Nitrógeno Total
datos_binned <- datos_limpios %>%
  mutate(
    TN_BIN = cut(
      Total_Nitrogen_mg_L,
      breaks = seq(
        floor(min(Total_Nitrogen_mg_L)),
        ceiling(max(Total_Nitrogen_mg_L)),
        by = 0.5
      )
    )
  )

# Medianas por bin
datos_resumen <- datos_binned %>%
  group_by(TN_BIN) %>%
  summarise(
    Total_Nitrogen_mg_L_mediana = median(Total_Nitrogen_mg_L, na.rm = TRUE),
    Turbidity_NTU_mediana = median(Turbidity_NTU, na.rm = TRUE),
    n = n()
  ) %>%
  filter(n >= 3)

datos_resumen
## # A tibble: 6 × 4
##   TN_BIN  Total_Nitrogen_mg_L_mediana Turbidity_NTU_mediana     n
##   <fct>                         <dbl>                 <dbl> <int>
## 1 (1.5,2]                        1.9                   3.03    49
## 2 (2,2.5]                        2.35                  2.88   392
## 3 (2.5,3]                        2.78                  3.18   968
## 4 (3,3.5]                        3.24                  3.47   983
## 5 (3.5,4]                        3.67                  3.32   390
## 6 (4,4.5]                        4.11                  3.90    68

5. Definir Variable

x <- datos_resumen$Total_Nitrogen_mg_L_mediana
y <- datos_resumen$Turbidity_NTU_mediana

6. Conjetura

plot(x, y,
     pch = 19,
     xlab = "Nitrógeno Total (mg/L)",
     ylab = "Turbidez (NTU)",
     main = "Gráfica Nº 1: Diagrama de dispersión\nNitrógeno Total y la Turbidez")

7. Parámetros del modelo

modelo_exp <- lm(log(y) ~ x)

# Parámetros del modelo
a <- exp(coef(modelo_exp)[1])
b <- coef(modelo_exp)[2]

a  # intercepto en escala original
## (Intercept) 
##    2.317544
b  # exponente
##         x 
## 0.1155028

7.1 Ecuación del modelo

plot(1, type = "n", axes = FALSE, xlab = "", ylab = "")
text(
  x = 1, y = 1,
  labels = paste0(
    "Ecuación Exponencial\n",
    "y = a  e^(b  x)\n",
    "y = ", round(a, 4), "  e^(", round(b, 4), " x)"
  ),
  cex = 2,
  col = "blue",
  font = 2
)

7.2 Gráfico con recta de regresión

plot(x, y,
     col = "deepskyblue",
     pch = 16,
     xlab = "Nitrógeno Total (mg/L)",
     ylab = "Turbidez (NTU)",
     main = "Gráfica Nº 2: Ajuste exponencial Nitrógeno Total y Turbidez")

curve(a * exp(b * x),
      from = min(x),
      to = max(x),
      add = TRUE,
      col = "blue",
      lwd = 2)

8. Correlación y coeficiente de determinación

y_log_hat <- predict(modelo_exp)
y_hat <- exp(y_log_hat)

r <- cor(y, y_hat, method = "pearson")
r2 <- r^2 * 100

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

9. Restricciones del modelo

cat("Restricciones del modelo exponencial:\n")
## Restricciones del modelo exponencial:
cat("- Dominio: x >= 0 (concentración de Nitrógeno Total no negativa)\n")
## - Dominio: x >= 0 (concentración de Nitrógeno Total no negativa)
cat("- Rango: y > 0 (Turbidez siempre positiva)\n")
## - Rango: y > 0 (Turbidez siempre positiva)
cat("- Aplicación física y estadística limitada al rango observado:\n")
## - Aplicación física y estadística limitada al rango observado:
cat("Rango experimental de x: ", range(x), "\n")
## Rango experimental de x:  1.9 4.11
cat("Rango experimental de y: ", range(y), "\n")
## Rango experimental de y:  2.875 3.905

10. Estimación

# Estimar Nitrógeno Total para Turbidez = 3 NTU
turb_objetivo <- 3
nt_est <- a * exp(b * turb_objetivo)

plot(1, type = "n", axes = FALSE, xlab = "", ylab = "")
text(
  1, 1,
  labels = paste0(
    "Estimación de Nitrógeno Total para Turbidez = ", turb_objetivo, " NTU\n",
    "Resultado estimado: ", round(nt_est, 4), " mg/L"
  ),
  cex = 1.3,
  col = "blue",
  font = 2
)

11. Conclusiones

En la contaminación del agua en China Existe una relación exponencial entre Nitrógeno Total y Turbidez.

El modelo ajustado es:

𝑦 ^ = 𝑎 ⋅ 𝑒 𝑏 𝑥 y ^ ​=a⋅e bx

El modelo es válido para todo 𝑥 ≥ 0 x≥0, 𝑦 > 0 y>0, pero se recomienda usar solo en el rango observado: 1.90 ≤ x ≤ 4.11 mg/L; 2.88 ≤ y ≤ 3.90 NTU.Para Turbidez = 3 NTU, la concentración estimada de Nitrógeno Total es aproximadamente nt_est mg/L. ```