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

1.Leer datos

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

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

2. Extracción y depuración de la variable

# ================================
# VARIABLE CUANTITATIVA CONTINUA
# ================================

CFP <- na.omit(datos$composition_food_organic_waste_percent)

# Datos para gráficos
CFP_graf <- CFP[CFP >= 0.01]

3. Frecuencia

3.1 Rango

# Valores mínimo y má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

# Lí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 máximo en el último intervalo
ni[length(Li)] <- sum(CFP >= Li[length(Li)] & CFP <= maximo)

# Frecuencia relativa
hi <- round((ni / sum(ni)) * 100, 2)

# Crear tabla base
TDF_CFP <- data.frame(
  Li, Ls, MC, ni, hi
)

# ========================================================
# NOTA DE CORRECCIÓN: SE MANTIENEN LOS INTERVALOS CON ni = 0
# Para asegurar la continuidad de los intervalos de clase
# ========================================================

# Calcular frecuencias acumuladas con todos los intervalos
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
# ================================
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
19.3827 22.684 21.03 0 0.00 4371 15522 22 78
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
42.492 45.7933 44.14 0 0.00 16074 3819 81 19
45.7933 49.0947 47.44 3223 16.20 19297 3819 97 19
49.0947 52.396 50.75 0 0.00 19297 596 97 3
52.396 55.6973 54.05 0 0.00 19297 596 97 3
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

# =============================================
# TABLA SIMPLIFICADA (BASADA EN EL HISTOGRAMA)
# =============================================

# 1. Definir los límites para forzar exactamente 10 intervalos perfectos en tu rango real
limites_exactos <- seq(minimo, maximo, length.out = 11) 

histoP <- hist(
  CFP,
  breaks = limites_exactos,
  plot = FALSE 
)

# 2. Extraer datos del histograma para la tabla
Limites <- histoP$breaks
LimInf <- round(Limites[1:(length(Limites) - 1)], 2)
LimSup <- round(Limites[2:length(Limites)], 2)
Mc <- round(histoP$mids, 2)
ni <- histoP$counts
hi <- round((ni / sum(ni)) * 100, 2)

# 3. Crear el DataFrame base (Tendrá exactamente 10 filas)
TDF_Histo_CFP <- data.frame(
  LimInf,
  LimSup,
  Mc,
  ni,
  hi
)

# 4. Calcular frecuencias acumuladas continuas
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)

# ========================================================
# AJUSTE DE REDONDEO: Garantizar que cierren exactamente en 100.00%
# ========================================================
TDF_Histo_CFP$Hi_asc[nrow(TDF_Histo_CFP)] <- 100.00
TDF_Histo_CFP$Hi_dsc[1] <- 100.00

# 5. Crear fila de totales
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 = " "
  )
)

# 6. Generar y mostrar la Tabla con 'gt'
tabla_Histo_CFP <- TDF_Histo_CFP_Completo %>%
  gt() %>%
  tab_header(
    title = md("*Tabla Nº2*"),
    subtitle = md("**Distribución simplificada de frecuencias 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
  )

# Imprimir la tabla 
tabla_Histo_CFP
Tabla Nº2
Distribución simplificada de frecuencias 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
12.78 17.73 15.26 4371 21.97 4371 19893 21.97 100
17.73 22.68 20.21 0 0.00 4371 15522 21.97 78.03
22.68 27.64 25.16 493 2.48 4864 15522 24.45 78.03
27.64 32.59 30.11 10354 52.05 15218 15029 76.5 75.55
32.59 37.54 35.06 499 2.51 15717 4675 79.01 23.5
37.54 42.49 40.02 357 1.79 16074 4176 80.8 20.99
42.49 47.44 44.97 82 0.41 16156 3819 81.21 19.2
47.44 52.4 49.92 3141 15.79 19297 3737 97 18.79
52.4 57.35 54.87 117 0.59 19414 596 97.59 3
57.35 62.3 59.82 479 2.41 19893 479 100 2.41
Total 19893 100.00
Autor: Grupo 3

5. Gráficas

5.1 Histograma (ni)

# =========================================
# Histograma generado por RStudio 
# =========================================
hist(
  CFP,
  breaks = histoP$breaks,
  main = "Gráfica Nº1: Distribución de frecuencias del Porcentaje de Residuos \nOrgánicos en el estudio de la calidad de agua en Europa (1991-2017)",
  xlab = "Porcentaje de residuos orgánicos (%)",
  ylab = "Cantidad",
  col = "darkslateblue",
  border = "black"
)

5.2 Histograma General (ni)

# ===========================================================
# Histograma con relación a la totalidad de los datos
# ===========================================================
barplot(
  TDF_Histo_CFP$ni,
  col = "slateblue",
  main = "Gráfica Nº2: Distribución de frecuencias del Porcentaje de Residuos \nOrgánicos en el estudio de la calidad de agua en Europa (1991-2017)",
  xlab = "Porcentaje de residuos orgánicos (%)",
  ylab = "Cantidad",
  space = 0,
   ylim = c(0, 20000),
  names.arg = round(TDF_Histo_CFP$Mc, 2)
)

5.3 Histograma Porcentual (hi)

# ======================================
# Histograma porcentual que genera RStudio
# ======================================
bp <- barplot(
  TDF_Histo_CFP$hi,
  col = "darkslateblue",
  main = "Gráfica Nº3: Distribución porcentual de frecuencias del Porcentaje de \nResiduos Orgánicos en el estudio de la calidad de agua en Europa (1991-2017)",
  xlab = "Porcentaje de residuos orgánicos (%)",
  ylab = "Porcentaje (%)",
  space = 0,
  names.arg = round(TDF_Histo_CFP$Mc, 2)
)

5.4 Histograma Porcentual General (hi)

# ===========================================================
# Histograma porcentual con relación a la totalidad 
# ===========================================================
barplot(
  TDF_Histo_CFP$hi,
  space = 0,
  col = "slateblue",
  main = "Gráfica Nº4: Distribución porcentual de frecuencias del Porcentaje de \nResiduos Orgánicos en el estudio de la calidad de agua en Europa (1991-2017)",
  xlab = "Porcentaje de residuos orgánicos (%)",
  ylab = "Porcentaje (%)",
  names.arg = TDF_Histo_CFP$Mc,
  ylim = c(0, 100)
)

5.5 Polígono de frecuencias (hi)

bp <- barplot(
  TDF_Histo_CFP$hi,
  col = "slateblue",
  main = "Gráfica Nº5: Polígono de frecuencia de la distribución porcentual \ndel Porcentaje de Residuos Orgánicos en el estudio de la calidad de agua en Europa (1991-2017)",
  xlab = "Porcentaje de residuos orgánicos (%)",
  ylab = "Porcentaje (%)",
  space = 0,
  names.arg = round(TDF_Histo_CFP$Mc, 2),
  ylim = c(0, max(TDF_Histo_CFP$hi) * 1.2)
)

# Polígono superpuesto
lines(
  bp,
  TDF_Histo_CFP$hi,
  type = "o",
  pch = 16,
  lwd = 2,
  col = "black"
)

# Etiquetas de texto
text(
  bp,
  TDF_Histo_CFP$hi,
  labels = round(TDF_Histo_CFP$hi, 2),
  pos = 3,
  cex = 0.8,
  col = "black"
)

5.6 Boxplot

# =============================
# BOXPLOT CON VALORES ATÍPICOS
# =============================
boxplot(
  CFP,
  horizontal = TRUE,
  col = "slateblue",
  main = "Gráfica Nº6: Diagrama de caja del Porcentaje de Residuos Orgánicos \nen el estudio de la calidad de agua en Europa (1991-2017)",
  xlab = "Porcentaje de residuos orgánicos (%)"
)

points(
  mean(CFP),
  1,
  text = "",
  pch = 19,
  col = "red"
)
## Warning in plot.xy(xy.coords(x, y), type = type, ...): "text" es un parámetro
## gráfico inválido
legend(
  "topright",
  legend = "Media",
  pch = 19,
  col = "red"
)

5.7 Ojiva ascendente y descendente (Ni)

# =========================
# OJIVAS Ni
# =========================
plot(
  TDF_Histo_CFP$LimInf,
  TDF_Histo_CFP$Ni_dsc,
  main = "Gráfica Nº7: Ojiva ascendente y descendente del Porcentaje de \nResiduos Orgánicos en el estudio de la calidad de agua en Europa (1991-2017)",
  xlab = "Porcentaje de residuos orgánicos (%)",
  ylab = "Cantidad",
  col = "slateblue",
  type = "o",
  lwd = 2
)

lines(
  TDF_Histo_CFP$LimSup,
  TDF_Histo_CFP$Ni_asc,
  col = "black",
  type = "o",
  lwd = 2
)

legend(
  "right",
  legend = c(
    "Ojiva descendente",
    "Ojiva ascendente"
  ),
  col = c("slateblue", "black"),
  pch = c(16, 16),
  lty = 1,
  bty = "n"
)

5.8 Ojiva ascendente y descendente (Hi)

# =========================
# OJIVAS PORCENTUALES
# =========================
plot(
  TDF_Histo_CFP$LimSup,
  TDF_Histo_CFP$Hi_asc,
  type = "o",
  col = "black",
  pch = 16,
  lwd = 2,
  main = "Gráfica Nº8: Ojiva ascendente y descendente porcentual del Porcentaje de \nResiduos Orgánicos en el estudio de la calidad de agua en Europa (1991-2017)",
  xlab = "Porcentaje de 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 = "darkslateblue",
  pch = 17,
  lwd = 2
)

grid()

legend(
  "right",
  legend = c(
    "Ojiva Ascendente (%)",
    "Ojiva Descendente (%)"
  ),
  col = c("black", "darkslateblue"),
  pch = c(16, 17),
  lty = 1,
  bty = "n"
)

6 Indicadores Estadísticos

6.1 Indicadores de Tendencia Central

# =========================
# INDICADORES ESTADISTICOS
# =========================

# Obtener valores atípicos según el criterio del boxplot
atipicos <- boxplot.stats(CFP)$out

# Cantidad de valores atí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)
# =========================
# Moda basada en Intervalo Modal de la Tabla Simplificada
fila_modal <- which.max(TDF_Histo_CFP$ni)
moda_intervalar <- 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 = "Residuos Orgánicos (%)",
  Rango = paste0("[", round(min(CFP), 2), " ; ", round(max(CFP), 2), "]"),
  X = media,
  Me = mediana,
  Mo = moda_intervalar,
  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 Orgá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 Orgá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
Residuos Orgánicos (%) [12.78 ; 62.3] 32.17 32 [27.64 ; 32.59] 128.29 11.33 35.21 0.44 -0.06 9434
Autor: Grupo 3

7. Conclusión

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