0. 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
3. Frecuencia
3.1 Rango
# Valores mC-nimo y mC!ximo
minimo <- min(CFP)
maximo <- max(CFP)
3.2 Uso de la Regla de Sturges
# Regla de Sturges
k <- 1 + (3.3 * log10(length(CFP)))
k <- floor(k)
# Rango y amplitud
R <- maximo - minimo
A <- R / k
3.3 Límites de clase
# LC-mites de clase
Li <- round(seq(from = minimo, to = maximo - A, by = A), 4)
Ls <- round(seq(from = minimo + A, to = maximo, by = A), 4)
# Marca de clase
MC <- round((Li + Ls) / 2, 2)
3.4 Creación de columnas
# Frecuencia absoluta
ni <- numeric(length(Li))
for (i in 1:length(Li)) {
ni[i] <- sum(CFP >= Li[i] & CFP < Ls[i])
}
# Incluir el valor mC!ximo en el C:ltimo intervalo
ni[length(Li)] <- sum(CFP >= Li[length(Li)] & CFP <= maximo)
# Frecuencia relativa
hi <- round((ni / sum(ni)) * 100, 2)
# Crear tabla
TDF_CFP <- data.frame(
Li, Ls, MC, ni, hi
)
# ================================
# ELIMINAR INTERVALOS CON ni = 0
# ================================
TDF_CFP <- TDF_CFP[TDF_CFP$ni > 0, ]
# Recalcular acumuladas
TDF_CFP$Niasc <- cumsum(TDF_CFP$ni)
TDF_CFP$Nidsc <- rev(cumsum(rev(TDF_CFP$ni)))
TDF_CFP$Hiasc <- round(cumsum(TDF_CFP$hi))
TDF_CFP$Hidsc <- round(rev(cumsum(rev(TDF_CFP$hi))))
4. Tabla de distribución de frecuencia
4.1 Tabla general con Sturges
TDF_CFP_Completo <- rbind(
TDF_CFP,
data.frame(
Li = "Total",
Ls = " ",
MC = " ",
ni = sum(TDF_CFP$ni),
hi = 100,
Niasc = " ",
Nidsc = " ",
Hiasc = " ",
Hidsc = " "
)
)
# ================================
# TABLA GT
# ================================
library(gt)
library(dplyr)
tabla_CFP <- TDF_CFP_Completo %>%
gt() %>%
tab_header(
title = md("Tabla Nº1"),
subtitle = md("**Distribución de frecuencias del Porcentaje de Residuos Orgánicos
en el 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_CFP
| Tabla Nº1 |
| Distribución de frecuencias del Porcentaje de Residuos Orgánicos
en el estudio de la calidad de agua en Europa (1991-2017) |
| Li |
Ls |
MC |
ni |
hi |
Niasc |
Nidsc |
Hiasc |
Hidsc |
| 12.78 |
16.0813 |
14.43 |
370 |
1.86 |
370 |
19893 |
2 |
100 |
| 16.0813 |
19.3827 |
17.73 |
4001 |
20.11 |
4371 |
19523 |
22 |
98 |
| 22.684 |
25.9853 |
24.33 |
493 |
2.48 |
4864 |
15522 |
24 |
78 |
| 25.9853 |
29.2867 |
27.64 |
22 |
0.11 |
4886 |
15029 |
25 |
76 |
| 29.2867 |
32.588 |
30.94 |
10332 |
51.94 |
15218 |
15007 |
76 |
75 |
| 32.588 |
35.8893 |
34.24 |
460 |
2.31 |
15678 |
4675 |
79 |
24 |
| 35.8893 |
39.1907 |
37.54 |
168 |
0.84 |
15846 |
4215 |
80 |
21 |
| 39.1907 |
42.492 |
40.84 |
228 |
1.15 |
16074 |
4047 |
81 |
20 |
| 45.7933 |
49.0947 |
47.44 |
3223 |
16.20 |
19297 |
3819 |
97 |
19 |
| 55.6973 |
58.9987 |
57.35 |
117 |
0.59 |
19414 |
596 |
98 |
3 |
| 58.9987 |
62.3 |
60.65 |
479 |
2.41 |
19893 |
479 |
100 |
2 |
| Total |
|
|
19893 |
100.00 |
|
|
|
|
| Autor: Grupo 3 |
4.2 Tabla Simplificada
# ============
# HISTOGRAMA
# ============
histoP <- hist(
CFP,
breaks = 8,
main = "Gráfica Nº1: Distribución de frecuencias del Porcentaje de Residuos Orgánicos
en el estudio de la calidad de agua en Europa (1991-2017)",
ylab = "Cantidad",
col = "blue"
)

# ===================================
# TABLA N 2: (Basada en Histograma)
# ===================================
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_CFP <- data.frame(
LimInf,
LimSup,
Mc,
ni,
hi
)
# Eliminar intervalos vacC-os
TDF_Histo_CFP <- TDF_Histo_CFP[TDF_Histo_CFP$ni > 0, ]
# Recalcular acumuladas
TDF_Histo_CFP$Ni_asc <- cumsum(TDF_Histo_CFP$ni)
TDF_Histo_CFP$Ni_dsc <- rev(cumsum(rev(TDF_Histo_CFP$ni)))
TDF_Histo_CFP$Hi_asc <- round(cumsum(TDF_Histo_CFP$hi), 2)
TDF_Histo_CFP$Hi_dsc <- round(rev(cumsum(rev(TDF_Histo_CFP$hi))), 2)
# Fila total
TDF_Histo_CFP_Completo <- rbind(
TDF_Histo_CFP,
data.frame(
LimInf = "Total",
LimSup = " ",
Mc = " ",
ni = sum(TDF_Histo_CFP$ni),
hi = 100,
Ni_asc = " ",
Ni_dsc = " ",
Hi_asc = " ",
Hi_dsc = " "
)
)
# Tabla GT
tabla_Histo_CFP <- TDF_Histo_CFP_Completo %>%
gt() %>%
tab_header(
title = md("Tabla Nº2"),
subtitle = md("*Tabla simplificada de Porcentaje de Residuos Orgánicos
en el 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_CFP
| Tabla Nº2 |
| Tabla simplificada de Porcentaje de Residuos Orgánicos
en el estudio de la calidad de agua en Europa (1991-2017) |
| LimInf |
LimSup |
Mc |
ni |
hi |
Ni_asc |
Ni_dsc |
Hi_asc |
Hi_dsc |
| 10 |
15 |
12.5 |
343 |
1.72 |
343 |
19893 |
1.72 |
100.01 |
| 15 |
20 |
17.5 |
4028 |
20.25 |
4371 |
19550 |
21.97 |
98.29 |
| 20 |
25 |
22.5 |
493 |
2.48 |
4864 |
15522 |
24.45 |
78.04 |
| 25 |
30 |
27.5 |
583 |
2.93 |
5447 |
15029 |
27.38 |
75.56 |
| 30 |
35 |
32.5 |
9876 |
49.65 |
15323 |
14446 |
77.03 |
72.63 |
| 35 |
40 |
37.5 |
523 |
2.63 |
15846 |
4570 |
79.66 |
22.98 |
| 40 |
45 |
42.5 |
228 |
1.15 |
16074 |
4047 |
80.81 |
20.35 |
| 45 |
50 |
47.5 |
3223 |
16.20 |
19297 |
3819 |
97.01 |
19.2 |
| 55 |
60 |
57.5 |
117 |
0.59 |
19414 |
596 |
97.6 |
3 |
| 60 |
65 |
62.5 |
479 |
2.41 |
19893 |
479 |
100.01 |
2.41 |
| Total |
|
|
19893 |
100.00 |
|
|
|
|
| Autor: Grupo 3 |
5. Gráficas
5.1 Histograma (ni)
# =========================
# HISTOGRAMA N'2 (ni)
# =========================
cortes <- seq(min(CFP), max(CFP), length.out = 11)
hist(CFP,
breaks = cortes,
main = "Gráfica Nº2: Distribución del Porcentaje de Residuos Orgánicos
en el estudio de la calidad de agua en Europa (1991-2017)",
xlab = "Residuos orgánicos (%)",
ylab = "Cantidad",
ylim = c(0, max(ni)),
col = "lightgreen")

5.2 Histograma General (ni)
# ============================
# HISTOGRAMA N'3 ni (GENERAL)
# ============================
cortes <- seq(min(CFP), max(CFP), length.out = 11)
hist(CFP,
breaks = cortes,
main = "Gráfica Nº3: Distribución general del Porcentaje de Residuos Orgánicos
en el estudio de la calidad de agua en Europa (1991-2017)",
xlab = "Residuos orgánicos (%)",
ylab = "Cantidad",
ylim = c(0, 20000),
col = "mediumseagreen")

5.3 Histograma Porcentual (hi)
# =========================
# HISTOGRAMA Nº4: PORCENTUAL
# =========================
barplot(
TDF_Histo_CFP$hi,
names.arg = round(TDF_Histo_CFP$Mc,2),
col = "royalblue",
space = 0,
main = "Gráfica Nº4: Distribución general del Porcentaje de Residuos Orgánicos",
xlab = "Residuos orgánicos (%)",
ylab = "Porcentaje (%)",
ylim = c(0, max(hi)*1.1),
las = 1
)

5.4 Histograma Porcentual General (hi)
# ==================================
# HISTOGRAMA Nº5 PORCENTUAL hi
# ==================================
barplot(
TDF_Histo_CFP$hi,
names.arg = round(TDF_Histo_CFP$Mc,2),
col = "royalblue",
space = 0,
main = "Gráfica Nº5: Distribución general porcentual de Residuos Orgánicos
en el estudio de la calidad de agua en Europa (1991-2017)",
xlab = "Residuos orgánicos (%)",
ylab = "Porcentaje (%)",
ylim = c(0, 100*1.1),
las = 1
)

5.5 Polígono de frecuencias (ni)
# Crear el histograma y guardarlo
histoP <- hist(
CFP,
breaks = cortes,
main = "Gráfica Nº6: Polígno de frecuencias del Porcentaje de Residuos
Orgánicos en el estudio de la calidad de agua en Europa (1991-2017) ",
xlab = "Residuos orgánicos (%)",
ylab = "Frecuencia",
col = "lightgreen",
border = "black"
)
# Agregar el polígono usando las marcas de clase del histograma
lines(
histoP$mids,
histoP$counts,
type = "o",
pch = 16,
lwd = 2,
col = "black"
)

5.6 Polígono de frecuencias (hi)
# Datos
hi <- TDF_Histo_CFP$hi
mc <- round(TDF_Histo_CFP$Mc, 2)
# Histograma (barras)
bp <- barplot(
hi,
names.arg = mc,
col = "royalblue",
space = 0,
main = "Gráfica Nº7: Polígno de frecuencias del Porcentaje de Residuos
Orgánicos en el estudio de la calidad de agua en Europa (1991-2017)",
xlab = "Residuos orgánicos (%)",
ylab = "Porcentaje (%)",
ylim = c(0, max(hi) * 1.2)
)
# Polígono superpuesto
lines(
bp,
hi,
type = "o",
pch = 16,
lwd = 2,
col = "black"
)

5.7 Boxplot
# =========================
# BOXPLOT
# =========================
boxplot(
CFP,
horizontal = TRUE,
col = "powderblue",
main = "Gráfica Nº8: Diagrama de caja del Porcentaje de Residuos Orgánicos
en el estudio de la calidad de agua en Europa (1991-2017)",
xlab = "Residuos Orgánicos (%)"
)
points(
mean(CFP),
1,
pch = 19,
col = "red"
)
legend(
"topright",
legend = "Media",
pch = 19,
col = "red"
)

5.8 Ojiva ascendente y descendente (Ni)
# =========================
# OJIVAS Ni
# =========================
plot(
TDF_Histo_CFP$LimInf,
TDF_Histo_CFP$Ni_dsc,
main = "Gráfica Nº9: Ojiva ascendente y descendente del Porcentaje de Residuos
Orgánicos en el estudio de la calidad de agua en Europa (1991-2017)",
xlab = "Residuos Orgánicos (%)",
ylab = "Cantidad",
col = "orange",
type = "o",
lwd = 2
)
lines(
TDF_Histo_CFP$LimSup,
TDF_Histo_CFP$Ni_asc,
col = "green",
type = "o",
lwd = 2
)
legend(
"right",
legend = c(
"Ojiva descendente",
"Ojiva ascendente"
),
col = c("orange", "green"),
pch = c(16, 16),
lty = 1,
bty = "n"
)

5.9 Ojiva ascendente y descendente (Hi)
# =========================
# OJIVAS PORCENTUALES
# =========================
plot(
TDF_Histo_CFP$LimSup,
TDF_Histo_CFP$Hi_asc,
type = "o",
col = "blue",
pch = 16,
lwd = 2,
main = "Gráfica Nº10: Ojiva ascendente y descendente porcentual de los Residuos
Orgánicos en el estudio de la calidad de agua en Europa (1991-2017)",
xlab = "Residuos Orgánicos (%)",
ylab = "Porcentaje acumulado (%)",
ylim = c(0, 100)
)
# Ojiva Descendente
lines(
TDF_Histo_CFP$LimInf,
TDF_Histo_CFP$Hi_dsc,
type = "o",
col = "red",
pch = 17,
lwd = 2
)
grid()
legend(
"right",
legend = c(
"Ojiva Ascendente (%)",
"Ojiva Descendente (%)"
),
col = c("blue", "red"),
pch = c(16, 17),
lty = 1,
bty = "n"
)

6 Indicadores Estadísticos
6.1 Indicadores de Tendencia Central
# =========================
# INDICADORES ESTADISTICOS
# =========================
# Obtener valores atC-picos segC:n el criterio del boxplot
atipicos <- boxplot.stats(CFP)$out
# Cantidad de valores atC-picos
n_atipicos <- length(atipicos)
CFP <- na.omit(datos$composition_food_organic_waste_percent)
CFP <- as.numeric(CFP)
media <- round(mean(CFP), 2)
mediana <- round(median(CFP), 2)
# =========================
# MODA (INTERVALO MODAL)
# =========================
fila_modal <- which.max(TDF_Histo_CFP$ni)
moda <- paste0(
"[",
round(TDF_Histo_CFP$LimInf[fila_modal], 2),
" ; ",
round(TDF_Histo_CFP$LimSup[fila_modal], 2),
"]"
)
6.2 Dispersión
varianza <- var(CFP)
desv_est <- sd(CFP)
cv <- round((desv_est / media) * 100, 2)
6.3 Asimetría
library(e1071)
asimetria <- skewness(CFP, type = 2)
curtosis <- kurtosis(CFP)
6.4 Tabla de Indicadores
# =========================
# TABLA RESUMEN FINAL
# =========================
tabla_indicadores <- data.frame(
Variable = "Porcentaje Residuos OrgC!nicos",
Rango = paste0("[", round(min(CFP), 2), " ; ", round(max(CFP), 2), "]"),
X = media,
Me = mediana,
Mo = moda,
V = round(varianza, 2),
Sd = round(desv_est, 2),
Cv = cv,
As = round(asimetria, 2),
K = round(curtosis, 2),
Valores_Atipicos = n_atipicos
)
tabla_indicadores_gt <- tabla_indicadores %>%
gt() %>%
tab_header(
title = md("Tabla Nº3"),
subtitle = md("*Indicadores estadísticos de la variable Porcentaje de Residuos
OrgC!nicos en el estudio de la calidad de agua en Europa (1991-2017)*")
) %>%
tab_source_note(
source_note = md("Autor: Grupo 3")
)
tabla_indicadores_gt
| Tabla Nº3 |
| Indicadores estadísticos de la variable Porcentaje de Residuos
OrgC!nicos en el estudio de la calidad de agua en Europa (1991-2017) |
| Variable |
Rango |
X |
Me |
Mo |
V |
Sd |
Cv |
As |
K |
Valores_Atipicos |
| Porcentaje Residuos OrgC!nicos |
[12.78 ; 62.3] |
32.17 |
32 |
[30 ; 35] |
128.29 |
11.33 |
35.21 |
0.44 |
-0.06 |
9434 |
| Autor: Grupo 3 |
7. Conclusión
##============##
## CONCLUSION ##
##============##
# La variable Porcentaje de Residuos Orgánicos (%) fluctúa entre 12.78% y 62.3%, y sus valores giran en torno a una mediana de 32%, con una desviación estándar de 11.33%, lo que representa un conjunto de datos con variabilidad moderada (CV = 35.21%). Los valores presentan una asimetría positiva (As = 0.44), indicando una ligera concentración de datos hacia valores menores a la media, y una curtosis negativa (K = -0.06), lo que evidencia una distribución platicúrtica, es decir, más achatada o plana que la distribución normal. Cabe destacar la identificación de 9,434 valores atípicos, lo cual sugiere la presencia de casos excepcionales o extremos dentro del monitoreo de la calidad del agua en Europa (1991-2017) que requieren una revisión detallada. Por lo anterior, aunque la tendencia central es clara, la alta cantidad de valores atípicos señala una heterogeneidad significativa en los niveles de residuos orgánicos a lo largo del periodo y territorio estudiado.