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))

# Filtrado de códigos de propiedades observadas y selección de columnas clave
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)

# Unión interna para emparejar por cuerpo de agua y año
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.
#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, se busca comprobar estadísticamente si el aumento de uno se relaciona de forma directa con el comportamiento del otro en las cuencas.

4. Tratamiento de Datos

# ------------------------------------------------------------------------------
# 4. TRATAMIENTO DE DATOS
# ------------------------------------------------------------------------------

# 4.1. Limpieza inicial y coerción de tipos
datos_pareados$X_val <- as.numeric(gsub("-", NA, datos_pareados$X_val))
datos_pareados$Y_val <- as.numeric(gsub("-", NA, datos_pareados$Y_val))

# Eliminar casos incompletos en las variables de interés
datos_pareados <- datos_pareados[complete.cases(datos_pareados$X_val, datos_pareados$Y_val), ]

# 4.2. Identificación y eliminación de valores atípicos mediante IQR
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
  }
}

# 4.3. Reducción por promedios y Transformación Logarítmica (Linealización)
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)

# Aplicación de logaritmo natural
x <- log(datos_prom$X_val_red)
y <- log(datos_prom$Y_val)

5. Tabla de pares de valores

# 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: Grupo 3."
  ) %>%
  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: Grupo 3.

6.Gráfica de Dispersión

6.1 Gráfica de Dispersión General

# ==============================================================================
# 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), 
     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")

6.2 Gráfica de Dispersión Ajustada

# ------------------------------------------------------------------------------
# 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")

7. Conjetura

#La distribución de los puntos en el diagrama de dispersión sugiere un modelo lineal. A medida que la concentración de fósforo total aumenta, la concentración de nitratos también lo hace de manera proporcional. Los puntos tienden a alinearse siguiendo una pendiente positiva, lo que indica que se puede ajustar una recta de regresión lineal para describir matemáticamente la relación causa-efecto entre ambas variables en los cuerpos de agua de Europa.

8. Cálculo de parámetros

# ------------------------------------------------------------------------------
# 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"

9. Comparación de la realidad con el modelo

# ------------------------------------------------------------------------------
# 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)

10. 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 %"

11. Restricciones

## Dominio [X]:

# D = {x ∈ R | 0.0057 mg/L ≤ x ≤ 0.253333 mg/L}

# Dominio [Y]:

# D = {y ∈ R | 0.20984 mg/L ≤ y ≤ 43.60117 mg/L}

# ¿Existe algún valor en el dominio de X que, sustituido en el modelo matemático,
# genere un valor en Y fuera de su dominio?

# No existe ningún valor del dominio del Fósforo Total (X ≥ 0.0057$) que genere un valor de Nitratos fuera de su dominio. Físicamente, las concentraciones de nutrientes no pueden ser negativas. Dado que el modelo presenta un intercepto positivo de 4.1303 y una pendiente positiva de 0.6566, cualquier valor de Fósforo Total mayor o igual a cero producirá una concentración estimada de Nitratos positiva. Por lo tanto, el modelo matemático respeta las restricciones de la realidad y no genera valores incompatibles con el comportamiento de los componentes evaluados.

12. Estimaciones

 #==============================================================================
# ESTIMACIONES
#==============================================================================

### Pregunta

# ¿Cuál es la concentración estimada de Nitratos cuando la concentración
# de Fósforo Total es de 0.05 mg/L, según el modelo lineal obtenido?

#--------------------------------------------------------------------------
# Valor de X para realizar la estimación
#--------------------------------------------------------------------------

fosforo_real <- 0.05

# Valor en la escala del modelo
fosforo_modelo <- log(fosforo_real)

#--------------------------------------------------------------------------
# Parámetros del modelo lineal
#--------------------------------------------------------------------------

intercepto <- coef(regresionlineal)[1]
pendiente  <- coef(regresionlineal)[2]

#--------------------------------------------------------------------------
# Estimación
#--------------------------------------------------------------------------

nitratos_modelo <- intercepto + pendiente * fosforo_modelo

nitratos_real <- exp(nitratos_modelo)

# RESPUESTA
# Al sustituir X = 0.05 mg/L en el modelo lineal se obtiene una concentración
# estimada de Nitratos de 8.70 mg/L.

#==============================================================================
# GRÁFICA No. 4
# MODELO LINEAL CON ESTIMACIÓN
#==============================================================================

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

# Recta del modelo
abline(regresionlineal,
       col = "red",
       lwd = 2)

# Líneas auxiliares

segments(
  x0 = fosforo_modelo,
  y0 = y_min,
  x1 = fosforo_modelo,
  y1 = nitratos_modelo,
  col = "gray60",
  lty = 2
)

segments(
  x0 = x_min,
  y0 = nitratos_modelo,
  x1 = fosforo_modelo,
  y1 = nitratos_modelo,
  col = "gray60",
  lty = 2
)

# Punto estimado

points(
  fosforo_modelo,
  nitratos_modelo,
  col = "blue",
  pch = 18,
  cex = 1.6
)

# Etiquetas

text(
  fosforo_modelo,
  y_min + 0.15,
  labels = paste0(fosforo_real, " mg/L"),
  col = "blue",
  font = 2,
  cex = 0.8
)

text(
  x_min + 0.05,
  nitratos_modelo,
  labels = paste0(round(nitratos_real,2), " mg/L"),
  col = "blue",
  pos = 3,
  font = 2,
  cex = 0.8
)

#--------------------------------------------------------------------------
# Leyenda (Opción Estándar)
#--------------------------------------------------------------------------

txt1 <- paste0(
  "Estimación: X = ",
  fosforo_real,
  " mg/L → Y = ",
  round(nitratos_real,2),
  " mg/L"
)

txt2 <- paste0(
  "Modelo: Y = ",
  round(intercepto,2),
  " + ",
  round(pendiente,2),
  "X"
)

legend(
  "topright",
  legend = c(txt1, txt2),
  col = c("blue","red"),
  pch = c(18,NA),
  lty = c(0,1),
  lwd = c(NA,2),
  bty = "o",
  bg = "white",
  cex = 0.75
)

## INTERPRETACIÓN:
## La recta roja representa el modelo de regresión lineal ajustado a los datos.
## El punto azul muestra la estimación realizada para una concentración de
## Fósforo Total de 0.05 mg/L. Según el modelo, la concentración esperada
## de Nitratos es de aproximadamente 8.70 mg/L.

13. Conclusión

Entre la concentración de fósforo total y nitratos existe una relación directamente proporcional de tipo lineal, regida por la ecuación Y = 4.1303 + 0.6566X, donde X representa la causa (fósforo total) y Y el efecto (nitratos). El modelo, es fuertemente respaldado por un coeficiente de correlación de Pearson del 87.22% y un coeficiente de determinación del 76.08%, demostrando que los cambios y aumentos en el Fósforo Total condicionan de manera directa el incremento de los Nitratos en las cuencas hidrográficas de Europa.