knitr::opts_chunk$set( echo = TRUE, warning = FALSE, message = FALSE )

1. Carga de datos

library(dplyr)

## Warning: package 'dplyr' was built under R version 4.5.2

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

setwd("C:/Users/LENOVO/OneDrive/Escritorio/ESTADISTICA")
datos <- read.csv("china_water_pollution_data.csv")

2. Depuración de datos: eliminación de atípicos (IQR) y agrupación por bins.

datos_sel <- datos %>%
  select(pH, Dissolved_Oxygen_mg_L)

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$pH) &
    quitar_atipicos_IQR(datos_sel$Dissolved_Oxygen_mg_L),
]

datos_binned <- datos_limpios %>%
  mutate(
    PH_BIN = cut(
      pH,
      breaks = seq(
        floor(min(pH)),
        ceiling(max(pH)),
        by = 0.5
      )
    )
  )
# Calcular medianas por bin
datos_resumen <- datos_binned %>%
  group_by(PH_BIN) %>%
  summarise(
    pH_mediana = median(pH, na.rm = TRUE),
    Oxigeno_mediana = median(Dissolved_Oxygen_mg_L, na.rm = TRUE),
    n = n()
  ) %>%
  filter(n >= 3)

datos_resumen

## # A tibble: 6 × 4
##   PH_BIN  pH_mediana Oxigeno_mediana     n
##   <fct>        <dbl>           <dbl> <int>
## 1 (5.5,6]       5.88            8.22    38
## 2 (6,6.5]       6.34            8.08   385
## 3 (6.5,7]       6.79            8.00  1010
## 4 (7,7.5]       7.23            8.05  1033
## 5 (7.5,8]       7.67            7.90   428
## 6 (8,8.5]       8.14            8.1     65

3. Definir variables de análisis: pH (x) y oxígeno disuelto (y)

El pH y el oxígeno disuelto se relacionan porque cuando hay más fotosíntesis aumentan ambos, y cuando hay respiración y descomposición disminuyen ambos.

x <- datos_resumen$pH_mediana
y <- datos_resumen$Oxigeno_mediana

4. Conjetura:

La gráfica indica que el oxígeno disuelto se mantiene relativamente estable frente a los cambios de pH, y se plantea un modelo polinómico porque los valores presentan ligeras variaciones no lineales, sin seguir una tendencia recta clara.

#A partir del diagrama de dispersión se observa una
# tendencia curvilínea entre el pH y el oxígeno disuelto,
# lo que sugiere el uso de un ajuste polinómico
plot(
  x, y,
  pch = 19,
  xlab = "pH",
  ylab = "Oxígeno disuelto (mg/L)",
   main = "Gráfica Nº 1: Relación entre el pH y el oxígeno disuelto",
  font.main = 2
)

5.Parámetros

xcuad <- x^2 #Calcula el término cuadrático de la variable independiente.
regrespoli <- lm(y ~ x + xcuad) #Ajusta un modelo de regresión polinómico de segundo grado entre x y y.


a <- regrespoli$coefficients[1] #Extrae el intercepto del modelo.
b <- regrespoli$coefficients[2] #Extrae el coeficiente lineal de x.
c <- regrespoli$coefficients[3] #Extrae el coeficiente cuadrático de X^2

a

## (Intercept) 
##    14.69854

##         x 
## -1.847812

##     xcuad 
## 0.1269502

# Ecuación del modelo
plot(1, type = "n", axes = FALSE, xlab = "", ylab = "")
text(
  x = 1, y = 1,
  labels = paste0(
    "Ecuación polinómica\n",
    "y = a + bx + cx^2\n",
    "y = ", round(a, 2), " + ", round(b, 2), "x + ", round(c, 2), "x^2"
  ),
  cex = 2,
  col = "blue",
  font = 2
)

5.1 Gráfica del modelo ajustado

plot(
  x, y,
  col = "deepskyblue",
  pch = 16,
  xlab = "pH",
  ylab = "Oxígeno disuelto (mg/L)",
  main = "Gráfica N.º 2: Diagrama de dispersión entre el pH y el oxígeno disuelto"
)

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

6. Test

6.1 Correlación Pearson

y_hat <- predict(regrespoli)
r <- cor(y, y_hat, method = "pearson")
r

## [1] 0.8587639

6.2 Coeficiente de determinación

r2 <- summary(regrespoli)$r.squared * 100
cat("R² polinómico grado 2 =", round(r2, 2), "%\n")

## R² polinómico grado 2 = 73.75 %

7. Restricciones del modelo

discriminante <- b^2 - 4*a*c
discriminante

##         x 
## -4.049517

coef_pol <- c(c, b, a)
raices <- polyroot(coef_pol)
raices_reales <- Re(raices[abs(Im(raices)) < 1e-6])
raices_reales

## numeric(0)

#Dado que el discriminante del polinomio es negativo, el modelo no presenta raíces reales y, por tanto, no existen restricciones reales asociadas al cruce con el eje x.El modelo solo es válido para valores de pH entre 5.9 y 8.1.

8. Estimación

ph_objetivo <- 7.2
ox_est <- a + b*ph_objetivo + c*ph_objetivo^2

plot(1, type = "n", axes = FALSE, xlab = "", ylab = "")
text(
  1, 1,
  labels = paste(
    "¿Cuál es la concentración esperada de oxígeno disuelto\n",
    "cuando el pH del agua es", ph_objetivo, "?\n\n",
    "Resultado estimado:",
    round(ox_est, 3), "mg/L"
  ),
  cex = 1.3,
  col = "blue",
  font = 2
)

9. Conclusión

“En el intervalo entre el pH y la concentración de oxígeno disuelto en los cuerpos de agua monitoreados en China existe una relación de tipo polinómica, representada por: ŷ = 14.69854 − 1.84781 * pH + 0.12695 * pH^2 Siendo pH el nivel de acidez/alcalinidad del agua y ŷ el oxígeno disuelto en mg/L. Dentro del intervalo seleccionado no existen restricciones. Se espera que, cuando el pH sea 7.2, se obtenga una concentración de oxígeno disuelto de aproximadamente 7.975 mg/L.”

Relación entre pH y Oxígeno Disuelto

Priscila Tandalla

2026-02-08