2. Tabla de distribución de frecuencia
Hist_Turbidez <- hist(Turbidez,
breaks = 6, # menos clases → FE ≥ 5
plot = FALSE)
Li <- Hist_Turbidez$breaks[-length(Hist_Turbidez$breaks)]
Ls <- Hist_Turbidez$breaks[-1]
ni <- Hist_Turbidez$counts
n <- sum(ni)
Mc <- Hist_Turbidez$mids
hi <- ni / n
Ni_asc <- cumsum(ni)
Hi_asc <- cumsum(hi)
Ni_desc <- rev(cumsum(rev(ni)))
Hi_desc <- rev(cumsum(rev(hi)))
TDFTurbidez <- data.frame(
Li = round(Li, 2),
Ls = round(Ls, 2),
Mc = round(Mc, 2),
ni = ni,
hi = round(hi * 100, 2),
Ni_asc = Ni_asc,
Ni_desc = Ni_desc,
Hi_asc = round(Hi_asc * 100, 2),
Hi_desc = round(Hi_desc * 100, 2)
)
# Fila de totales
totales <- data.frame(
Li = "TOTAL", Ls = "-", Mc = "-",
ni = sum(ni),
hi = sum(hi * 100),
Ni_asc = "-", Ni_desc = "-",
Hi_asc = "-", Hi_desc = "-"
)
TDFTurbidez <- rbind(TDFTurbidez, totales)
kable(TDFTurbidez,
align = "c",
caption = "Tabla de Frecuencias de la Turbidez (NTU)") %>%
kable_styling(full_width = FALSE,
position = "center",
bootstrap_options = c("striped", "hover", "condensed"))
Tabla de Frecuencias de la Turbidez (NTU)
|
Li
|
Ls
|
Mc
|
ni
|
hi
|
Ni_asc
|
Ni_desc
|
Hi_asc
|
Hi_desc
|
|
0
|
10
|
5
|
2589
|
86.30
|
2589
|
3000
|
86.3
|
100
|
|
10
|
20
|
15
|
366
|
12.20
|
2955
|
411
|
98.5
|
13.7
|
|
20
|
30
|
25
|
38
|
1.27
|
2993
|
45
|
99.77
|
1.5
|
|
30
|
40
|
35
|
5
|
0.17
|
2998
|
7
|
99.93
|
0.23
|
|
40
|
50
|
45
|
2
|
0.07
|
3000
|
2
|
100
|
0.07
|
|
TOTAL
|
|
|
3000
|
100.00
|
|
|
|
|
3. Histograma y Conjetura
hist(Turbidez,
breaks = 6,
col = "pink",
main = "Gráfica N°1: Distribución de la Turbidez (NTU)",
xlab = "Turbidez (NTU)",
ylab = "Cantidad")
base <- min(Turbidez)
lambda <- 1 / (mean(Turbidez) - base)
hist(Turbidez,
breaks = 6,
freq = FALSE,
col = "orange2",
main = "Gráfica N°2: Ajuste Exponencial de la Turbidez",
xlab = "Turbidez (NTU)",
ylab = "Cantidad")
curve(dexp(x - base, rate = lambda),
from = base,
to = max(Turbidez),
col = "blue",
lwd = 2,
add = TRUE)
4. Cálculo de frecuencias observadas y esperadas
FO <- ni
FE <- numeric(length(FO))
for (i in 1:length(FO)) {
P <- pexp(Ls[i] - base, rate = lambda) -
pexp(Li[i] - base, rate = lambda)
FE[i] <- n * P
}
FE
## [1] 2602.4079112 344.8989324 45.7096957 6.0579378 0.8028627
cor(FO, FE)
## [1] 0.9999471
x2 <- sum((FO - FE)^2 / FE)
gl <- length(FO) - 1 - 1 # k - 1 - parámetros
VC <- qchisq(0.95, gl)
x2
## [1] 4.630209
VC
## [1] 7.814728
x2 < VC
## [1] TRUE
plot(1, type = "n", axes = FALSE, xlab = "", ylab = "") # Crear un gráfico vacío
text(x = 1, y = 1,
labels = "Cálculos de probabilidad\n(Estimación general)\n
¿Cuál es la probabilidad de que\nel valor de Turbidez afectada
((NTU) \n esté entre 10 y 20 (NTU) ?\n\n
R:8.69 (%)",
cex = 1.5, # Tamaño del texto (ajustable)
col = "blue", # Color del texto
font =6) #tipo
plot(FO, FE,
main = "Gráfica N°3: Frecuencias Observadas vs Esperadas",
xlab = "Observadas",
ylab = "Esperadas",
pch = 19)
abline(lm(FE ~ FO), col = "red", lwd = 2)
P1 <- (pexp(1 - base, rate = lambda) -
pexp(0.5 - base, rate = lambda)) * 100
P1
## [1] 8.687246
x <- seq(base, max(Turbidez), length.out = 1000)
plot(x, dexp(x - base, rate = lambda),
type = "l",
col = "red",
lwd = 2,
main = "Gráfica N°4: Modelo Exponencial de la Turbidez",
xlab = "Turbidez (NTU)",
ylab = "Densidad")
x_area <- seq(0.5, 1, length.out = 200)
polygon(c(0.5, x_area, 1),
c(0, dexp(x_area - base, rate = lambda), 0),
col = rgb(0, 0, 1, 0.3),
border = NA)
legend("topright",
legend = c("Modelo Exponencial", "Área [0.5 – 1]"),
col = c("red", rgb(0, 0, 1, 0.3)),
lwd = c(2, NA),
pch = c(NA, 15),
pt.cex = 2,
bty = "n")
lim_inf <- mean(Turbidez) - 2 * sd(Turbidez) / sqrt(n)
lim_sup <- mean(Turbidez) + 2 * sd(Turbidez) / sqrt(n)
lim_inf
## [1] 4.768884
lim_sup
## [1] 5.127496
plot(1, type = "n", axes = FALSE, xlab = "", ylab = "") # Crear un gráfico vacío
text(x = 1, y = 1,
labels = "CONCLUSIONES",
cex = 2, # Tamaño del texto (ajustable)
col = "blue", # Color del texto
font = 6) #tipo
# =========================================================
# TABLAS DE RESULTADOS DEL MODELO
# =========================================================
tabla_modelos <- data.frame(
"Turbidez (NTU)" = c("[0.5 , 1.0]", "Media"),
"Modelo" = c("Exponencial", ""),
"Parámetros" = c(paste("Lambda =", round(lambda, 4)), ""),
"Test Pearson" = c(round(cor(FO, FE), 3), ""),
"Test Chi-cuadrado" = c(ifelse(x2 < VC, "Aprobado", "No aprobado"), "")
)
tabla_intervalos <- data.frame(
"Intervalo de Confianza" = c("Límite Inferior", "Límite Superior"),
"Grado Confianza (%)" = c("95", "95"),
"Turbidez (NTU)" = c(round(lim_inf, 4), round(lim_sup, 4))
)
library(knitr)
kable(tabla_modelos,
align = "c",
caption = "Conclusiones del Modelo Exponencial para Turbidez (NTU)")
Conclusiones del Modelo Exponencial para Turbidez
(NTU)
| [0.5 , 1.0] |
Exponencial |
Lambda = 0.2021 |
1 |
Aprobado |
| Media |
|
|
|
|
kable(tabla_intervalos,
align = "c",
caption = "Intervalos de Confianza de la Media Poblacional")
Intervalos de Confianza de la Media Poblacional
| Límite Inferior |
95 |
4.7689 |
| Límite Superior |
95 |
5.1275 |