CARGA DE DATOS
datos <- read.csv2("china_water_pollution_data.csv",
stringsAsFactors = FALSE,
fileEncoding = "UTF-8")
to_numeric_coma <- function(x) as.numeric(gsub(",", ".", x))
datos <- datos %>%
mutate(
BOD_mg_L = to_numeric_coma(BOD_mg_L),
COD_mg_L = to_numeric_coma(COD_mg_L),
Ammonia_N_mg_L = to_numeric_coma(Ammonia_N_mg_L),
Total_Nitrogen_mg_L = to_numeric_coma(Total_Nitrogen_mg_L),
Total_Phosphorus_mg_L = to_numeric_coma(Total_Phosphorus_mg_L),
Turbidity_NTU = to_numeric_coma(Turbidity_NTU),
Coliform_Count_CFU_100mL = to_numeric_coma(Coliform_Count_CFU_100mL),
Water_Quality_Index = to_numeric_coma(Water_Quality_Index)
)
datos <- datos %>%
mutate(
Carga_Contaminante =
BOD_mg_L +
COD_mg_L +
Ammonia_N_mg_L +
Total_Nitrogen_mg_L +
Total_Phosphorus_mg_L +
Turbidity_NTU +
Coliform_Count_CFU_100mL / 1000
)
1. SELECCIONAR DOS VARIABLES CON CAUSA Y EFECTO
# X = Carga_Contaminante (causa)
# Y = Water_Quality_Index (efecto)
# Modelo: y = a + b*ln(x)
datos_sel <- datos %>%
select(Carga_Contaminante, Water_Quality_Index) %>%
filter(!is.na(Carga_Contaminante), !is.na(Water_Quality_Index)) %>%
filter(Carga_Contaminante > 0) # requisito para ln(x)
#DEPURACIÓN (IQR) + 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$Carga_Contaminante) &
quitar_atipicos_IQR(datos_sel$Water_Quality_Index),
]
# Bins para X
bin_width <- 10
datos_binned <- datos_limpios %>%
mutate(
CARGA_BIN = cut(
Carga_Contaminante,
breaks = seq(floor(min(Carga_Contaminante)),
ceiling(max(Carga_Contaminante)),
by = bin_width),
include.lowest = TRUE
)
)
# Medianas por bin
datos_resumen <- datos_binned %>%
group_by(CARGA_BIN) %>%
summarise(
Carga_mediana = median(Carga_Contaminante, na.rm = TRUE),
WQI_mediana = median(Water_Quality_Index, na.rm = TRUE),
n = n(),
.groups = "drop"
) %>%
filter(n >= 20)
# Definir variables finales
x <- datos_resumen$Carga_mediana
y <- datos_resumen$WQI_mediana
2. TABLA PARES DE VALORES (TPV)
TPV <- datos_resumen %>% select(Carga_mediana, WQI_mediana, n)
print(TPV)
## # A tibble: 4 × 3
## Carga_mediana WQI_mediana n
## <dbl> <dbl> <int>
## 1 21.2 48.1 204
## 2 28.8 51.0 1446
## 3 36.5 50.4 1115
## 4 45.7 52.1 178
3. GRÁFICA DE DISPERSIÓN
plot(
x, y,
pch = 19,
xlab = "Carga contaminante (mg/L)",
ylab = "Índice de calidad del agua",
main = "Gráfica Nº1: Diagrama de dispersión entre
la carga contaminante y el índice de calidad de
agua",
font.main = 2
)
4. CONJETURA
# Tendencia no lineal → modelo logarítmico: y = a + b ln(x)
5. CÁLCULO DE PARÁMETROS (MODELO LOGARÍTMICO)
x1 <- log(x)
regresionlogaritmica <- lm(y ~ x1)
a <- regresionlogaritmica$coefficients[1]
b <- regresionlogaritmica$coefficients[2]
a
## (Intercept)
## 34.26208
b
## x1
## 4.672847
summary(regresionlogaritmica)
##
## Call:
## lm(formula = y ~ x1)
##
## Residuals:
## 1 2 3 4
## -0.45965 1.07419 -0.63535 0.02081
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 34.262 5.725 5.985 0.0268 *
## x1 4.673 1.650 2.832 0.1053
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.9405 on 2 degrees of freedom
## Multiple R-squared: 0.8004, Adjusted R-squared: 0.7007
## F-statistic: 8.022 on 1 and 2 DF, p-value: 0.1053
# REPRESENTACIÓN DE LA ECUACIÓN LOGARÍTMICA
plot(1, type = "n", axes = FALSE, xlab = "", ylab = "")
text(
x = 1, y = 1.1,
labels = "Ecuación Logarítmica",
col = "blue",
cex = 2,
font = 2
)
text(
x = 1, y = 1,
labels = "y = a + b · ln(x)",
col = "blue",
cex = 1.8,
font = 2
)
text(
x = 1, y = 0.85,
labels = paste0(
"y = ",
round(a, 5),
" + ",
round(b, 6),
" · ln(x)"
),
col = "blue",
cex = 1.8,
font = 2
)
6. GRÁFICA MODELO VS REALIDAD
plot(x, y,
main = "Grafica N°2: Regresión logarítmica
entre carga contaminante y el índice de
calidad de agua",
xlab = "Carga contaminante (mg/L)",
ylab = "Índice de calidad de agua",
col = "grey",
pch = 16,
cex = 1.2,
cex.main = 1,
cex.lab = 1,
cex.axis = 0.9,
xlim = c(0, max(x)*1.05),
ylim = c(min(y)*0.95, max(y)*1.05))
curve(a + b * log(x),
n = 500,
add = TRUE,
col = "red",
lwd = 2)
7. TEST DE PEARSON
r <- cor(x1, y)
r
## [1] 0.8946717
r_porcentaje <- r * 100
r_porcentaje
## [1] 89.46717
8. COEFICIENTE DE DETERMINACIÓN
R2 <- r^2
R2
## [1] 0.8004374
R2_porcentaje <- R2 * 100
R2_porcentaje
## [1] 80.04374
summary(regresionlogaritmica)$r.squared * 100
## [1] 80.04374
9. RESTRICCIONES
#El dominio de la variable independiente es Dx=R+ debido a la presencia del logaritmo natural en el modelo, por
#lo que x > 0. El índice de calidad del agua se interpreta en el rango 0 ≤ y ≤ 100. Sin embargo, el modelo
#logarítmico ajustado solo es válido dentro del intervalo observado 21.185 ≤ 𝑥 ≤ 45.671, ya que fuera de este
#rango se incurriría en extrapolación y las predicciones perderían confiabilidad estadística.
10. APLICACIÓN DEL MODELO
carga_objetivo <- median(x, na.rm = TRUE)
if(carga_objetivo <= 0){
stop("carga_objetivo debe ser > 0 para usar ln(x)")
}
wqi_est <- a + b * log(carga_objetivo)
plot(1, type = "n", axes = FALSE, xlab = "", ylab = "")
text(
1, 1,
labels = paste(
"Pregunta:\n¿Cuál es el índice de calidad e
agua esperado\n",
"cuando la carga contaminante es",
round(carga_objetivo, 3), "?\n\n",
"Resultado estimado:",
round(wqi_est, 3)
),
cex = 1.2,
col = "blue",
font = 2
)
11. CONCLUSIÓN
#Entre la carga de contaminante y el índice de calidad de agua existe una relación de tipo logarítmica cuya
#ecuación matemática es y = 34.26208+4.672847*ln(x), siendo x = Carga de contaminante y y = Índice de calidad de
#agua, donde el índice de calidad de agua depende en un 89.46% de la carga de contaminante, y el 10.54% se debe a
#otros factores. El modelo presenta restricciones y funciona con carga de contaminante > 0 debido a la presencia
#del logaritmo natural, y es válido dentro del intervalo observado: 21.185 ≤ x ≤ 45.671. Fuera de este rango el
#modelo pierde confiabilidad estadística.