Modelo Lineal
Universidad Central del Ecuador
2026-06-17
1. Librerías
# -------------------------
# Cargar librerías
# -------------------------
library(gt)
library(dplyr)##
## 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, unionlibrary(htmltools)2.Leer datos
# -------------------------
# Cargar datos
# -------------------------
datos <- read.csv("waterPollution.csv",
sep = ",",
stringsAsFactors = FALSE)3. Selección (causa y efecto)
# ================================
# SELECCIÓN Y SEPARACIÓN
# ================================
#Justificaciòn
#El fósforo total y los nitratos fueron seleccionados por ser indicadores representativos de la contaminación por nutrientes en cuerpos de agua. El análisis conjunto de ambas variables permite evaluar si existe una relación estadística entre la concentración de fósforo total (causa) y la concentración de nitratos (efecto).
datos$resultMeanValue <- as.numeric(gsub("-", NA, datos$resultMeanValue))
# Filtrado de códigos de propiedades observadas y selección de columnas clave
fosforo <- datos %>%
filter(observedPropertyDeterminandCode == "CAS_7723-14-0") %>%
select(waterBodyIdentifier, phenomenonTimeReferenceYear, X_val = resultMeanValue)
nitratos <- datos %>%
filter(observedPropertyDeterminandCode == "CAS_14797-55-8") %>%
select(waterBodyIdentifier, phenomenonTimeReferenceYear, Y_val = resultMeanValue)
# Unión interna para emparejar por cuerpo de agua y año
datos_pareados <- inner_join(fosforo, nitratos, by = c("waterBodyIdentifier", "phenomenonTimeReferenceYear"))## Warning in inner_join(fosforo, nitratos, by = c("waterBodyIdentifier", "phenomenonTimeReferenceYear")): Detected an unexpected many-to-many relationship between `x` and `y`.
## ℹ Row 28 of `x` matches multiple rows in `y`.
## ℹ Row 64 of `y` matches multiple rows in `x`.
## ℹ If a many-to-many relationship is expected, set `relationship =
## "many-to-many"` to silence this warning.4. Tabla de pares de valores
# ================================
# TABLA DE PARES DE VALORES
# ================================
datos_pareados$X_val <- as.numeric(gsub("-", NA, datos_pareados$X_val))
datos_pareados$Y_val <- as.numeric(gsub("-", NA, datos_pareados$Y_val))
datos_tabla_limpia <- datos_pareados[complete.cases(datos_pareados$X_val, datos_pareados$Y_val), ]
tabla_valores <- datos_tabla_limpia %>%
transmute(
Observación = row_number(),
`(X) Fósforo Total (mg/L)` = round(X_val, 4),
`(Y) Nitratos (mg/L)` = round(Y_val, 4)
)
tabla_gt <- tabla_valores %>%
gt() %>%
tab_header(
title = "Tabla 1. Pares de valores observados de fósforo total y nitratos"
) %>%
tab_source_note(
source_note = "Fuente: Grupo 3."
) %>%
cols_align(
align = "center",
columns = everything()
)
browsable(
div(
style = "height:400px; overflow-y:auto; border:1px solid #ddd;",
HTML(as_raw_html(tabla_gt))
)
)| Tabla 1. Pares de valores observados de fósforo total y nitratos | ||
| Observación | (X) Fósforo Total (mg/L) | (Y) Nitratos (mg/L) |
|---|---|---|
| Fuente: Grupo 3. | ||
5.Gráfica de Dispersión
# ------------------------------------------------------------------------------
# 4. GRÁFICA DE DISPERSIÓN
# ------------------------------------------------------------------------------
x_crudo <- log(datos_tabla_limpia$X_val)
Y_crudo <- log(datos_tabla_limpia$Y_val)
plot(x_crudo, Y_crudo,
main = "Gráfica No 1: Diagrama de dispersión entre el Fósforo Total y\nNitratos en el estudio de los cuerpos de agua de Europa",
xlab = "Fósforo Total (mg/L)",
ylab = "Nitratos (mg/L)",
col = rgb(135, 206, 235, maxColorValue = 255, alpha = 90),
pch = 16,
cex = 0.9,
xlim = c(-5.5, -1.2),
ylim = c(-1.5, 3.8),
xaxt = "n",
yaxt = "n",
xaxs = "r", yaxs = "r")
marcas_x_log <- c(-5, -4, -3, -2)
valores_x_reales <- round(exp(marcas_x_log), 4)
axis(side = 1, at = marcas_x_log, labels = valores_x_reales, cex.axis = 0.8)
marcas_y_log <- c(-1, 0, 1, 2, 3)
valores_y_reales <- round(exp(marcas_y_log), 2)
axis(side = 2, at = marcas_y_log, labels = valores_y_reales, cex.axis = 0.8, las = 1)
6. Tratamiento de Datos
# ================================
# TRATAMIENTO DE LOS DATOS
# ================================
datos_filtrados <- datos_tabla_limpia
if (nrow(datos_tabla_limpia) > 5) {
Q1_X <- quantile(datos_tabla_limpia$X_val, 0.25, na.rm = TRUE)
Q3_X <- quantile(datos_tabla_limpia$X_val, 0.75, na.rm = TRUE)
IQR_X <- Q3_X - Q1_X
Q1_Y <- quantile(datos_tabla_limpia$Y_val, 0.25, na.rm = TRUE)
Q3_Y <- quantile(datos_tabla_limpia$Y_val, 0.75, na.rm = TRUE)
IQR_Y <- Q3_Y - Q1_Y
lin_inf_X <- Q1_X - 1.5 * IQR_X
lin_sup_X <- Q3_X + 1.5 * IQR_X
lin_inf_Y <- Q1_Y - 1.5 * IQR_Y
lin_sup_Y <- Q3_Y + 1.5 * IQR_Y
candidatos <- datos_tabla_limpia[
datos_tabla_limpia$X_val >= lin_inf_X & datos_tabla_limpia$X_val <= lin_sup_X &
datos_tabla_limpia$Y_val >= lin_inf_Y & datos_tabla_limpia$Y_val <= lin_sup_Y,
]
if (nrow(candidatos) > 0) {
datos_filtrados <- candidatos
}
}
# Verificación de ceros (requisito para logaritmo)
sum(datos_filtrados$X_val == 0)## [1] 0sum(datos_filtrados$Y_val == 0)## [1] 0# Redondeo y agregación por promedio para extraer la tendencia central (suavizado)
datos_filtrados$X_val_red <- round(datos_filtrados$X_val, 2)
datos_prom <- aggregate(
Y_val ~ X_val_red,
data = datos_filtrados,
FUN = mean,
na.rm = TRUE
)
# Variables definitivas en escala logarítmica para el modelo final
x <- log(datos_prom$X_val_red)
y <- log(datos_prom$Y_val)7. Gráfica Simplificada
# ------------------------------------------------------------------------------
# Grafica Simplificada
# ------------------------------------------------------------------------------
plot(x, y,
main = "Gráfica No 2: Diagrama simplificado entre Fósforo Total y Nitratos
en el estudio de los cuerpos de agua en Europa",
xlab = "Fósforo Total (mg/L)",
ylab = "Nitratos (mg/L)",
col = "skyblue",
pch = 16,
cex = 1.3,
xaxt = "n",
yaxt = "n")
marcas_x_log2 <- seq(-4.5, -1.5, by = 0.5)
valores_x_reales2 <- round(exp(marcas_x_log2), 4)
axis(side = 1, at = marcas_x_log2, labels = valores_x_reales2, cex.axis = 0.7, las = 1)
marcas_y_log2 <- seq(0.5, 3.0, by = 0.5)
valores_y_reales2 <- round(exp(marcas_y_log2), 1)
axis(side = 2, at = marcas_y_log2, labels = valores_y_reales2, cex.axis = 0.7, las = 1)
## COMENTARIO:
#Cabe destacar que analizando la distribución de la variable causa, el gráfico podría trabajarse bajo un enfoque segmentado en dos secciones distintas: una que abarca desde un Fósforo Total de 0 hasta 0.0183 mg/L, y una segunda sección que se extiende de 0.0183 hasta 0.2231 mg/L. Sin embargo, se determinó mantener una única estructura de linealidad global para toda la gráfica. Esto evita complejizar innecesariamente el modelo únicamente por la influencia o ajuste puntual de un solo valor aislado en el origen.8. Conjetura
#La nube de puntos presenta una tendencia creciente y lineal, sin evidenciar patrones curvilíneos dominantes, lo que sugiere que un modelo de regresión lineal resulta adecuado para describir la relación entre ambas variables. Aunque los miles de datos crudos muestran una dispersión caótica por el ruido ambiental, al estabilizar la varianza y extraer la tendencia centra, la masa de datos se reduce a una trayectoria nítida de puntos representativos. 9. Cálculo de parámetros
# ========================
# CÁLCULO DE PARÁMETROS
# ========================
regresionlineal <- lm(y ~ x)
intercepto <- coef(regresionlineal)[1]
pendiente <- coef(regresionlineal)[2]
print(paste("Intercepto (beta 0):", round(intercepto, 4)))## [1] "Intercepto (beta 0): 4.1303"print(paste("Pendiente (beta 1):", round(pendiente, 4)))## [1] "Pendiente (beta 1): 0.6566"Modelo de Regresión Lineal obtenido
Y = β
0
+ β
1
* X
(Donde Y = Nitratos y X = Fósforo Total en mg/L)
Significado de los parámetros:
- β 0 (Intercepto): Representa el valor basal teórico. Indica el valor de la concentración de Nitratos esperado si el valor del Fósforo Total fuese cero en la escala del modelo.
- β 1 (Pendiente / Elasticidad): Determina la tasa de cambio ambiental. Indica cuánto aumenta, en promedio, el valor de la concentración de Nitratos (mg/L) por cada incremento unitario en el valor de Fósforo Total.
10. Comparación de la realidad con el modelo
plot(x, y,
main = "Gráfica No 3: Regresión lineal entre Fósforo Total y Nitratos\nen el estudio de los cuerpos de agua en Europa",
xlab = "Fósforo Total (mg/L)",
ylab = "Nitratos (mg/L)",
col = "skyblue",
pch = 16,
cex = 1.3,
xaxt = "n",
yaxt = "n")
abline(regresionlineal, col = "red", lwd = 2)
axis(side = 1, at = marcas_x_log2, labels = valores_x_reales2, cex.axis = 0.7, las = 1)
axis(side = 2, at = marcas_y_log2, labels = valores_y_reales2, cex.axis = 0.7, las = 1)
11. Test de bondad
# =================
# TEST DE BONDAD
# =================
r_valor <- cor(x, y, use = "complete.obs")
r_porcentaje <- r_valor * 100
r2_porcentaje <- summary(regresionlineal)$r.squared * 100
print(paste(" Coeficiente de correlación (%):", round(r_porcentaje, 2), "%"))## [1] " Coeficiente de correlación (%): 87.22 %"print(paste(" Coeficiente de determinación (R² %):", round(r2_porcentaje, 2), "%"))## [1] " Coeficiente de determinación (R² %): 76.08 %"12. Restricciones
# Dominio [X]:
# D = {x ∈ R+ U 0 }
# Dominio [Y]:
# D = {y ∈ R+ U 0 }
# ¿Existe algún valor en el dominio de X que, sustituido en el modelo matemático,
# genere un valor en Y fuera de su dominio?
#
# No. Al evaluar el modelo matemático dentro del dominio observado del Fósforo Total , las concentraciones estimadas de Nitratos permanecen dentro de su dominio observado. Por ello, el modelo no genera valores fuera del rango de los datos cuando se utiliza dentro de su dominio de aplicación.13. Estimaciones
#=================
# ESTIMACIONES
#=================
### Pregunta
# ¿Cuál es la concentración estimada de Nitratos cuando la concentración
# de Fósforo Total es de 0.05 mg/L, según el modelo lineal obtenido?
#--------------------------------------------------------------------------
# Valor de X para realizar la estimación
#--------------------------------------------------------------------------
fosforo_real <- 0.05
# Valor en la escala del modelo
fosforo_modelo <- log(fosforo_real)
#--------------------------------------------------------------------------
# Parámetros del modelo lineal
#--------------------------------------------------------------------------
intercepto <- coef(regresionlineal)[1]
pendiente <- coef(regresionlineal)[2]
#--------------------------------------------------------------------------
# Estimación
#--------------------------------------------------------------------------
nitratos_modelo <- intercepto + pendiente * fosforo_modelo
nitratos_real <- exp(nitratos_modelo)
# RESPUESTA
# Al sustituir X = 0.05 mg/L en el modelo lineal se obtiene una concentración
# estimada de Nitratos de 8.70 mg/L.
#==============================================================================
# GRÁFICA No. 4: MODELO LINEAL CON ESTIMACIÓN (EJES CORREGIDOS A VALORES REALES)
#==============================================================================
# 1. Parámetros y cálculos previos
fosforo_real <- 0.05
fosforo_modelo <- log(fosforo_real)
intercepto <- coef(regresionlineal)[1]
pendiente <- coef(regresionlineal)[2]
nitratos_modelo <- intercepto + pendiente * fosforo_modelo
nitratos_real <- exp(nitratos_modelo)
# Configuración de límites del lienzo
x_min <- min(x, na.rm = TRUE) - 0.5
x_max <- max(x, na.rm = TRUE) + 0.5
y_min <- min(y, na.rm = TRUE) - 0.5
y_max <- max(y, na.rm = TRUE) + 1.2
# 2. Lienzo base desactivando los ejes automáticos (xaxt="n", yaxt="n")
plot(
x,
y,
type = "n",
main = "Gráfica No. 4: Modelo de Regresión Lineal con Estimación",
xlab = "Fósforo Total (mg/L)",
ylab = "Nitratos (mg/L)",
xlim = c(x_min, x_max),
ylim = c(y_min, y_max),
xaxt = "n", # Desactiva eje X automático
yaxt = "n", # Desactiva eje Y automático
xaxs = "r",
yaxs = "r"
)
# 3. Recta del modelo (Roja)
abline(regresionlineal, col = "red", lwd = 2)
# 4. Líneas auxiliares delgadas
segments(x0 = fosforo_modelo, y0 = y_min - 2, x1 = fosforo_modelo, y1 = nitratos_modelo, col = "gray60", lty = 2)
segments(x0 = x_min - 2, y0 = nitratos_modelo, x1 = fosforo_modelo, y1 = nitratos_modelo, col = "gray60", lty = 2)
# 5. Punto estimado (Rombo Azul)
points(fosforo_modelo, nitratos_modelo, col = "blue", pch = 18, cex = 1.6)
# 6. Etiquetas azules de proyección (Valores reales)
text(fosforo_modelo, y_min + 0.15, labels = paste0(fosforo_real, " mg/L"), col = "blue", font = 2, pos = 4, cex = 0.7)
text(x_min + 0.05, nitratos_modelo, labels = paste0(round(nitratos_real, 2), " mg/L"), col = "blue", pos = 3, font = 2, cex = 0.7)
# 7. CONSTRUCCIÓN DE EJES PERSONALIZADOS EN VALORES REALES
# Eje X
marcas_x_log <- seq(-5, -1, by = 1)
valores_x_reales <- round(exp(marcas_x_log), 4)
axis(side = 1, at = marcas_x_log, labels = valores_x_reales, cex.axis = 0.75)
# Eje Y
marcas_y_log <- seq(0, 4, by = 1)
valores_y_reales <- round(exp(marcas_y_log), 1)
axis(side = 2, at = marcas_y_log, labels = valores_y_reales, cex.axis = 0.75, las = 1)
# 8. CONSTRUCCIÓN DE LEYENDA COMPACTA AUTO-AJUSTADA
txt1 <- paste0("Estimación: X = ", fosforo_real, " mg/L → Y = ", round(nitratos_real, 2), " mg/L")
txt2 <- paste0("Modelo: Y = ", round(intercepto, 4), " + ", round(pendiente, 4), "X")
textos_leyenda <- c(txt1, txt2)
# Calculamos el ancho exacto del texto para ajustar la caja
ancho_perfecto <- max(strwidth(textos_leyenda, cex = 0.65))
legend(
"topright",
legend = textos_leyenda,
col = c("blue", "red"),
pch = c(18, NA),
lty = c(0, 1),
lwd = c(NA, 2),
bty = "o",
box.col = "black",
bg = "white",
cex = 0.65,
x.intersp = 0.4,
y.intersp = 0.8,
text.width = ancho_perfecto * 1.15
)
## INTERPRETACIÓN:
## La recta roja representa el modelo de regresión lineal ajustado a los datos.El punto azul muestra la estimación realizada para una concentración de Fósforo Total de 0.05 mg/L. Según el modelo, la concentración esperada de Nitratos es de aproximadamente 8.70 mg/L.14. Conclusión
Entre la concentración de fósforo total y nitratos existe una relación lineal positiva, representada por la ecuación Y = 4.1303 + 0.6566X. El modelo presentó un coeficiente de correlación del 87.22% y un coeficiente de determinación del 76.08 %. El modelo no presenta restricciones dentro del dominio.