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 correctamente sobre toda la secuencia continua
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 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

Li	Ls	MC	ni	hi (%)	Ni ↑	Ni ↓	Hi ↑ (%)	Hi ↓ (%)
Tabla Nº1
Distribución de frecuencias de composición porcentual de vidrios en el estudio de la calidad de agua en Europa (1991-2017)
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 (SIMPLIFICADA CONTINUA Y AJUSTADA)
# ================================================

# Crear 10 intervalos continuos redondeados
cortes <- seq(
  floor(min(CGP)),
  ceiling(max(CGP)),
  length.out = 11
)

# Histograma base para conteo sin graficar
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 basados en las frecuencias acumuladas reales
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 de 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

Límite Inferior	Límite Superior	Marca de Clase	ni	hi (%)	Ni ↑	Ni ↓	Hi ↑ (%)	Hi ↓ (%)
Tabla Nº2
Distribución de frecuencias de composición porcentual de vidrios agruados en el estudio de la calidad de agua en Europa (1991-2017)
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 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"
)

# Mostrar las marcas de clase en el eje X
axis(
  side = 1,
  at = TDF_Histo_CGP$Mc,
  labels = round(TDF_Histo_CGP$Mc, 1),
  las = 2,
  cex.axis = 0.8
)

grid()

5.2 Histograma General (ni)

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

barplot(
  TDF_Histo_CGP$ni,
  names.arg = TDF_Histo_CGP$Mc,
  col = "lightsteelblue2",
  border = "black",
  main = "Gráfica Nº2: Distribución de frecuencias de 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,
  ylim = c(0, 20000)
)

grid()

5.3 Histograma Porcentual (hi)

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

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

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)

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

grid()

5.5 Polígono de frecuencias (hi)

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

# Polígono cerrado
x_pol <- c(
  bp[1] - (bp[2] - bp[1]),  # punto inicial
  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 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))
plot(
  TDF_Histo_CGP$LimInf,
  TDF_Histo_CGP$Ni_dsc,
  main = "Gráfica Nº7: Ojiva ascendente y descendente de composición 
  porcentual de vidrios en el estudio de la calidad de 
  agua en Europa (1991-2017)",
  xlab = "Porcentaje de vidrio (%)",
  ylab = "Cantidad",
  col = "black",
  type = "o",
  lwd = 2
)

lines(
  TDF_Histo_CGP$LimSup,
  TDF_Histo_CGP$Ni_asc,
  col = "steelblue3",
  type = "o",
  lwd = 2
)

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))
plot(
  TDF_Histo_CGP$LimSup,
  TDF_Histo_CGP$Hi_asc,
  type = "o",
  col = "steelblue1",
  pch = 16,
  lwd = 2,
  main = "Gráfica Nº8: Ojiva ascendente y descendente de 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)
)

# Ojiva Descendente
lines(
  TDF_Histo_CGP$LimInf,
  TDF_Histo_CGP$Hi_dsc,
  type = "o",
  col = "black",
  pch = 17,
  lwd = 2
)

grid()

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)

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 = n_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)**")
  ) %>%
  tab_source_note(
    source_note = md("Autor: Grupo 3")
  )

tabla_indicadores_gt

Variable	Rango	X	Me	Mo	V	Sd	Cv	As	K	Valores_Atipicos
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)
Porcentaje vidrios (%)	[2.2 ; 21.4]	7.66	10	[8 ; 10]	10.75	3.28	42.82	-0.58	0.16	82
Autor: Grupo 3

7.Conclusión

La variable Porcentajes de Vidrio fluctúa en un rango de [2.2; 21.4], y sus valores giran en torno a una mediana de 10, con una desviación estándar de 3.28, lo que representa un conjunto de datos con una variabilidad alta CV = 42.82. Los valores presentan una asimetría negativa As = -0.58, indicando una concentración de los datos hacia valores mayores a la media, y una curtosis de K = 0.16, lo que evidencia una distribución prácticamente mesocúrtica. Cabe destacar la identificación de 82 valores atípicos, la cantidad de valores atípicos y la desviación estándar señalan una heterogeneidad dentro del monitoreo de la calidad del agua en Europa (1991–2017).

Porcentaje de vidrio

Universidad Central del Ecuador

2026-05-22