0.Librerias

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
library("e1071")

1. Leer Datos

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

2. Extracción y depuración de Variable

CGP <- na.omit(datos$composition_glass_percent)

3. Frecuencia

3.1 Rango

# Valores mínimo y máximo
minimo <- min(CGP)
maximo <- max(CGP)

3.2 Uso de la regla de Sturges

# Regla de Sturges
k <- 1 + (3.3 * log10(length(CGP)))
k <- floor(k)
# Rango y amplitud
R <- maximo - minimo
A <- R / k

3.3 Limites de clase

# Límites de clase continuos
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(CGP >= Li[i] & CGP < Ls[i])
}

# Incluir el valor máximo en el último intervalo de forma exacta
ni[length(Li)] <- sum(CGP >= Li[length(Li)] & CGP <= maximo)

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

# Crear tabla base (SIN ELIMINAR ni = 0)
TDF_CGP <- data.frame(
  Li, Ls, MC, ni, hi
)

# Calcular frecuencias acumuladas 
TDF_CGP$Niasc <- cumsum(TDF_CGP$ni)
TDF_CGP$Nidsc <- rev(cumsum(rev(TDF_CGP$ni)))
TDF_CGP$Hiasc <- round(cumsum(TDF_CGP$hi))
TDF_CGP$Hidsc <- round(rev(cumsum(rev(TDF_CGP$hi))))

4.Tabla de distribución de Frecuencia

4.1 Tabla generada con Sturges

# ================================================
# FILA TOTAL
# ================================================

TDF_CGP_Completo <- rbind(
  TDF_CGP,
  data.frame(
    Li = "Total",
    Ls = " ",
    MC = " ",
    ni = sum(TDF_CGP$ni),
    hi = 100,
    Niasc = " ",
    Nidsc = " ",
    Hiasc = " ",
    Hidsc = " "
  )
)

# ================================================
# TABLA GT - PRESENTACIÓN FINAL
# ================================================

library(gt)
library(dplyr)

tabla_CGP <- TDF_CGP_Completo %>%
  gt() %>%
  tab_header(
    title = md("*Tabla Nº1*"),
    subtitle = md("**Distribución de frecuencias de la composición porcentual de vidrios en el estudio de la calidad de agua en Europa (1991-2017)**")
  ) %>%
  cols_label(
    Li = "Li",
    Ls = "Ls",
    MC = "MC",
    ni = "ni",
    hi = "hi (%)",
    Niasc = "Ni ↑",
    Nidsc = "Ni ↓",
    Hiasc = "Hi ↑ (%)",
    Hidsc = "Hi ↓ (%)"
  ) %>%
  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_CGP
Tabla Nº1
Distribución de frecuencias de la composición porcentual de vidrios en el estudio de la calidad de agua en Europa (1991-2017)
Li Ls MC ni hi (%) Ni ↑ Ni ↓ Hi ↑ (%) Hi ↓ (%)
2.2 3.48 2.84 4697 23.61 4697 19893 24 100
3.48 4.76 4.12 83 0.42 4780 15196 24 76
4.76 6.04 5.4 657 3.30 5437 15113 27 76
6.04 7.32 6.68 126 0.63 5563 14456 28 73
7.32 8.6 7.96 3291 16.54 8854 14330 44 72
8.6 9.88 9.24 754 3.79 9608 11039 48 55
9.88 11.16 10.52 10203 51.29 19811 10285 100 52
11.16 12.44 11.8 0 0.00 19811 82 100 0
12.44 13.72 13.08 0 0.00 19811 82 100 0
13.72 15 14.36 0 0.00 19811 82 100 0
15 16.28 15.64 0 0.00 19811 82 100 0
16.28 17.56 16.92 0 0.00 19811 82 100 0
17.56 18.84 18.2 0 0.00 19811 82 100 0
18.84 20.12 19.48 0 0.00 19811 82 100 0
20.12 21.4 20.76 82 0.41 19893 82 100 0
Total 19893 100.00
Autor: Grupo 3

4.2 Tabla Simplificada

# ================================================
# TABLA Nº2 (BASADA EN EL HISTOGRAMA)
# ================================================

cortes <- seq(
  floor(min(CGP)),
  ceiling(max(CGP)),
  length.out = 11
)

# Histograma 
histoP <- hist(
  CGP,
  breaks = cortes,
  plot = FALSE
)

# Extraer información continua
LimInf <- histoP$breaks[-length(histoP$breaks)]
LimSup <- histoP$breaks[-1]
Mc <- round((LimInf + LimSup)/2, 1)

ni <- histoP$counts
hi <- round((ni/sum(ni))*100, 2)

# Crear tabla base
TDF_Histo_CGP <- data.frame(
  LimInf,
  LimSup,
  Mc,
  ni,
  hi
)

# Calcular acumuladas
TDF_Histo_CGP$Ni_asc <- cumsum(TDF_Histo_CGP$ni)
TDF_Histo_CGP$Ni_dsc <- rev(cumsum(rev(TDF_Histo_CGP$ni)))

# Calcular porcentajes acumulados 
TDF_Histo_CGP$Hi_asc <- round((TDF_Histo_CGP$Ni_asc / sum(TDF_Histo_CGP$ni)) * 100, 2)
TDF_Histo_CGP$Hi_dsc <- round((TDF_Histo_CGP$Ni_dsc / sum(TDF_Histo_CGP$ni)) * 100, 2)

# Ajustar los límites por redondeo
TDF_Histo_CGP$Hi_asc[nrow(TDF_Histo_CGP)] <- 100.00
TDF_Histo_CGP$Hi_dsc[1] <- 100.00

# Agregar fila total
TDF_Histo_CGP_Completo <- rbind(
  TDF_Histo_CGP,
  data.frame(
    LimInf = "Total",
    LimSup = "",
    Mc = "",
    ni = sum(TDF_Histo_CGP$ni),
    hi = 100.00,
    Ni_asc = "",
    Ni_dsc = "",
    Hi_asc = "",
    Hi_dsc = ""
  )
)

# ================================================
# TABLA GT - PRESENTACIÓN FINAL
# ================================================

library(gt)

tabla_Histo_CGP <- TDF_Histo_CGP_Completo %>%
  gt() %>%
  tab_header(
    title = md("*Tabla Nº2*"),
    subtitle = md("**Distribución de frecuencias simplificada de la composición porcentual de vidrios agruados en el estudio de la calidad de agua en Europa (1991-2017)**")
  ) %>%
  cols_label(
    LimInf = "Límite Inferior",
    LimSup = "Límite Superior",
    Mc = "Marca de Clase",
    ni = "ni",
    hi = "hi (%)",
    Ni_asc = "Ni ↑",
    Ni_dsc = "Ni ↓",
    Hi_asc = "Hi ↑ (%)",
    Hi_dsc = "Hi ↓ (%)"
  ) %>%
  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_CGP
Tabla Nº2
Distribución de frecuencias simplificada de la composición porcentual de vidrios agruados en el estudio de la calidad de agua en Europa (1991-2017)
Límite Inferior Límite Superior Marca de Clase ni hi (%) Ni ↑ Ni ↓ Hi ↑ (%) Hi ↓ (%)
2 4 3 4753 23.89 4753 19893 23.89 100
4 6 5 684 3.44 5437 15140 27.33 76.11
6 8 7 3373 16.96 8810 14456 44.29 72.67
8 10 9 11000 55.30 19810 11083 99.58 55.71
10 12 11 1 0.01 19811 83 99.59 0.42
12 14 13 0 0.00 19811 82 99.59 0.41
14 16 15 0 0.00 19811 82 99.59 0.41
16 18 17 0 0.00 19811 82 99.59 0.41
18 20 19 0 0.00 19811 82 99.59 0.41
20 22 21 82 0.41 19893 82 100 0.41
Total 19893 100.00
Autor: Grupo 3

5. Gráficas

5.1 Histograma (ni)

# =========================================
# Histograma generado por RStudio 
# =========================================

hist(
  CGP,
  breaks = c(TDF_Histo_CGP$LimInf, max(TDF_Histo_CGP$LimSup)),
  col = "steelblue1",
  border = "black",
  main = "Gráfica Nº1: Distribución de frecuencias de la composición porcentual 
  de vidrios en el estudio de la calidad de 
  agua en Europa (1991-2017)",
  xlab = "Porcentaje de vidrios (%)",
  ylab = "Cantidad",
  xaxt = "n" 
)

limites_etiquetas_cgp <- c(TDF_Histo_CGP$LimInf, tail(TDF_Histo_CGP$LimSup, 1))

axis(
  side = 1,
  at = limites_etiquetas_cgp,
  labels = round(limites_etiquetas_cgp, 1),
  las = 1,
  cex.axis = 0.8
)

grid()

5.2 Histograma General (ni)

# ===========================================================
# Histograma con relación a la totalidad de los datos
# ===========================================================

bp <- barplot(
  TDF_Histo_CGP$ni,
  col = "lightsteelblue2",
  border = "black",
  main = "Gráfica Nº2: Distribución de frecuencias de la composición porcentual 
  de vidrios en el estudio de la calidad de 
  agua en Europa (1991-2017)",
  xlab = "Porcentaje de vidrios (%)",
  ylab = "Cantidad",
  space = 0,
  xaxt = "n",
  ylim = c(0, 20000)
)

limites_etiquetas_cgp <- c(TDF_Histo_CGP$LimInf, tail(TDF_Histo_CGP$LimSup, 1))

axis(
  side = 1,
  at = 0:length(TDF_Histo_CGP$ni),
  labels = round(limites_etiquetas_cgp, 1),
  las = 1,
  cex.axis = 0.8
)

grid()

5.3 Histograma Porcentual (hi)

# ======================================
# Histograma porcentual que genera RStudio
# ======================================

bp <- barplot(
  TDF_Histo_CGP$hi,
  col = "steelblue1",
  border = "black",
  main = "Gráfica Nº3: Distribución porcentual de frecuencias de la  
  composición de vidrios en el estudio de la calidad de  
  agua en Europa (1991-2017)",
  xlab = "Porcentaje de vidrios (%)",
  ylab = "Porcentaje (%)",
  space = 0,
  xaxt = "n",
  ylim = c(0, max(TDF_Histo_CGP$hi) * 1.15)
)

limites_etiquetas_cgp <- c(TDF_Histo_CGP$LimInf, tail(TDF_Histo_CGP$LimSup, 1))

axis(
  side = 1,
  at = 0:length(TDF_Histo_CGP$hi),
  labels = round(limites_etiquetas_cgp, 1),
  las = 1,
  cex.axis = 0.8
)

grid()

5.4 Histograma Porcentual General (hi)

# ===========================================================
# Histograma porcentual con relación a la totalidad 
# ===========================================================

hi_global <- round((TDF_Histo_CGP$ni / 20000) * 100, 2)

bp <- barplot(
  hi_global,
  col = "lightsteelblue2",
  border = "black",
  main = "Gráfica Nº4: Distribución porcentual de frecuencias de la
  composición de vidrios en el estudio de la calidad de  
  agua en Europa (1991-2017)",
  xlab = "Porcentaje de vidrios (%)",
  ylab = "Porcentaje (%)",
  space = 0,
  xaxt = "n",
  ylim = c(0, 100)
)

limites_etiquetas_cgp <- c(TDF_Histo_CGP$LimInf, tail(TDF_Histo_CGP$LimSup, 1))

axis(
  side = 1,
  at = 0:length(TDF_Histo_CGP$ni),
  labels = round(limites_etiquetas_cgp, 1),
  las = 1,
  cex.axis = 0.8
)

grid()

5.5 Polígono de frecuencias (hi)

bp <- barplot(
  TDF_Histo_CGP$hi,
  col = "steelblue2",
  border = "black",
  main = "Gráfica Nº5: Polígono de frecuencia de la distribución porcentual  
  de la composición de vidrios en el estudio de la calidad de  
  agua en Europa (1991-2017)",
  xlab = "Porcentaje de vidrios (%)",
  ylab = "Porcentaje (%)",
  space = 0,
  xaxt = "n",
  ylim = c(0, max(TDF_Histo_CGP$hi) * 1.15)
)

limites_etiquetas_cgp <- c(TDF_Histo_CGP$LimInf, tail(TDF_Histo_CGP$LimSup, 1))

# 3. Dibujamos el eje X 
axis(
  side = 1,
  at = 0:length(TDF_Histo_CGP$hi),
  labels = round(limites_etiquetas_cgp, 1),
  las = 1,
  cex.axis = 0.8
)

# Polígono cerrado
x_pol <- c(
  bp[1] - (bp[2] - bp[1]),  
  bp,
  bp[length(bp)] + (bp[length(bp)] - bp[length(bp)-1]) # punto final
)

y_pol <- c(
  0,
  TDF_Histo_CGP$hi,
  0
)

# Dibujar polígono
lines(
  x_pol,
  y_pol,
  type = "o",
  pch = 16,
  lwd = 3,
  col = "red"
)

grid()

legend(
  "topright",
  legend = c("Frecuencia relativa (%)"),
  col = "red",
  lwd = 3,
  pch = 16,
  bty = "n"
)

5.6 Bloxplot

# =========================
# BOXPLOT CON ATÍPICOS
# =========================

boxplot(
  CGP,
  horizontal = TRUE,
  col = "lightblue1",
  outline = TRUE,
  main = "Gráfica Nº6: Diagrama de caja de la composición porcentual de vidrios 
  en el estudio de la calidad de agua en Europa (1991-2017)"
)

# Media
points(
  mean(CGP),
  1,
  pch = 19,
  col = "red",
  cex = 1.5
)

legend(
  "topright",
  legend = c("Media", "Valores atípicos"),
  pch = c(19, 1),
  col = c("red", "black"),
  bty = "n"
)

5.7 Ojiva ascendente y descendente

# =========================
# OJIVAS
# =========================
par(mar = c(10, 4, 7, 2))

# 1. Definir todos los límites de clase 
todos_limites_cgp <- c(TDF_Histo_CGP$LimInf[1], TDF_Histo_CGP$LimSup)

# Ojiva Ascendente
x_asc_cgp <- c(TDF_Histo_CGP$LimInf[1], TDF_Histo_CGP$LimSup)
y_asc_cgp <- c(0, TDF_Histo_CGP$Ni_asc)

# Ojiva Descendente
x_dsc_cgp <- c(TDF_Histo_CGP$LimInf, tail(TDF_Histo_CGP$LimSup, 1))
y_dsc_cgp <- c(TDF_Histo_CGP$Ni_dsc, 0)

plot(
  x_dsc_cgp,
  y_dsc_cgp,
  main = "Gráfica Nº7: Ojiva ascendente y descendente de la composición 
  porcentual de vidrios en el estudio de la calidad de 
  agua en Europa (1991-2017)",
  xlab = "Porcentaje de vidrio (%)",
  ylab = "Frecuencia acumulada",
  col = "black",
  type = "o",
  lwd = 2,
  xaxt = "n",
  ylim = c(0, max(TDF_Histo_CGP$Ni_asc) * 1.05)
)

# 4. Dibujar la ojiva ascendente
lines(
  x_asc_cgp,
  y_asc_cgp,
  col = "steelblue3",
  type = "o",
  lwd = 2
)

# 5. Dibujar el eje X 
axis(
  side = 1,
  at = todos_limites_cgp,
  labels = round(todos_limites_cgp, 1),
  las = 1,
  cex.axis = 0.8
)

# 6. Leyenda
legend(
  "right",
  legend = c(
    "Ojiva descendente",
    "Ojiva ascendente"
  ),
  col = c("black", "steelblue3"),
  pch = c(16, 16),
  lty = 1,
  bty = "n"
)

5.8 Ojiva de Frecuencia relativa

# =========================
# OJIVAS PORCENTUALES
# =========================
par(mar = c(10, 4, 7, 2))

# 1. Definir todos los límites de clase
todos_limites_cgp <- c(TDF_Histo_CGP$LimInf[1], TDF_Histo_CGP$LimSup)

# Ojiva Ascendente
x_asc_cgp <- c(TDF_Histo_CGP$LimInf[1], TDF_Histo_CGP$LimSup)
y_asc_cgp <- c(0, TDF_Histo_CGP$Hi_asc)

# Ojiva Descendente
x_dsc_cgp <- c(TDF_Histo_CGP$LimInf, tail(TDF_Histo_CGP$LimSup, 1))
y_dsc_cgp <- c(TDF_Histo_CGP$Hi_dsc, 0)

plot(
  x_asc_cgp,
  y_asc_cgp,
  type = "o",
  col = "steelblue1",
  pch = 16,
  lwd = 2,
  main = "Gráfica Nº8: Ojiva ascendente y descendente de la composición 
  porcentual de vidrios en el estudio de la calidad de 
  agua en Europa (1991-2017)",
  xlab = "Porcentaje de vidrio (%)",
  ylab = "Porcentaje acumulado (%)",
  ylim = c(0, 100),
  xaxt = "n"
)

# 4. Ojiva Descendente
lines(
  x_dsc_cgp,
  y_dsc_cgp,
  type = "o",
  col = "black",
  pch = 17,
  lwd = 2
)

# 5. Dibujar el eje X
axis(
  side = 1,
  at = todos_limites_cgp,
  labels = round(todos_limites_cgp, 1),
  las = 1,
  cex.axis = 0.8
)

grid()

# 6. Leyenda
legend(
  "right",
  legend = c(
    "Ojiva Ascendente (%)",
    "Ojiva Descendente (%)"
  ),
  col = c("steelblue1", "black"),
  pch = c(16, 17),
  lty = 1,
  bty = "n"
)

6. Indicadores estadísticos

6.1 Indicadores de Tendencia Central

atipicos <- boxplot.stats(CGP)$out
n_atipicos <- length(atipicos)

# Rango de los valores atípicos [Mínimo ; Máximo] junto con el conteo total
if (n_atipicos > 0) {
  rango_atipicos <- paste0("[", round(min(atipicos), 2), " ; ", round(max(atipicos), 2), "] (Valores: ", n_atipicos, ")")
} else {
  rango_atipicos <- "No existen"
}

media <- round(mean(CGP), 2)
mediana <- round(median(CGP), 2)

# Moda como intervalo
indice_moda <- which.max(TDF_Histo_CGP$ni)

moda <- paste0(
  "[",
  TDF_Histo_CGP$LimInf[indice_moda],
  " ; ",
  TDF_Histo_CGP$LimSup[indice_moda],
  "]"
)

6.2 Dispersión

varianza <- round(var(CGP), 2)
desv_est <- round(sd(CGP), 2)
cv <- round((desv_est / media) * 100, 2)

6.3 Asimetría

# Asimetría 
asimetria <- round(
  mean((CGP - mean(CGP))^3) /
    sd(CGP)^3,
  2
)

# Curtosis 
curtosis <- round(
  mean((CGP - mean(CGP))^4) /
    sd(CGP)^4 - 3,
  2
)

6.4 Tabla de indicadores

tabla_indicadores <- data.frame(
  Variable = "Porcentaje vidrios (%)",
  Rango = paste0(
    "[",
    round(min(CGP), 2),
    " ; ",
    round(max(CGP), 2),
    "]"
  ),
  X = media,
  Me = mediana,
  Mo = moda,
  V = varianza,
  Sd = desv_est,
  Cv = cv,
  As = asimetria,
  K = curtosis,
  Valores_Atipicos = rango_atipicos
)

tabla_indicadores_gt <- tabla_indicadores %>%
  gt() %>%
  tab_header(
    title = md("*Tabla Nº3*"),
    subtitle = md("**Indicadores estadísticos de porcentajes de vidrio en los residuos 
                  sólidos en el estudio de la calidad de agua en Europa(1991-2017)**")
  ) %>%
  cols_label(
    Valores_Atipicos = "Rango Atípicos"
  ) %>%
  tab_source_note(
    source_note = md("Autor: Grupo 3")
  )

tabla_indicadores_gt
Tabla Nº3
Indicadores estadísticos de porcentajes de vidrio en los residuos sólidos en el estudio de la calidad de agua en Europa(1991-2017)
Variable Rango X Me Mo V Sd Cv As K Rango Atípicos
Porcentaje vidrios (%) [2.2 ; 21.4] 7.66 10 [8 ; 10] 10.75 3.28 42.82 -0.58 0.16 [21.4 ; 21.4] (Valores: 82)
Autor: Grupo 3

7.Conclusión

La variable Porcentaje de vidrios (%) fluctúa entre 2.2 y 21.4, y sus valores giran en torno a una mediana de 10, con una desviación estándar de 3.28. Dado que el coeficiente de variación es de 42.82%, se trata de un conjunto de valores heterogéneo. Los datos presentan una asimetría negativa, lo que indica que los valores se acumulan de manera pronunciada en la parte alta de la variable. Con la presencia de valores atípicos en el intervalo de 21.4 a 21.4 (82 valores), resulta perjudicial para la gestión ambiental, ya que evidencia una acumulación o presencia focalizada de residuos de vidrio en los cuerpos hídricos o zonas de estudio en Europa.