Modelo Lineal

1. Librerías

# -------------------------
# Cargar librerías
# -------------------------
library(gt)
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

2.Leer datos

# -------------------------
# Cargar datos
# -------------------------

datos <- read.csv("waterPollution.csv",
                  sep = ",",
                  stringsAsFactors = FALSE)

3. Selección(causa y efecto)

# ================================
# SELECCIÓN Y SEPARACIÓN
# ================================

datos$resultMeanValue <- as.numeric(gsub("-", NA, datos$resultMeanValue))

fosforo <- datos %>%  
  filter(observedPropertyDeterminandCode == "CAS_7723-14-0") %>%
  select(waterBodyIdentifier, phenomenonTimeReferenceYear, X_val = resultMeanValue)

nitratos <- datos %>%  
  filter(observedPropertyDeterminandCode == "CAS_14797-55-8") %>%
  select(waterBodyIdentifier, phenomenonTimeReferenceYear, Y_val = resultMeanValue)

datos_pareados <- inner_join(fosforo, nitratos, by = c("waterBodyIdentifier", "phenomenonTimeReferenceYear"))

## Warning in inner_join(fosforo, nitratos, by = c("waterBodyIdentifier", "phenomenonTimeReferenceYear")): Detected an unexpected many-to-many relationship between `x` and `y`.
## ℹ Row 28 of `x` matches multiple rows in `y`.
## ℹ Row 64 of `y` matches multiple rows in `x`.
## ℹ If a many-to-many relationship is expected, set `relationship =
##   "many-to-many"` to silence this warning.

datos_pareados <- datos_pareados[complete.cases(datos_pareados$X_val, datos_pareados$Y_val), ]



#La razón para seleccionar estas dos variables es que el Fósforo Total y los Nitratos son los indicadores clave para medir la contaminación por nutrientes en el agua. Al unirlos en R, se busca comprobar estadísticamente si el aumento de uno se relaciona de forma directa con el comportamiento del otro en las cuencas.


# ------------------------------------------------------------------------------
# 4. IQR PARA ATÍPICOS
# ------------------------------------------------------------------------------
datos_filtrados <- datos_pareados

if (nrow(datos_pareados) > 5) {
  Q1_X <- quantile(datos_pareados$X_val, 0.25, na.rm = TRUE)
  Q3_X <- quantile(datos_pareados$X_val, 0.75, na.rm = TRUE)
  IQR_X <- Q3_X - Q1_X
  
  Q1_Y <- quantile(datos_pareados$Y_val, 0.25, na.rm = TRUE)
  Q3_Y <- quantile(datos_pareados$Y_val, 0.75, na.rm = TRUE)
  IQR_Y <- Q3_Y - Q1_Y
  
  lin_inf_X <- Q1_X - 1.5 * IQR_X
  lin_sup_X <- Q3_X + 1.5 * IQR_X
  lin_inf_Y <- Q1_Y - 1.5 * IQR_Y
  lin_sup_Y <- Q3_Y + 1.5 * IQR_Y
  
  candidatos <- datos_pareados[
    datos_pareados$X_val >= lin_inf_X & datos_pareados$X_val <= lin_sup_X &
      datos_pareados$Y_val >= lin_inf_Y & datos_pareados$Y_val <= lin_sup_Y,
  ]
  
  if (nrow(candidatos) > 0) {
    datos_filtrados <- candidatos
  }
}


datos_filtrados$X_val_red <- round(datos_filtrados$X_val, 2)
datos_prom <- aggregate(Y_val ~ X_val_red, data = datos_filtrados, FUN = mean, na.rm = TRUE)

x <- log(datos_prom$X_val_red)
y <- log(datos_prom$Y_val)

4. Tabla de pares de valores

# 4. Tabla de pares de valores (TVP)
TVP <- data.frame(fosforo = x, Nitratos = y)
num_intervalos <- 6

datos_filtrados$FOSFORO_BIN <- cut(
  datos_filtrados$X_val, 
  breaks = num_intervalos, 
  include.lowest = TRUE,
  dig.lab = 3
)

tabla_resumen <- datos_filtrados %>%
  group_by(Intervalo = FOSFORO_BIN) %>%
  summarize(
    `(X)  Fósforo Total(mg/L)` = round(median(X_val, na.rm = TRUE), 3),
    `(Y)  Nitratos(mg/L)`      = round(median(Y_val, na.rm = TRUE), 3)
  ) %>%
  ungroup()

tabla_gt <- tabla_resumen %>%
  gt() %>%
  tab_header(
    title = "Tabla 1. Valores medianos de nutrientes distribuidos en intervalos de clases"
  ) %>%
  cols_label(
    Intervalo = "Intervalo de Fósforo"
  ) %>%
  tab_source_note(
    source_note = "Fuente: Datos obtenidos de la red de monitoreo de cuencas hidrográficas."
  ) %>%
  tab_options(
    heading.align = "left",                 
    column_labels.background.color = "#ffffff", 
    column_labels.font.weight = "bold",
    table.border.top.color = "#000000",     
    table.border.bottom.color = "#000000",
    column_labels.border.bottom.color = "#000000",
    table.font.size = 11
  ) %>%
  cols_align(
    align = "center",
    columns = everything()
  )

tabla_gt

Tabla 1. Valores medianos de nutrientes distribuidos en intervalos de clases
Intervalo de Fósforo	(X) Fósforo Total(mg/L)	(Y) Nitratos(mg/L)
[0.00545,0.047]	0.021	2.686
(0.047,0.0882]	0.062	11.588
(0.0882,0.13]	0.109	17.744
(0.13,0.171]	0.146	13.762
(0.171,0.212]	0.187	19.418
(0.212,0.254]	0.242	19.905
Fuente: Datos obtenidos de la red de monitoreo de cuencas hidrográficas.

5.Gráfica de Dispersión

5.1 Gráfica de Dispersión total

# ==============================================================================
# GRÁFICA EXPLICATIVA: DISTRIBUCIÓN ABSOLUTA
# ==============================================================================

# 1. Transformamos directamente todos los puntos individuales filtrados por el IQR
x_crudo <- log(datos_filtrados$X_val)
Y_crudo <- log(datos_filtrados$Y_val)

# 2. Gráfica de dispersión logarítmica completa sin reducir por promedios
plot(x_crudo, Y_crudo,
     main = "Gráfica No 1: Diagrama de dispersion entre el Fósforo Total y
     Nitratos en el estudio de los cuerpos de agua de Europa",
     xlab = "(Fósforo Total)(mg/L)",
     ylab = "(Nitratos)(mg/L)",
     col = rgb(135, 206, 235, maxColorValue = 255, alpha = 90), # "skyblue" translúcido para revelar la alta densidad de puntos
     pch = 16,
     cex = 0.9,
     xlim = c(min(x_crudo, na.rm=TRUE)*1.05, max(x_crudo, na.rm=TRUE) * 0.95),
     ylim = c(min(Y_crudo, na.rm=TRUE)*1.05, max(Y_crudo, na.rm=TRUE) * 1.05),
     xaxs = "i", yaxs = "i")

5.2 Gráfica de Dispersión ajustada

# ------------------------------------------------------------------------------
# 5. GRÁFICA No2: Gráfica DE DISPERSIÓN 
# ------------------------------------------------------------------------------
plot(x, y,
     main = "Gráfica No2: Relación entre Fósforo Total y Nitratos en el estudio de
     los cuerpos de agua de Europa",
     xlab = "(Fósforo Total) (mg/L)",
     ylab = "(Nitratos) (mg/L)",
     col = "skyblue",
     pch = 16,
     cex = 1.2,
     cex.main = 1,
     cex.lab = 1,
     cex.axis = 0.9,
     xlim = c(min(x, na.rm=TRUE)*1.05, max(x, na.rm=TRUE) * 0.95),
     ylim = c(min(y, na.rm=TRUE)*1.05, max(y, na.rm=TRUE) * 1.05),
     xaxs = "i", yaxs = "i")

6. Conjetura

# La distribución de los puntos agregados sugiere un modelo lineal de pendiente positiva, lo que demuestra una correlación cinética e hidroquímica estable en las subcuencas monitoreadas. Esta relación estructural indica que el incremento en los niveles de Fósforo Total se vincula de manera directa y proporcional con el comportamiento de los Nitratos en el ecosistema acuático.

7 Cálculo de parámetros

# ------------------------------------------------------------------------------
# 6. CÁLCULO DE PARÁMETROS DEL MODELO LINEAL
# ------------------------------------------------------------------------------
regresionlineal <- lm(y ~ x)
intercepto <- coef(regresionlineal)[1]
pendiente  <- coef(regresionlineal)[2]

print(paste("Intercepto (beta 0):", round(intercepto, 4)))

## [1] "Intercepto (beta 0): 4.1303"

print(paste("Pendiente (beta 1):", round(pendiente, 4)))

## [1] "Pendiente (beta 1): 0.6566"

8. Comparación de la realidad con el modelo

# ------------------------------------------------------------------------------
# 7. GRÁFICA No3: REGRESIÓN LINEAL 
# ------------------------------------------------------------------------------
plot(x, y,
     main = "Gráfica No3: Regresión lineal entre Fósforo Total y Nitratos
     en el estudio de los cuerpos de agua en Europa",
     xlab = "(Fósforo Total) (mg/L)",
     ylab = "(Nitratos) (mg/L)",
     col = "skyblue",
     pch = 16,
     cex = 1.2,
     cex.main = 1,
     cex.lab = 1,
     cex.axis = 0.9,
     xlim = c(min(x, na.rm=TRUE)*1.05, max(x, na.rm=TRUE) * 0.95),
     ylim = c(min(y, na.rm=TRUE)*1.05, max(y, na.rm=TRUE) * 1.05),
     xaxs = "i", yaxs = "i")

abline(regresionlineal, col = "red", lwd = 2)

9. Test de bondad

r_valor <- cor(x, y, use = "complete.obs")
r_porcentaje <- r_valor * 100
r2_porcentaje <- summary(regresionlineal)$r.squared * 100

print(paste(" Coeficiente de correlación (%):", round(r_porcentaje, 2), "%"))

## [1] " Coeficiente de correlación (%): 87.22 %"

print(paste(" Coeficiente de determinación (R² %):", round(r2_porcentaje, 2), "%"))

## [1] " Coeficiente de determinación (R² %): 76.08 %"

10. Restricciones

#El modelo lineal es válido únicamente dentro del rango de concentraciones muestreadas, perdiendo confiabilidad al extrapolarse a escenarios extremos (aguas ultra-puras o sobresaturadas). Asimismo, su supuesto de linealidad estricta ignora los procesos ecológicos estacionales de saturación biológica y eutrofización real. Finalmente, su enfoque bivariado simplifica en exceso el ecosistema; el coeficiente $R^2$ obtenido en R demuestra que existe una variabilidad matemática en los Nitratos que el Fósforo Total no puede explicar, confirmando que la dinámica del agua depende críticamente de múltiples factores ambientales omitidos como el pH, la temperatura, el caudal y la escorrentía agrícola.

11. Estimaciones

 # ==============================================================================
# SECCIÓN 10: ESTIMACIONES ADAPTADAS AL MODELO DE REGRESIÓN
# ==============================================================================

fosforo_real <- 0.05  
fosforo_escala_calc <- log(fosforo_real)


intercepto_manual <- coef(regresionlineal)[1]
pendiente_manual  <- coef(regresionlineal)[2]

nitratos_escala_calc <- (pendiente_manual * fosforo_escala_calc) + intercepto_manual

nitratos_real_estimado <- exp(nitratos_escala_calc)

print(paste("Valor estimado en escala matemática:", round(nitratos_escala_calc, 4)))

## [1] "Valor estimado en escala matemática: 2.1632"

print(paste("Concentración real estimada de Nitratos:", round(nitratos_real_estimado, 4), "mg/L"))

## [1] "Concentración real estimada de Nitratos: 8.699 mg/L"

# ==============================================================================
# GRÁFICA N.º 3 CON RECUADRO PERFECTO Y VALORES REALES
# ==============================================================================

fosforo_real <- 0.05  
fosforo_escala_calc <- log(fosforo_real)

intercepto_manual <- coef(regresionlineal)[1]
pendiente_manual  <- coef(regresionlineal)[2]

nitratos_escala_calc <- (pendiente_manual * fosforo_escala_calc) + intercepto_manual
nitratos_real_estimado <- exp(nitratos_escala_calc)

fosforo_real_redondo  <- round(fosforo_real, 3)
nitratos_real_redondo <- round(nitratos_real_estimado, 2)

x_min <- min(x, na.rm=TRUE) - 0.5
x_max <- max(x, na.rm=TRUE) + 0.5
y_min <- min(y, na.rm=TRUE) - 0.5
y_max <- max(y, na.rm=TRUE) + 1.2  

plot(x, y,  
     type = "n",                                                    
     main = "Gráfica N.º 4: Modelo de Regresión Lineal con Estimación",  
     xlab = "Fósforo Total (mg/L)",  
     ylab = "Nitratos (mg/L)",
     xlim = c(x_min, x_max),
     ylim = c(y_min, y_max),
     xaxs = "r", yaxs = "r")

abline(regresionlineal, col = "red", lwd = 2)

segments(x0 = fosforo_escala_calc, y0 = y_min - 2, 
         x1 = fosforo_escala_calc, y1 = nitratos_escala_calc, 
         col = "gray60", lty = 2, lwd = 1.2)

segments(x0 = x_min - 2, y0 = nitratos_escala_calc, 
         x1 = fosforo_escala_calc, y1 = nitratos_escala_calc, 
         col = "gray60", lty = 2, lwd = 1.2)

# 5. Ejes
text(x = fosforo_escala_calc, y = y_min + 0.15, 
     labels = paste0(fosforo_real_redondo, " mg/L"), col = "blue", font = 2, pos = 4, cex = 0.7)

text(x = x_min + 0.05, y = nitratos_escala_calc, 
     labels = paste0(nitratos_real_redondo, " mg/L"), col = "blue", font = 2, pos = 3, cex = 0.7)

points(x = fosforo_escala_calc, y = nitratos_escala_calc, col = "blue", pch = 18, cex = 1.5)


txt_linea1 <- paste0("Est. Real: P = ", fosforo_real_redondo, " mg/L -> N = ", nitratos_real_redondo, " mg/L")
signo_intercepto <- ifelse(intercepto_manual >= 0, " + ", " ")
txt_linea2 <- paste0("Modelo: Y = ", round(pendiente_manual, 2), "X", signo_intercepto, round(intercepto_manual, 2))
textos_leyenda <- c(txt_linea1, txt_linea2)
ancho_perfecto <- max(strwidth(textos_leyenda, cex = 0.65))

legend(
  "topright",                                  
  legend = textos_leyenda,  
  col = c("blue", "red"),   
  lty = c(0, 1),         
  pch = c(18, NA),                        
  lwd = c(NA, 2),   
  bty = "o",           
  box.col = "black",   
  bg = "white",        
  cex = 0.65,          
  x.intersp = 0.4,     
  y.intersp = 0.8,     
  text.width = ancho_perfecto * 0.5 
)

12. Conclusión

En el análisis hidroquímico de la calidad del agua en Europa se observa una relación lineal positiva entre la concentración de Fósforo Total y la concentración de Nitratos. El modelo se describe mediante la ecuación: y = 0.66 x + 4.13 El modelo explica aproximadamente el 87 % de la variabilidad de la concentración de Nitratos, lo que indica una buena asociación entre ambas variables cinéticas de nutrientes. El porcentaje restante de la variabilidad puede atribuirse a otros factores físicos, químicos y geográficos que no fueron considerados en este modelo bivariado simple, tales como el oxígeno disuelto, el pH, la temperatura del cuerpo hídrico, el caudal del río o la escorrentía agrícola directa de la cuenca. Las restricciones se aplican para todo el dominio natural de las variables, siendo los resultados significativamente más confiables dentro del rango observado de los datos de las medianas de las estaciones de monitoreo europeas. Fuera de este rango, el modelo extrapola y puede no reflejar con total precisión la dinámica ecológica y fisicoquímica real de los ecosistemas acuáticos. ```