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
# 1. Cargar datos
setwd("C:/Users/LENOVO/OneDrive/Escritorio/ESTADISTICA")
datos <- read.csv("china_water_pollution_data.csv")
datos_sel <- datos %>%
select(pH, Dissolved_Oxygen_mg_L)
# 2. Depuración de datos: eliminación de atípicos (IQR) y agrupación por bins.
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 # tamaño del bin (puedes cambiarlo)
)
)
)
# 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)
# 3. Definir variables de análisis: pH (x) y oxígeno disuelto (y)
x <- datos_resumen$pH_mediana
y <- datos_resumen$Oxigeno_mediana
# 3. Resumen de datos agrupados por bins de pH con medianas y frecuencias.
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
# 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(
datos_resumen$pH_mediana,
datos_resumen$Oxigeno_mediana,
pch = 19,
xlab = "pH",
ylab = "Oxígeno disuelto (mg/L)",
main = "Relación pH vs Oxígeno (datos agrupados)"
)
# 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
# Extraer coeficientes reales del modelo grado 2
beta0 <- regrespoli$coefficients[1] # intercepto
beta1 <- regrespoli$coefficients[2] # x
beta2 <- regrespoli$coefficients[3] # x^2
# Renombrar si quieres usar notación a, b, c
a <- beta0
b <- beta1
c <- beta2
a
## (Intercept)
## 14.69854
b
## x
## -1.847812
c
## xcuad
## 0.1269502
plot(
x, y,
col = "deepskyblue",
main = "Gráfica: Diagrama de dispersión con regresión polinómica",
xlab = "pH",
ylab = "Oxígeno disuelto (mg/L)",
pch = 16
)
curve(
a + b*x + c*x^2,
from = min(x),
to = max(x),
add = TRUE,
col = "blue",
lwd = 2
)
# 6. Test
r2 <- summary(regrespoli)$r.squared * 100
cat("R² polinómico grado 2 =", round(r2, 2), "%\n")
## R² polinómico grado 2 = 73.75 %
coef_pol <- c(c, b, a)
raices <- polyroot(coef_pol)
raices_reales <- Re(raices[abs(Im(raices)) < 1e-6])
raices_reales
## numeric(0)
# 7. Restricciones del modelo
# El modelo solo es válido para valores de pH entre 5.9 y 8.1.
# No se recomienda extrapolar fuera de este intervalo.
# Dentro del intervalo no existen restricciones adicionales.
# Estimación puntual de calidad del agua
# ================================
ph_objetivo <- 7.2
ox_est <- a + b*ph_objetivo + c*ph_objetivo^2
plot(1, type = "n", axes = FALSE, xlab = "", ylab = "")
text(
x = 1, y = 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.4,
col = "blue",
font = 2
)
# 8. 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 8.00 mg/L."