# 1. Cargar datos
setwd("C:/Users/LENOVO/OneDrive/Escritorio/ESTADISTICA")
datos <- read.csv("china_water_pollution_data.csv")
# Convertir a numérico
datos$Water_Temperature_C <- as.numeric(datos$Water_Temperature_C)
datos$pH <- as.numeric(datos$pH)
datos$Nitrate_mg_L <- as.numeric(datos$Nitrate_mg_L)
# Eliminar NAs
datos_limpios <- na.omit(datos[, c(
"Water_Temperature_C",
"pH",
"Nitrate_mg_L"
)])
# Función para eliminar outliers (IQR)
eliminar_outliers <- function(x) {
q1 <- quantile(x, 0.25)
q3 <- quantile(x, 0.75)
iqr <- q3 - q1
lim_inf <- q1 - 1.5 * iqr
lim_sup <- q3 + 1.5 * iqr
x >= lim_inf & x <= lim_sup
}
# Aplicar filtro a todas las columnas
filtro <- with(datos_limpios,
eliminar_outliers(Water_Temperature_C) &
eliminar_outliers(pH) &
eliminar_outliers(Nitrate_mg_L))
datos_limpios <- datos_limpios[filtro, ]
# Agregar columnas transformadas
datos_limpios$LOG_TEMP <- log(datos_limpios$Water_Temperature_C + 1)
datos_limpios$LOG_pH <- log(datos_limpios$pH + 1)
datos_limpios$LOG_NITRATE <- log(datos_limpios$Nitrate_mg_L + 1)
# 2. Modelo de regresión múltiple
modelo_nitratos <- lm(
Nitrate_mg_L ~ Water_Temperature_C + pH,
data = datos_limpios
)
summary(modelo_nitratos)
##
## Call:
## lm(formula = Nitrate_mg_L ~ Water_Temperature_C + pH, data = datos_limpios)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.37131 -0.34451 0.00349 0.33282 1.37097
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.978106 0.138893 14.242 <2e-16 ***
## Water_Temperature_C -0.002859 0.001924 -1.486 0.137
## pH 0.008626 0.018942 0.455 0.649
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.4923 on 2921 degrees of freedom
## Multiple R-squared: 0.0008251, Adjusted R-squared: 0.000141
## F-statistic: 1.206 on 2 and 2921 DF, p-value: 0.2995
# Intervalos y resumen de datos
min_x1 <- min(datos_limpios$LOG_TEMP)
max_x1 <- max(datos_limpios$LOG_TEMP)
min_x2 <- min(datos_limpios$LOG_pH)
max_x2 <- max(datos_limpios$LOG_pH)
min_y <- min(datos_limpios$Nitrate_mg_L)
max_y <- max(datos_limpios$Nitrate_mg_L)
n <- nrow(datos_limpios)
tabla_intervalos <- data.frame(
"Min.x1" = min_x1, "Max.x1" = max_x1,
"Min.x2" = min_x2, "Max.x2" = max_x2,
"Min.y" = min_y, "Max.y" = max_y,
"N" = n
)
library(knitr)
## Warning: package 'knitr' was built under R version 4.5.2
kable(tabla_intervalos, format = "markdown",
caption = "Tabla 1: Resumen de depuración")
Tabla 1: Resumen de depuración
| 2.128232 |
3.530763 |
1.906575 |
2.235376 |
0.62 |
3.34 |
2924 |
# Modelo con logaritmos
modelo_log <- lm(
LOG_NITRATE ~ LOG_TEMP + LOG_pH,
data = datos_limpios
)
summary(modelo_log)
##
## Call:
## lm(formula = LOG_NITRATE ~ LOG_TEMP + LOG_pH, data = datos_limpios)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.59895 -0.10835 0.01556 0.12027 0.39464
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.09073 0.11625 9.382 <2e-16 ***
## LOG_TEMP -0.02016 0.01322 -1.526 0.127
## LOG_pH 0.02327 0.05240 0.444 0.657
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.1702 on 2921 degrees of freedom
## Multiple R-squared: 0.0008644, Adjusted R-squared: 0.0001802
## F-statistic: 1.263 on 2 and 2921 DF, p-value: 0.2828
# 3. Extraemos las variables después del filtrado
x1 <- datos_limpios$LOG_TEMP
x2 <- datos_limpios$LOG_pH
y_pre <- fitted(modelo_log)
library(scatterplot3d)
## Warning: package 'scatterplot3d' was built under R version 4.5.2
# Regresión lineal múltiple
modelo_pred <- lm(y_pre ~ x1 + x2)
# Crear etiquetas del eje Z con dos decimales (0.50, 1.00, etc.)
z_ticks <- pretty(y_pre)
z_labels <- format(round(z_ticks, 2), nsmall = 2)
graf <- scatterplot3d(
x1, x2, y_pre,
main = "Gráfica Nº 1: Diagrama de dispersión entre la temperatura, el pH
y la concentración de nitratos",
xlab = "Temperatura del agua (°C)",
ylab = "pH (adimensional)",
zlab = "Concentración de nitratos (mg/L)",
angle = 310,
color = "red",
pch = 16,
z.ticklabs = z_labels
)
graf$plane3d(modelo_pred, col = "black")
# 4.TEST
r <- cor(y_pre, x1 + x2) * 100
r
## [1] -86.26328
# Coeficiente de determinación
r2 <- (cor(y_pre, x1 + x2)^2) * 100
print(paste("Coeficiente de determinación:", round(r2, 2), "%"))
## [1] "Coeficiente de determinación: 74.41 %"
# 5. Mostrar ecuación múltiple
b0 <- coef(modelo_log)[1]
b1 <- coef(modelo_log)[2]
b2 <- coef(modelo_log)[3]
plot(1, type = "n", axes = FALSE, xlab = "", ylab = "")
text(1, 1,
labels = paste0(
"Ecuación múltiple:\n",
"Y = a + b1*x1 + b2*x2\n",
"Y = ", round(b0, 2),
" + ", round(b1, 2), "*x1",
" + ", round(b2, 2), "*x2"
),
cex = 1.8,
col = "blue",
font = 6
)
# 6. Restricciones :
# y>=0, x1>0 , x2 >= 0
# Estimaciones
cat("\n¿CUÁL SERÁ LA CONCENTRACIÓN DE NITRATOS CUANDO LA TEMPERATURA DEL AGUA ES 20 °C Y EL pH ES 7?\n")
##
## ¿CUÁL SERÁ LA CONCENTRACIÓN DE NITRATOS CUANDO LA TEMPERATURA DEL AGUA ES 20 °C Y EL pH ES 7?
# Nuevos valores
x1_new <- 20 # Water_Temperature_C
x2_new <- 7 # pH
# Transformación logarítmica
log_x1 <- log(x1_new + 1)
log_x2 <- log(x2_new + 1)
# Estimación usando la ecuación múltiple ya definida
y_new <- b0 + b1 * log_x1 + b2 * log_x2
y_new <- max(0, y_new)
cat(paste("Respuesta: Nitratos ≈", round(y_new, 4), "mg/L\n"))
## Respuesta: Nitratos ≈ 1.0777 mg/L
# 7. Conclusión
# Entre la concentración de nitratos (mg/L), la temperatura del agua (°C)
# y el pH del agua existe una relación de tipo múltiple, representada por
# la ecuación Y = 1.09 − 0.02x1 + 0.02x2, donde Y corresponde al logaritmo
# de la concentración de nitratos, x1 al logaritmo de la temperatura del
# agua y x2 al logaritmo del pH.
# Los resultados indican que la temperatura y el pH explican el
# 74.41 % de la variabilidad en la concentración de nitratos, mientras
# que el 25.59 % depende de otros factores no considerados en el modelo,
# como factores externos y condiciones propias del sistema acuático.