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)
4. TDF variable Porcentaje de residuos verdes
# ===================================
# TABLA NB:2 ESTADÍSTICA DESCRIPTIVA
# ===================================
# AGREGAMOS plot = FALSE para que calcule los datos pero NO dibuje el histograma
histoP <- hist(CYP, plot = FALSE)
Limites <- histoP$breaks
LimInf <- Limites[1:(length(Limites) - 1)]
LimSup <- Limites[2:length(Limites)]
Mc <- histoP$mids
ni <- histoP$counts
hi <- round((ni / sum(ni)) * 100, 2)
TDF_Histo_CYP <- data.frame(
LimInf,
LimSup,
Mc,
ni,
hi
)
# Eliminar intervalos vacíos
TDF_Histo_CYP <- TDF_Histo_CYP[TDF_Histo_CYP$ni > 0, ]
# CORRECCIÓN DE ACUMULADAS: Redondear DESPUÉS de acumular
TDF_Histo_CYP$Ni_asc <- cumsum(TDF_Histo_CYP$ni)
TDF_Histo_CYP$Ni_dsc <- rev(cumsum(rev(TDF_Histo_CYP$ni)))
# Primero acumulamos los valores exactos, y luego redondeamos el resultado final a 2 decimales
TDF_Histo_CYP$Hi_asc <- round(cumsum((TDF_Histo_CYP$ni / sum(TDF_Histo_CYP$ni)) * 100), 2)
TDF_Histo_CYP$Hi_dsc <- round(rev(cumsum(rev((TDF_Histo_CYP$ni / sum(TDF_Histo_CYP$ni)) * 100))), 2)
# Fila total
TDF_Histo_CYP_Completo <- rbind(
TDF_Histo_CYP,
data.frame(
LimInf = "Total",
LimSup = " ",
Mc = " ",
ni = sum(TDF_Histo_CYP$ni),
hi = 100,
Ni_asc = " ",
Ni_dsc = " ",
Hi_asc = " ",
Hi_dsc = " "
)
)
# Tabla GT
tabla_Histo_CYP <- TDF_Histo_CYP_Completo %>%
gt() %>%
tab_header(
title = md("Tabla Nº1"),
subtitle = md("Distribución del porcentaje de Residuos Verdes,
estudio de la calidad de agua en Europa (1991-2017)")
) %>%
tab_source_note(
source_note = md("Autor: Grupo 3")
) %>%
tab_options(
table.border.top.color = "black",
table.border.bottom.color = "black",
column_labels.border.bottom.color = "black",
row.striping.include_table_body = TRUE
)
tabla_Histo_CYP
| Tabla Nº1 |
| Distribución del porcentaje de Residuos Verdes,
estudio de la calidad de agua en Europa (1991-2017) |
| LimInf |
LimSup |
Mc |
ni |
hi |
Ni_asc |
Ni_dsc |
Hi_asc |
Hi_dsc |
| 0 |
2 |
1 |
14881 |
74.81 |
14881 |
19893 |
74.81 |
100 |
| 2 |
4 |
3 |
3957 |
19.89 |
18838 |
5012 |
94.7 |
25.19 |
| 4 |
6 |
5 |
280 |
1.41 |
19118 |
1055 |
96.1 |
5.3 |
| 6 |
8 |
7 |
44 |
0.22 |
19162 |
775 |
96.33 |
3.9 |
| 12 |
14 |
13 |
129 |
0.65 |
19291 |
731 |
96.97 |
3.67 |
| 14 |
16 |
15 |
198 |
1.00 |
19489 |
602 |
97.97 |
3.03 |
| 18 |
20 |
19 |
322 |
1.62 |
19811 |
404 |
99.59 |
2.03 |
| 30 |
32 |
31 |
82 |
0.41 |
19893 |
82 |
100 |
0.41 |
| Total |
|
|
19893 |
100.00 |
|
|
|
|
| Autor: Grupo 3 |
5. Histograma de la variable
# ===================================
# HISTOGRAMA Nº1 PORCENTUAL(LOCAL)
# ===================================
barplot(
TDF_Histo_CYP$hi,
names.arg = round(TDF_Histo_CYP$Mc,2),
col = "royalblue",
space = 0,
main = "Gráfica Nº1: Distribución del porcentaje de Residuos Verdes,
estudio de la calidad de agua en Europa (1991-2017)",
xlab = "Residuos Verdes",
ylab = "Porcentaje (%)",
ylim = c(0, max(hi)*1.1),
las = 1
)

6. Conjetura
# ============
# CONJETURA
# ============
# Se conjetura que el porcentaje de residuos verdes sigue un modelo de
# probabilidad exponencial, ya que la variable en su histograma muestra que
# la mayor parte de los datos está fuertemente concentrada en el extremo izquierdo
# y la frecuencia relativa disminuye
# rápidamente conforme aumentan dichos valores.
6.1 Cálculo de parámetros distribución exponencial
# ================================================
# CÁLCULO DE PARÁMETROS DISTRIBUCIÓN EXPONENCIAL
# ================================================
# Media de la variable original (CYP)
media <- mean(CYP)
print(paste("Media:", round(media, 4)))
## [1] "Media: 1.3025"
# Parámetro Lambda (Tasa de fallos / decaimiento)
lambda <- 1 / media
print(paste("Lambda:", round(lambda, 4)))
## [1] "Lambda: 0.7678"
7. Sobreponer la realidad con el modelo
# =======================================
# HISTOGRAMA Nº2 DENSIDAD DE PROBABILIDAD
# =======================================
hist(
CYP,
probability = TRUE,
col = "lightblue",
border = "black",
xlim = c(0,7),
main = "Gráfica Nº2: Comparación del modelo exponencial con la realidad del
porcentaje de Residuos Verdes",
xlab = "Residuos verdes (%)",
ylab = "Densidad de probabilidad"
)
lambda <- 1/mean(CYP)
curve(
dexp(x, rate = lambda),
from = 0,
to = 8,
add = TRUE,
col = "red",
lwd = 3
)

8. Test de bondad
# ================
# TEST DE BONDAD
# ================
TDF_Acotada <- data.frame(
LimInf = c(0, 2, 4, 6),
LimSup = c(2, 4, 6, 8),
ni = c(14881, 3957, 280, 44)
)
fo <- TDF_Acotada$ni
n <- sum(fo)
# Recalculamos lambda para este rango controlado
lambda <- 1 / mean(CYP[CYP <= 8])
fe <- numeric(length(fo))
for(i in 1:length(fo)){
fe[i] <- n * (pexp(TDF_Acotada$LimSup[i], rate = lambda) -
pexp(TDF_Acotada$LimInf[i], rate = lambda))
}
# ===========================
# CORRELACIÓN DE PEARSON (%)
# ===========================
Correlacion <- cor(fo, fe) * 100
print(paste("Correlación de Pearson:", round(Correlacion, 2), "%"))
## [1] "Correlación de Pearson: 97.7 %"
# =====================
# TEST DE CHI-CUADRADO
# =====================
fe_frac <- fe / n
fo_frac <- fo / n
x2 <- sum((fo_frac - fe_frac)^2 / fe_frac)
# Grados de libertad: k (número de intervalos) - 1 (restricción n) - 1 (parámetro lambda estimado)
gl <- length(fo_frac) - 2
umbral_aceptacion <- qchisq(0.95, df = gl)
acepta_modelo <- x2 < umbral_aceptacion
# Impresión de resultados en consola
print(paste("Estadístico X2:", round(x2, 4)))
## [1] "Estadístico X2: 0.7051"
print(paste("Grados de libertad (gl):", gl))
## [1] "Grados de libertad (gl): 2"
print(paste("Umbral de aceptación:", round(umbral_aceptacion, 4)))
## [1] "Umbral de aceptación: 5.9915"
print(paste("¿El modelo exponencial es aceptado?:", acepta_modelo))
## [1] "¿El modelo exponencial es aceptado?: TRUE"
9. Cálculo de Probabilidades
# ==========================================================
# CÁLCULO DE PROBABILIDAD Y CANTIDAD (MODELO EXPONENCIAL)
# ==========================================================
# 1. Pregunta de Probabilidad:
# "¿Cuál es la probabilidad de que el porcentaje de residuos verdes se encuentre entre el 0% y el 2%?"
prob1 <- pexp(2, rate = lambda) - pexp(0, rate = lambda)
prob1 * 100
## [1] 95.16316
# 2. Pregunta de Cantidad:
# "¿A partir de qué porcentaje de residuos verdes se considera que un día está dentro del 2% de los casos con mayor acumulación de la región?"
limite_critico <- qexp(0.02, rate = lambda, lower.tail = FALSE)
limite_critico
## [1] 2.583123
9.1 Demostración de la Probabilidad
# =====================================
# DEMOSTRACIÓN GRÁFICA DE PROBABILIDAD
# =====================================
x <- seq(0, 8, by=0.001)
y <- dexp(x, rate=lambda)
ylim_max <- max(y) * 1.1
limite_critico <- qexp(0.02, rate = lambda, lower.tail = FALSE)
# 2. Graficar la curva principal (Modelo Exponencial)
plot(x, y, type="l", col="orange", lwd=3, xlim=c(0, 8), ylim=c(0, ylim_max),
main="Gráfica N°3: Cálculo de Probabilidad",
ylab="Densidad de probabilidad", xlab="Residuos verdes (%)", xaxt="n")
# --------------------------------------------------
# SOMBREADO PREGUNTA 1: Probabilidad entre 0% y 2%
# --------------------------------------------------
x_prob1 <- seq(0, 2, by=0.001)
y_prob1 <- dexp(x_prob1, rate=lambda)
# Polígono azul con borde oscuro definido
polygon(c(x_prob1, rev(x_prob1)), c(y_prob1, rep(0, length(y_prob1))),
col=rgb(0.2, 0.6, 0.8, 0.4), border="steelblue4")
# ----------------------------------------------------------
# SOMBREADO PREGUNTA 2: Cantidad (Límite crítico del 2% más alto)
# ----------------------------------------------------------
x_cant2 <- seq(limite_critico, 8, by=0.001)
y_cant2 <- dexp(x_cant2, rate=lambda)
# Polígono rojo con borde rojo oscuro
polygon(c(x_cant2, rev(x_cant2)), c(y_cant2, rep(0, length(y_cant2))),
col=rgb(0.9, 0.2, 0.2, 0.5), border="red4")
# ----------------------
# LÍNEAS GUÍA (Límites)
# ----------------------
# Línea discontinua gris en X = 2
abline(v = 2, col = "grey30", lty = 2, lwd = 2)
# Línea discontinua roja en el límite crítico
abline(v = limite_critico, col = "firebrick3", lty = 2, lwd = 2)
# Redibujar la curva original encima para que se vea impecable
lines(x, y, col="orange", lwd=3)
# Configurar el eje X con marcas de 1 en 1
axis(1, at=seq(0, 8, by=1))
# Leyenda con recuadro y bloques de color sólidos
legend("topright",
legend=c("Modelo Exponencial", "Probabilidad (0% a 2%)", "Límite Crítico (2%)"),
col=c("orange", "steelblue4", "red4"),
fill=c(NA, rgb(0.2, 0.6, 0.8, 0.4), rgb(0.9, 0.2, 0.2, 0.5)),
border=c(NA, "steelblue4", "red4"),
lty=c(1, NA, NA),
lwd=c(3, NA, NA),
bg="white",
box.col="grey40",
pt.cex=2,
cex=1.1)

10. Intervalo de Confianza
# ==============================
# #INTERVALO DE CONFIANZA
# ==============================
library(gt)
library(dplyr)
# Parámetros de tu variable real (Residuos Verdes - CYP)
media <- mean(CYP)
sigma <- sd(CYP)
n <- length(CYP)
# Cálculo del error estándar
error <- 2 * (sigma / sqrt(n))
# Límites del intervalo de confianza
limite_inferior <- round(media - error, 2)
limite_superior <- round(media + error, 2)
# Crear el texto del intervalo
texto_intervalo <- paste0("P [", limite_inferior, " < \u00b5 < ", limite_superior, "] = 95%")
# Construcción de la tabla formal con gt
tabla_intervalo <- data.frame(Intervalo = texto_intervalo)
tabla_intervalo %>%
gt() %>%
tab_header(
title = md("*Tabla Nro. 2*"),
subtitle = md("**Intervalo de confianza del porcentaje de residuos verdes
en el estudio de la calidad de agau en Europa (1991-2017)**")
) %>%
tab_source_note(
source_note = md("Autor: Grupo 3")
) %>%
tab_options(
table.border.top.color = "black",
table.border.bottom.color = "black",
table.border.top.style = "solid",
table.border.bottom.style = "solid",
column_labels.border.top.color = "black",
column_labels.border.bottom.color = "black",
column_labels.border.bottom.width = px(2),
row.striping.include_table_body = TRUE,
heading.border.bottom.color = "black",
heading.border.bottom.width = px(2),
table_body.hlines.color = "gray",
table_body.border.bottom.color = "black"
)
| Tabla Nro. 2 |
| Intervalo de confianza del porcentaje de residuos verdes
en el estudio de la calidad de agau en Europa (1991-2017) |
| Intervalo |
| P [1.25 < µ < 1.35] = 95% |
| Autor: Grupo 3 |
11. Conclusión
La variable de porcentaje de residuos verdes (%) se explica con un
modelo exponencial con parámetro λ = 0.7686, y podemos afirmar con un
95% de confianza que la media aritmética de esta variable se encuentra
entre 1.25% y 1.35%, con una desviaciòn estandar de 4.71%.