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)

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

4. Conjetura:

#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
regrespoli <- lm(y ~ x + xcuad)
summary(regrespoli)

## 
## Call:
## lm(formula = y ~ x + xcuad)
## 
## Residuals:
##         1         2         3         4         5         6 
## -0.000857 -0.006247 -0.009816  0.075091 -0.089157  0.030986 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)  
## (Intercept) 14.69854    2.73445   5.375   0.0126 *
## x           -1.84781    0.78668  -2.349   0.1004  
## xcuad        0.12695    0.05604   2.265   0.1084  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.06996 on 3 degrees of freedom
## Multiple R-squared:  0.7375, Adjusted R-squared:  0.5625 
## F-statistic: 4.214 on 2 and 3 DF,  p-value: 0.1345

a <- regrespoli$coefficients[1]
b <- regrespoli$coefficients[2]
c <- regrespoli$coefficients[3]

a

## (Intercept) 
##    14.69854

##         x 
## -1.847812

##     xcuad 
## 0.1269502

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