0. Carga de 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

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

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

CMP <- na.omit(datos$composition_metal_percent)

3. Frecuencia

3.1 Tamaño de muestra

n <- length(CMP)

3.2 Rango

minimo <- min(CMP)
maximo <- max(CMP)

R <- maximo - minimo

3.3 Regla de Sturges

k <- ceiling(1 + 3.322 * log10(n))

cat("Número de intervalos:", k)

## Número de intervalos: 16

3.4 Amplitud

A <- R / k

3.5 Construcción de intervalos

Li <- seq(
  from = minimo,
  to = maximo - A,
  by = A
)

Ls <- c(
  seq(
    from = minimo + A,
    to = maximo - A,
    by = A
  ),
  maximo
)

Li <- round(Li, 2)
Ls <- round(Ls, 2)

MC <- round((Li + Ls) / 2, 2)

3.6 Construcción de la tabla de frecuencias

# =========================
# FRECUENCIAS ABSOLUTAS
# =========================

ni <- numeric(length(Li))

for(i in 1:length(Li)){
  
  if(i < length(Li)){
    
    ni[i] <- sum(
      CMP >= Li[i] &
      CMP < Ls[i]
    )
    
  }else{
    
    ni[i] <- sum(
      CMP >= Li[i] &
      CMP <= Ls[i]
    )
    
  }
}

# =========================
# FRECUENCIAS RELATIVAS
# =========================

hi <- round((ni/n)*100,2)

Ni_asc <- cumsum(ni)
Ni_desc <- rev(cumsum(rev(ni)))

Hi_asc <- round(cumsum(hi),2)
Hi_desc <- round(rev(cumsum(rev(hi))),2)

# =========================
# INTERVALOS
# =========================

Intervalo <- paste0(
  "[",
  Li,
  " - ",
  Ls,
  ")"
)

Intervalo[length(Intervalo)] <- paste0(
  "[",
  Li[length(Li)],
  " - ",
  Ls[length(Ls)],
  "]"
)

# =========================
# TABLA
# =========================

TDF_CMP <- data.frame(
  Intervalo,
  MC,
  ni,
  hi,
  Ni_asc,
  Ni_desc,
  Hi_asc,
  Hi_desc
)

4. Tabla de frecuencias

4.1 Tabla completa

Totales <- data.frame(
  Intervalo = "TOTAL",
  MC = "-",
  ni = sum(ni),
  hi = 100,
  Ni_asc = "-",
  Ni_desc = "-",
  Hi_asc = "-",
  Hi_desc = "-"
)

TDF_CMP_total <- rbind(
  TDF_CMP,
  Totales
)

TDF_CMP_total %>%
  gt() %>%
  tab_header(
    title = md("**Tabla N°1**"),
    subtitle = md(
      "**Distribución de frecuencias del porcentaje de metales en el estudio de la calidad de agua en Europa (1991-2017)**"
    )
  ) %>%
  cols_label(
    Intervalo = "Intervalo",
    MC = "MC",
    ni = "ni",
    hi = "hi (%)",
    Ni_asc = "Ni ↑",
    Ni_desc = "Ni ↓",
    Hi_asc = "Hi ↑ (%)",
    Hi_desc = "Hi ↓ (%)"
  ) %>%
  tab_source_note(
    source_note = md("Autor: Grupo 3")
  )

Intervalo	MC	ni	hi (%)	Ni ↑	Ni ↓	Hi ↑ (%)	Hi ↓ (%)
Tabla N°1
Distribución de frecuencias del porcentaje de metales en el estudio de la calidad de agua en Europa (1991-2017)
[1.38 - 1.87)	1.62	1060	5.33	1060	19893	5.33	100
[1.87 - 2.36)	2.12	623	3.13	1683	18833	8.46	94.67
[2.36 - 2.85)	2.6	427	2.15	2110	18210	10.61	91.54
[2.85 - 3.34)	3.09	12824	64.46	14934	17783	75.07	89.39
[3.34 - 3.82)	3.58	4001	20.11	18935	4959	95.18	24.93
[3.82 - 4.31)	4.06	108	0.54	19043	958	95.72	4.82
[4.31 - 4.8)	4.56	91	0.46	19134	850	96.18	4.28
[4.8 - 5.29)	5.04	0	0.00	19134	759	96.18	3.82
[5.29 - 5.78)	5.54	0	0.00	19134	759	96.18	3.82
[5.78 - 6.27)	6.03	27	0.14	19161	759	96.32	3.82
[6.27 - 6.76)	6.52	82	0.41	19243	732	96.73	3.68
[6.76 - 7.24)	7	0	0.00	19243	650	96.73	3.27
[7.24 - 7.73)	7.48	0	0.00	19243	650	96.73	3.27
[7.73 - 8.22)	7.98	0	0.00	19243	650	96.73	3.27
[8.22 - 8.71)	8.46	479	2.41	19722	650	99.14	3.27
[8.71 - 9.2]	8.96	171	0.86	19893	171	100	0.86
TOTAL	-	19893	100.00	-	-	-	-
Autor: Grupo 3

4.2 Tabla simplificada

k2 <- 10

A2 <- R/k2

Li2 <- seq(
  minimo,
  maximo-A2,
  by=A2
)

Ls2 <- c(
  seq(
    minimo+A2,
    maximo-A2,
    by=A2
  ),
  maximo
)

Li2 <- round(Li2,2)
Ls2 <- round(Ls2,2)

MC2 <- round((Li2+Ls2)/2,2)

ni2 <- numeric(length(Li2))

for(i in 1:length(Li2)){
  
  if(i < length(Li2)){
    
    ni2[i] <- sum(
      CMP >= Li2[i] &
      CMP < Ls2[i]
    )
    
  }else{
    
    ni2[i] <- sum(
      CMP >= Li2[i] &
      CMP <= Ls2[i]
    )
    
  }
}

hi2 <- round((ni2/n)*100,2)

Ni2_asc <- cumsum(ni2)
Ni2_desc <- rev(cumsum(rev(ni2)))

Hi2_asc <- round(cumsum(hi2),2)
Hi2_desc <- round(rev(cumsum(rev(hi2))),2)

Intervalo2 <- paste0(
  "[",
  Li2,
  " - ",
  Ls2,
  ")"
)

Intervalo2[length(Intervalo2)] <- paste0(
  "[",
  Li2[length(Li2)],
  " - ",
  Ls2[length(Ls2)],
  "]"
)

TDF_CMP_10 <- data.frame(
  Intervalo = Intervalo2,
  MC = MC2,
  ni = ni2,
  hi = hi2,
  Ni_asc = Ni2_asc,
  Ni_desc = Ni2_desc,
  Hi_asc = Hi2_asc,
  Hi_desc = Hi2_desc
)

Totales2 <- data.frame(
  Intervalo = "TOTAL",
  MC = "-",
  ni = sum(ni2),
  hi = 100,
  Ni_asc = "-",
  Ni_desc = "-",
  Hi_asc = "-",
  Hi_desc = "-"
)

TDF_CMP_10_total <- rbind(
  TDF_CMP_10,
  Totales2
)

TDF_CMP_10_total %>%
  gt() %>%
  tab_header(
    title = md("**Tabla N°2**"),
    subtitle = md(
      "**Distribución de frecuencias del porcentaje de metales en el estudio de la calidad de agua en Europa (1991-2017)**"
    )
  ) %>%
  cols_label(
    Intervalo = "Intervalo",
    MC = "MC",
    ni = "ni",
    hi = "hi (%)",
    Ni_asc = "Ni ↑",
    Ni_desc = "Ni ↓",
    Hi_asc = "Hi ↑ (%)",
    Hi_desc = "Hi ↓ (%)"
  ) %>%
  tab_source_note(
    source_note = md("Autor: Grupo 3")
  )

Intervalo	MC	ni	hi (%)	Ni ↑	Ni ↓	Hi ↑ (%)	Hi ↓ (%)
Tabla N°2
Distribución de frecuencias del porcentaje de metales en el estudio de la calidad de agua en Europa (1991-2017)
[1.38 - 2.16)	1.77	1682	8.46	1682	19893	8.46	100.01
[2.16 - 2.94)	2.55	428	2.15	2110	18211	10.61	91.55
[2.94 - 3.73)	3.34	16825	84.58	18935	17783	95.19	89.4
[3.73 - 4.51)	4.12	199	1.00	19134	958	96.19	4.82
[4.51 - 5.29)	4.9	0	0.00	19134	759	96.19	3.82
[5.29 - 6.07)	5.68	0	0.00	19134	759	96.19	3.82
[6.07 - 6.85)	6.46	109	0.55	19243	759	96.74	3.82
[6.85 - 7.64)	7.24	0	0.00	19243	650	96.74	3.27
[7.64 - 8.42)	8.03	479	2.41	19722	650	99.15	3.27
[8.42 - 9.2]	8.81	171	0.86	19893	171	100.01	0.86
TOTAL	-	19893	100.00	-	-	-	-
Autor: Grupo 3

5. Gráficas

5.1 Histograma

bp <- barplot(
  TDF_CMP_10$ni,
  space = 0,
  names.arg = FALSE,
  xaxt = "n",
  yaxt = "n",
  main = "Gráfica N°1: Distribución del porcentaje de metales\nen el estudio de la calidad de agua en Europa (1991-2017)",
  xlab = "Porcentaje de metales",
  ylab = "Cantidad",
  col = "skyblue",
  border = "black",
  ylim = c(0, max(TDF_CMP_10$ni)*1.10),
  cex.main = 0.9
)

axis(
  1,
  at = c(bp[1], bp[3], bp[5], bp[7], bp[10]),
  labels = round(c(MC2[1], MC2[3], MC2[5], MC2[7], MC2[10]),2),
  las = 1
)

axis(
  2,
  at = pretty(c(0,max(TDF_CMP_10$ni))),
  las = 1
)

grid()

5.2 Histograma general

bp <- barplot(
  TDF_CMP_10$ni,
  space = 0,
  names.arg = FALSE,
  xaxt = "n",
  yaxt = "n",
  main = "Gráfica N°2: Distribución del porcentaje de metales\nen el estudio de la calidad de agua en Europa (1991-2017)",
  xlab = "Porcentaje de metales",
  ylab = "Cantidad",
  col = "red",
  border = "black",
  ylim = c(0,20000),
  cex.main = 0.9
)

axis(
  1,
  at = c(bp[1], bp[3], bp[5], bp[7], bp[10]),
  labels = round(c(MC2[1], MC2[3], MC2[5], MC2[7], MC2[10]),2),
  las = 1
)

axis(
  2,
  at = seq(0,20000,5000),
  las = 1
)

grid()

5.3 Histograma porcentual

bp <- barplot(
  TDF_CMP_10$hi,
  space = 0,
  names.arg = FALSE,
  xaxt = "n",
  yaxt = "n",
  main = "Gráfica N°3: Distribución porcentual del porcentaje de metales\nen el estudio de la calidad de agua en Europa (1991-2017)",
  xlab = "Porcentaje de metales",
  ylab = "Porcentaje (%)",
  col = "skyblue",
  border = "black",
  ylim = c(0,max(TDF_CMP_10$hi)*1.15),
  cex.main = 0.9
)

axis(
  1,
  at = c(bp[1], bp[3], bp[5], bp[7], bp[10]),
  labels = round(c(MC2[1], MC2[3], MC2[5], MC2[7], MC2[10]),2),
  las = 1
)

axis(
  2,
  at = pretty(c(0,max(TDF_CMP_10$hi))),
  las = 1
)

grid()

5.4 Histograma porcentual general

bp <- barplot(
  TDF_CMP_10$hi,
  space = 0,
  names.arg = FALSE,
  xaxt = "n",
  yaxt = "n",
  main = "Gráfica N°4: Distribución porcentual del porcentaje de metales\nen el estudio de la calidad de agua en Europa (1991-2017)",
  xlab = "Porcentaje de metales",
  ylab = "Porcentaje (%)",
  col = "green",
  border = "black",
  ylim = c(0,100),
  cex.main = 0.9
)

axis(
  1,
  at = c(bp[1], bp[3], bp[5], bp[7], bp[10]),
  labels = round(c(MC2[1], MC2[3], MC2[5], MC2[7], MC2[10]),2),
  las = 1
)

axis(
  2,
  at = seq(0,100,20),
  las = 1
)

grid()

5.5 Polígono porcentual

bp <- barplot(
  TDF_CMP_10$hi,
  space = 0,
  names.arg = FALSE,
  xaxt = "n",
  yaxt = "n",
  main = "Gráfica N°6: Polígono porcentual del porcentaje de metales\nen el estudio de la calidad de agua en Europa (1991-2017)",
  xlab = "Porcentaje de metales",
  ylab = "Porcentaje (%)",
  col = "lightgreen",
  border = "black",
  ylim = c(0,max(TDF_CMP_10$hi)*1.15)
)

axis(
  1,
  at = c(bp[1],bp[3],bp[5],bp[7],bp[10]),
  labels = round(c(MC2[1],MC2[3],MC2[5],MC2[7],MC2[10]),2),
  las = 1
)

axis(2, las=1)

lines(
  bp,
  TDF_CMP_10$hi,
  type="b",
  pch=16,
  lwd=2,
  col="blue"
)

grid()

5.6 Diagrama de caja

# =========================
# DIAGRAMA DE CAJA
# =========================

boxplot(
  CMP,
  horizontal = TRUE,
  main = "Gráfica N°7: Diagrama de caja del porcentaje de metales\nen el estudio de la calidad de agua en Europa (1991-2017)",
  xlab = "Porcentaje de metales",
  col = "plum",
  border = "purple4",
  pch = 19,
  cex = 0.6
)

grid()

 # La caja no se visualiza claramente debido a que el 50 % central de los datos se encuentra concentrado en un intervalo muy pequeño de valores. Esto hace que el rango intercuartílico sea muy reducido, por lo que la caja se representa gráficamente como una línea muy delgada.

5.7 Ojiva de frecuencias

# =========================
# OJIVA DE FRECUENCIAS
# =========================

plot(
  MC2,
  Ni2_asc,
  type = "b",
  pch = 19,
  col = "blue",
  lwd = 2,
  ylim = c(0, n),
  xlab = "Porcentaje de metales",
  ylab = "Frecuencia acumulada",
  main = "Gráfica N°8: Ojiva de frecuencias del porcentaje de metales\nen el estudio de la calidad de agua en Europa (1991-2017)"
)

lines(
  MC2,
  Ni2_desc,
  type = "b",
  pch = 19,
  col = "red",
  lwd = 2
)

legend(
  "right",
  legend = c("Ascendente", "Descendente"),
  col = c("blue", "red"),
  pch = 19,
  lty = 1,
  bty = "n"
)

grid()

5.8 Ojiva porcentual

# =========================
# OJIVA PORCENTUAL
# =========================

plot(
  MC2,
  Hi2_asc,
  type = "b",
  pch = 19,
  col = "darkgreen",
  lwd = 2,
  ylim = c(0, 100),
  xlab = "Porcentaje de metales",
  ylab = "Porcentaje acumulado (%)",
  main = "Gráfica N°9: Ojiva porcentual del porcentaje de metales\nen el estudio de la calidad de agua en Europa (1991-2017)"
)

lines(
  MC2,
  Hi2_desc,
  type = "b",
  pch = 19,
  col = "orange",
  lwd = 2
)

legend(
  "right",
  legend = c("Ascendente", "Descendente"),
  col = c("darkgreen", "orange"),
  pch = 19,
  lty = 1,
  bty = "n"
)

grid()

6. Indicadores Estadísticos

# =========================
# INDICADORES ESTADÍSTICOS
# =========================

# Media
X <- mean(CMP)

# Mediana
Me <- median(CMP)

# Moda (intervalo modal)
indice_moda <- which.max(TDF_CMP_10$ni)
Mo <- TDF_CMP_10$Intervalo[indice_moda]

# Rango
Rango <- paste0(
  "[",
  round(min(CMP),2),
  " - ",
  round(max(CMP),2),
  "]"
)

# Varianza
V <- var(CMP)

# Desviación estándar
Sd <- sd(CMP)

# Coeficiente de variación
Cv <- (Sd/X)*100

# =========================
# ASIMETRÍA
# =========================

n <- length(CMP)

As <- (n*sum((CMP-X)^3)) /
((n-1)*(n-2)*(Sd^3))

# =========================
# CURTOSIS
# =========================

K <- (sum((CMP-X)^4)/(n*(Sd^4))) - 3

# =========================
# VALORES ATÍPICOS
# =========================

Q1 <- quantile(CMP,0.25)

Q3 <- quantile(CMP,0.75)

RIQ <- IQR(CMP)

LI <- Q1 - 1.5*RIQ

LS <- Q3 + 1.5*RIQ

Atipicos <- sum(
  CMP < LI |
  CMP > LS
)

# =========================
# TABLA
# =========================

Tabla_indicadores <- data.frame(

Variable = "Porcentaje de metales",

Rango = Rango,

Media = round(X,2),

Mediana = round(Me,2),

Moda = Mo,

Varianza = round(V,2),

Desv_Est = round(Sd,2),

CV = round(Cv,2),

Asimetria = round(As,2),

Curtosis = round(K,2),

Valores_Atipicos = Atipicos

)

Tabla_indicadores %>%

gt() %>%

tab_header(

title = md("**Tabla N°3**"),

subtitle = md(
"**Indicadores estadísticos del porcentaje de metales en el estudio de la calidad de agua en Europa (1991-2017)**"
)

) %>%

cols_label(

Variable = "Variable",

Rango = "Rango",

Media = "Media",

Mediana = "Mediana",

Moda = "Moda",

Varianza = "Varianza",

Desv_Est = "Desv. Est.",

CV = "CV (%)",

Asimetria = "As",

Curtosis = "K",

Valores_Atipicos = "Valores Atípicos"

) %>%

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,

table.align = "center"

)

Variable	Rango	Media	Mediana	Moda	Varianza	Desv. Est.	CV (%)	As	K	Valores Atípicos
Tabla N°3
Indicadores estadísticos del porcentaje de metales en el estudio de la calidad de agua en Europa (1991-2017)
Porcentaje de metales	[1.38 - 9.2]	3.2	3	[2.94 - 3.73)	1.28	1.13	35.36	3.54	15.3	7069
Autor: Grupo 3

7. Conclusión

#La variable porcentaje de metales fluctúa entre 1.38 y 9.20, con una media de 3.20 y una desviación estándar de 1.13. Debido a un CV de 35.36 %, presenta un comportamiento heterogéneo y 7069 valores atípicos. La caja del diagrama se visualiza como una línea debido a la alta concentración del 50 % central de los datos.

Porcentaje de metales

Universidad Central del Ecuador

06/05/2026

0. Carga de librerías

1. Leer datos

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

3. Frecuencia

3.1 Tamaño de muestra

3.2 Rango

3.3 Regla de Sturges

3.4 Amplitud

3.5 Construcción de intervalos

3.6 Construcción de la tabla de frecuencias

4. Tabla de frecuencias

4.1 Tabla completa

4.2 Tabla simplificada

5. Gráficas

5.1 Histograma

5.2 Histograma general

5.3 Histograma porcentual

5.4 Histograma porcentual general

5.5 Polígono porcentual

5.6 Diagrama de caja

5.7 Ojiva de frecuencias

5.8 Ojiva porcentual

6. Indicadores Estadísticos

7. Conclusión