Modelo Lineal

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, union

2.Leer datos

# -------------------------
# Cargar datos
# -------------------------

datos <- read.csv("waterPollution.csv",
                  sep = ",",
                  stringsAsFactors = FALSE)

3. Selección (causa y efecto)

# ================================
# SELECCIÓN Y SEPARACIÓN
# ================================

#RAZÓ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. Tratamiento de Datos

# ------------------------------------------------------------------------------
# 4. TRATAMIENTO DE DATOS
# ------------------------------------------------------------------------------

# 4.1. Limpieza inicial y coerción de tipos
datos_pareados$X_val <- as.numeric(gsub("-", NA, datos_pareados$X_val))
datos_pareados$Y_val <- as.numeric(gsub("-", NA, datos_pareados$Y_val))

# Eliminar casos incompletos en las variables de interés
datos_pareados <- datos_pareados[complete.cases(datos_pareados$X_val, datos_pareados$Y_val), ]

# 4.2. Identificación y eliminación de valores atípicos mediante IQR
datos_filtrados <- datos_pareados

if (nrow(datos_pareados) > 5) {
  Q1_X <- quantile(datos_pareados$X_val, 0.25, na.rm = TRUE)
  Q3_X <- quantile(datos_pareados$X_val, 0.75, na.rm = TRUE)
  IQR_X <- Q3_X - Q1_X
  
  Q1_Y <- quantile(datos_pareados$Y_val, 0.25, na.rm = TRUE)
  Q3_Y <- quantile(datos_pareados$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_pareados[
    datos_pareados$X_val >= lin_inf_X & datos_pareados$X_val <= lin_sup_X &
    datos_pareados$Y_val >= lin_inf_Y & datos_pareados$Y_val <= lin_sup_Y,
  ]
  
  if (nrow(candidatos) > 0) {
    datos_filtrados <- candidatos
  }
}

# 4.3. Verificación de valores iguales a cero

sum(datos_filtrados$X_val == 0)

## [1] 0

sum(datos_filtrados$Y_val == 0)

## [1] 0

# No existen valores iguales a cero, por lo que es posible
# aplicar directamente la transformación logarítmica.

# 4.4. Transformación logarítmica

# Agrupar valores de Fósforo y obtener el promedio de Nitratos
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
)

# Transformación logarítmica
x <- log(datos_prom$X_val_red)
y <- log(datos_prom$Y_val)

5. Tabla de pares de valores

tabla_valores <- datos_filtrados %>%
  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 fosforo total y
    nitratos"
  ) %>%
  tab_source_note(
    source_note = "Fuente: Grupo 3."
  ) %>%
  cols_align(
    align = "center",
    columns = everything()
  )

tabla_gt

Tabla 1. Pares de valores observados de fosforo total y nitratos
Observación	(X) Fósforo Total (mg/L)	(Y) Nitratos (mg/L)
1	0.0133	2.4778
2	0.0567	5.9562
3	0.0483	5.2731
4	0.0825	22.8052
5	0.1433	15.0225
6	0.0692	4.5484
7	0.0208	3.5404
8	0.0208	3.3988
9	0.0450	18.8600
10	0.0408	2.6882
11	0.0663	37.2701
12	0.1108	5.2481
13	0.1108	5.5813
14	0.0338	3.4321
15	0.0200	0.9330
16	0.0833	7.2807
17	0.0833	6.0645
18	0.1383	4.4984
19	0.0600	40.9655
20	0.0133	0.9830
21	0.2467	12.7622
22	0.0688	26.4823
23	0.1865	28.3649
24	0.1119	19.0099
25	0.1261	17.7437
26	0.0274	18.5268
27	0.0839	24.4330
28	0.1147	19.0099
29	0.0822	23.3084
30	0.1025	29.1230
31	0.1050	18.2983
32	0.2278	25.7541
33	0.1217	18.3935
34	0.1225	18.1322
35	0.0142	2.0659
36	0.0333	10.6629
37	0.0333	3.1156
38	0.1100	1.7398
39	0.0383	31.7010
40	0.1333	5.1504
41	0.0517	2.2425
42	0.1251	21.4469
43	0.1167	19.7097
44	0.1595	17.8020
45	0.0676	2.5004
46	0.1267	9.3300
47	0.0850	5.9479
48	0.0983	7.2807
49	0.0983	6.0645
50	0.1351	28.2983
51	0.1100	9.6504
52	0.0200	1.4661
53	0.0300	4.9316
54	0.0266	8.8802
55	0.0266	7.4807
56	0.0133	0.5998
57	0.1467	6.9808
58	0.0483	1.5494
59	0.0200	1.7327
60	0.0167	1.7161
61	0.0881	11.5875
62	0.0846	11.5875
63	0.2533	39.3360
64	0.0567	5.9562
65	0.0150	1.5994
66	0.0455	6.3068
67	0.2483	23.5583
68	0.1358	17.4129
69	0.0183	3.0656
70	0.0250	3.5487
71	0.0267	4.7483
72	0.1908	3.9223
73	0.0680	6.8476
74	0.0600	18.5768
75	0.0450	5.7980
76	0.0967	12.0457
77	0.0675	5.4064
78	0.2442	33.6214
79	0.1589	8.0067
80	0.1662	19.1723
81	0.2085	11.9189
82	0.1655	33.9470
83	0.0750	3.1489
84	0.0317	4.8816
85	0.0255	2.8323
86	0.1192	34.8876
87	0.1575	3.4238
88	0.0375	28.1567
89	0.0927	7.1641
90	0.0927	7.2702
91	0.1630	31.4305
92	0.0400	6.4461
93	0.0871	14.1038
94	0.0300	21.0259
95	0.1300	20.3761
96	0.1300	8.0688
97	0.0453	8.8802
98	0.0453	7.4807
99	0.1000	25.2410
100	0.0079	0.2284
101	0.2378	5.3522
102	0.0138	0.8500
103	0.0087	1.1324
104	0.0717	6.6143
105	0.0461	4.0002
106	0.0917	6.7892
107	0.0150	1.1496
108	0.0133	2.4491
109	0.0083	7.0004
110	0.1870	18.3756
111	0.1868	27.9268
112	0.0553	14.8601
113	0.0283	5.2815
114	0.0317	3.0839
115	0.0150	0.7544
116	0.0800	2.2425
117	0.0617	4.8483
118	0.1000	0.9996
119	0.1333	0.9996
120	0.1167	2.6657
121	0.0600	1.3995
122	0.0450	2.8323
123	0.0517	14.5615
124	0.1088	7.7556
125	0.0811	17.5771
126	0.0282	16.7214
127	0.0500	24.1581
128	0.0917	27.1487
129	0.0200	1.6161
130	0.0853	11.9234
131	0.1685	14.9496
132	0.0200	16.2276
133	0.0155	16.4760
134	0.1848	19.4181
135	0.0583	6.8143
136	0.0200	5.0316
137	0.0480	32.9083
138	0.0133	0.3582
139	0.1567	42.6849
140	0.2415	8.6386
141	0.2313	16.8732
142	0.0583	2.4991
143	0.1000	1.6661
144	0.0200	3.2488
145	0.0850	7.1808
146	0.0850	8.3720
147	0.0600	8.2471
148	0.0933	19.3098
149	0.0533	22.9585
150	0.0817	11.8291
151	0.0133	2.9989
152	0.0533	8.2138
153	0.2028	37.6783
154	0.1467	35.8290
155	0.0592	7.2308
156	0.0342	3.4738
157	0.0796	19.2813
158	0.0341	3.9079
159	0.0578	1.2662
160	0.1713	14.9208
161	0.1798	19.4345
162	0.2460	21.0358
163	0.1129	20.6926
164	0.0592	23.8749
165	0.0583	3.3738
166	0.1133	26.5572
167	0.0683	9.3467
168	0.0617	6.8143
169	0.0538	7.5348
170	0.1003	21.4015
171	0.0680	14.2449
172	0.0167	5.1648
173	0.0092	0.5914
174	0.0093	0.3373
175	0.0509	1.2493
176	0.0079	0.4551
177	0.0069	0.5547
178	0.0246	1.2086
179	0.0082	0.3342
180	0.0120	0.3396
181	0.0120	0.5733
182	0.0355	0.3041
183	0.0844	25.1994
184	0.1291	7.8469
185	0.1167	10.4546
186	0.0580	3.5062
187	0.1419	12.1632
188	0.1650	33.4423
189	0.1334	11.6061
190	0.0965	19.6633
191	0.1996	25.8249
192	0.1547	12.5745
193	0.0887	9.9132
194	0.0989	19.8846
195	0.0934	7.7389
196	0.1361	16.3858
197	0.0334	4.6169
198	0.0542	10.9865
199	0.0454	4.2490
200	0.1591	5.8091
201	0.2104	6.0752
202	0.0785	1.6061
203	0.1075	20.0012
204	0.0838	17.2522
205	0.0587	12.5706
206	0.0577	27.1650
207	0.0641	7.4484
208	0.0113	1.1315
209	0.0166	7.7118
210	0.0279	20.1021
211	0.0079	0.4338
212	0.0416	2.6845
213	0.0173	0.2200
214	0.0060	0.2098
215	0.0071	0.2546
216	0.0124	0.9797
217	0.0184	1.4844
218	0.0060	0.4268
219	0.0214	0.3971
220	0.0093	0.2723
221	0.0185	0.5914
222	0.0083	0.4763
223	0.0084	0.4445
224	0.0165	4.0720
225	0.0073	0.3754
226	0.0173	1.2976
227	0.0071	0.2975
228	0.0419	20.6223
229	0.0068	0.2900
230	0.0510	26.0817
231	0.0133	2.1159
232	0.2340	18.7767
233	0.0807	17.4021
234	0.0275	5.3314
235	0.0950	36.1039
236	0.0998	5.4545
237	0.1122	8.7801
238	0.0184	0.2855
239	0.0059	0.2559
240	0.0078	0.5326
241	0.0267	2.1009
242	0.0695	13.5285
243	0.0725	24.4913
244	0.0365	38.7446
245	0.0727	21.0675
246	0.0583	37.1202
247	0.0933	29.6061
248	0.0550	11.8291
249	0.1183	32.1886
250	0.0068	3.5173
251	0.0275	12.5039
252	0.2145	32.1582
253	0.0500	11.7634
254	0.0565	0.2776
255	0.1078	0.9221
256	0.0470	20.0986
257	0.0527	13.1953
258	0.0528	28.3293
259	0.1079	26.6655
260	0.0850	15.0113
261	0.0293	1.8089
262	0.0185	0.4073
263	0.0273	4.5484
264	0.0273	5.7813
265	0.0333	6.5723
266	0.0521	5.8286
267	0.0206	0.7840
268	0.0207	0.6875
269	0.0310	5.6134
270	0.0388	0.4445
271	0.0543	20.0145
272	0.0123	0.9553
273	0.0128	2.4428
274	0.0543	35.1136
275	0.0516	7.8836
276	0.0724	17.7045
277	0.0788	23.3267
278	0.0141	0.6370
279	0.1740	19.3380
280	0.0575	13.1849
281	0.0433	1.4495
282	0.0425	2.0661
283	0.0383	0.9497
284	0.0550	6.0978
285	0.0060	0.3484
286	0.0083	0.3975
287	0.0060	0.6397
288	0.0143	1.1479
289	0.0060	0.3227
290	0.0097	0.3156
291	0.0069	0.4232
292	0.0121	0.3834
293	0.0057	0.6933
294	0.0183	29.2896
295	0.0300	15.7861
296	0.0600	23.8772
297	0.1051	12.1927
298	0.0517	4.9982
299	0.0612	18.1184
300	0.0442	17.8346
301	0.1375	9.9048
302	0.0060	2.2857
303	0.0280	2.9190
304	0.1128	21.3341
305	0.1161	24.8578
306	0.0132	0.2484
307	0.0250	3.9736
308	0.0650	8.9718
309	0.0969	7.3589
310	0.0862	6.8360
311	0.1217	12.3290
312	0.1000	12.7021
313	0.0392	9.8923
314	0.0307	12.7288
315	0.0508	4.8906
316	0.0274	6.9823
317	0.0453	4.7400
318	0.0556	31.2546
319	0.0599	21.2828
320	0.0217	3.3272
321	0.1384	25.6909
322	0.1384	41.6519
323	0.0267	2.8257
324	0.1113	17.1522
325	0.0525	5.9979
326	0.0467	12.0290
327	0.0617	14.2000
328	0.0158	16.4608
329	0.2533	22.0722
330	0.0208	4.9482
331	0.0242	1.9993
332	0.1125	16.3400
333	0.1460	11.9374
334	0.1592	10.1932
335	0.0200	6.0178
336	0.1252	14.6602
337	0.0078	0.3519
338	0.0123	1.1873
339	0.0886	32.9740
340	0.0279	34.0713
341	0.0882	6.3511
342	0.1786	20.8954
343	0.0983	7.9757
344	0.0833	0.3542
345	0.0917	15.9610
346	0.0217	2.2659
347	0.0500	17.8020
348	0.0992	32.0220
349	0.1866	12.5914
350	0.1023	19.0432
351	0.1217	33.7047
352	0.0238	43.6012
353	0.0317	1.4495
354	0.0445	35.2958
355	0.0446	24.3080
356	0.1264	19.1689
357	0.1487	11.9050
358	0.0129	0.4657
359	0.0321	5.6563
360	0.2418	3.9474
361	0.1300	6.0318
362	0.0420	2.9506
363	0.0598	20.7663
364	0.1110	38.6715
365	0.0758	29.7631
366	0.2011	13.5035
367	0.0700	7.6973
368	0.0200	2.2159
369	0.0785	2.4428
370	0.0300	3.2655
371	0.0117	5.6502
372	0.1142	33.0383
373	0.0737	3.6744
374	0.0159	0.3944
375	0.0796	28.1109
376	0.0658	18.9016
377	0.0812	7.3724
378	0.0727	7.6473
379	0.1193	12.7303
380	0.1193	6.8132
381	0.2090	21.1134
382	0.0650	6.4644
383	0.0838	32.7217
384	0.0751	38.8112
385	0.2377	18.4864
386	0.2475	26.2632
387	0.1498	29.7185
388	0.0790	9.4775
389	0.1168	28.8456
390	0.0133	3.4521
391	0.2229	18.9683
392	0.1959	19.7513
393	0.0100	0.4998
394	0.0200	1.4495
395	0.0287	4.5484
396	0.0287	5.7813
397	0.0767	22.2754
398	0.0325	2.8323
399	0.0808	12.8704
400	0.0550	15.6986
401	0.0617	8.6136
402	0.0617	10.2130
403	0.1050	36.0539
404	0.0400	8.6136
405	0.0400	10.2130
406	0.0443	14.0965
407	0.0853	26.0715
408	0.0373	1.4153
409	0.0179	3.7070
410	0.0600	29.4145
411	0.0117	0.6034
412	0.0534	3.9746
413	0.0585	4.6541
414	0.0526	9.7523
415	0.0122	2.8323
416	0.0315	1.4162
417	0.0125	1.9493
418	0.0233	3.0489
419	0.0162	1.9993
420	0.1029	23.1668
421	0.0467	3.0656
422	0.0467	2.9323
423	0.0633	10.1880
424	0.2417	20.8426
425	0.0298	1.1501
426	0.0485	24.8934
427	0.2133	1.3887
428	0.0233	1.1663
429	0.1117	8.8219
430	0.0671	6.6560
431	0.0300	17.4105
Fuente: Grupo 3.

6.Gráfica de Dispersión

6.1 Gráfica de Dispersión General

# ==============================================================================
# GRÁFICA EXPLICATIVA: DISTRIBUCIÓN ABSOLUTA CON EJES EN MG/L
# ==============================================================================

x_crudo <- log(datos_filtrados$X_val)
Y_crudo <- log(datos_filtrados$Y_val)


plot(x_crudo, Y_crudo,
     main = "Gráfica No 1: Diagrama de dispersion 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.2 Gráfica de Dispersión Ajustada

# ==============================================================================
# GRÁFICA DE DISPERSIÓN AJUSTADA==============================================================================
plot(x, y,  
     main = "Gráfica No2: 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")  


marcas_x_log <- seq(-4.5, -1.5, by = 0.5)
valores_x_reales <- round(exp(marcas_x_log), 4)
axis(side = 1, at = marcas_x_log, labels = valores_x_reales, cex.axis = 0.7, las = 1)

marcas_y_log <- seq(0.5, 3.0, by = 0.5)
valores_y_reales <- round(exp(marcas_y_log), 1)
axis(side = 2, at = marcas_y_log, labels = valores_y_reales, cex.axis = 0.7, las = 1)

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

8. Cálculo de parámetros

# ------------------------------------------------------------------------------
# 6. CÁLCULO DE PARÁMETROS DEL MODELO LINEAL
# ------------------------------------------------------------------------------
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"

9. Comparación de la realidad con el modelo

# ------------------------------------------------------------------------------
# 7. GRÁFICA No3: REGRESIÓN LINEAL 
# ------------------------------------------------------------------------------
plot(x, y,  
     main = "Gráfica No3: 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") 

# 2. Dibujar la línea de regresión sobre el gráfico abierto
abline(regresionlineal, col = "red", lwd = 2)

marcas_x_log <- seq(-4.5, -1.5, by = 0.5)
valores_x_reales <- round(exp(marcas_x_log), 4)
axis(side = 1, at = marcas_x_log, labels = valores_x_reales, cex.axis = 0.7, las = 1)

marcas_y_log <- seq(0.5, 3.0, by = 0.5)
valores_y_reales <- round(exp(marcas_y_log), 1)
axis(side = 2, at = marcas_y_log, labels = valores_y_reales, cex.axis = 0.7, las = 1)

10. 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 %"

11. Restricciones

## Dominio [X]:

# D = {x ∈ R | 0.0057 mg/L ≤ x ≤ 0.253333 mg/L}

# Dominio [Y]:

# D = {y ∈ R | 0.20984 mg/L ≤ y ≤ 43.60117 mg/L}

# ¿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 (0.0057≤X≤0.253333 mg/L), las concentraciones estimadas de Nitratos permanecen dentro de su dominio observado (0.20984≤Y≤43.60117 mg/L). Por ello, el modelo no genera valores fuera del rango de los datos cuando se utiliza dentro de su dominio de aplicación.

12. Estimaciones

 #==============================================================================
# 11. 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, 2), " + ", round(pendiente, 2), "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.

13. 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.13 + 0.66X. El modelo presentó un coeficiente de correlación del 87.22% y un coeficiente de determinación del 76.08 %, evidenciando un buen ajuste entre ambas variables.