Porcentaje de metales

0. 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 Rango

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

R <- maximo - minimo

3.2 Regla de Sturges

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

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

## Número de intervalos: 16

3.4 Limites de clase

A <- R / k
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.5 Creación de columnas

# =========================
# 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(
  Li = Li,
  Ls = Ls,
  Intervalo = Intervalo,
  MC = MC,
  ni = ni,
  hi = hi,
  Ni_asc = Ni_asc,
  Ni_desc = Ni_desc,
  Hi_asc = Hi_asc,
  Hi_desc = Hi_desc
)

4. Tabla de frecuencias

4.1 Tabla generada con Sturges

Totales <- data.frame(
  Li = "-",
  Ls = "-",
  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(
    Li = "Li",
    Ls = "Ls",
    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")
  ) %>%
  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"
  )

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

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

CMP_filtrado <- CMP[CMP <= quantile(CMP, 0.99, na.rm = TRUE)]

# Histograma
histoCMP <- hist(
  CMP_filtrado,
  breaks = 6,
  plot = FALSE
)

# Límites
Limites <- histoCMP$breaks

LimInf <- round(Limites[-length(Limites)], 2)

LimSup <- round(Limites[-1], 2)

LimSup[length(LimSup)] <- 10

# =============================================
# TABLA BASE
# =============================================

TDF_CMP <- data.frame(
  Li = LimInf,
  Ls = LimSup,
  Intervalo = paste0(
    "[",
    LimInf,
    " - ",
    LimSup,
    ")"
  ),
  MC = round(histoCMP$mids, 2),
  ni = histoCMP$counts
)

# Cerrar el último intervalo

TDF_CMP$Intervalo[nrow(TDF_CMP)] <- paste0(
  "[",
  LimInf[length(LimInf)],
  " - ",
  LimSup[length(LimSup)],
  "]"
)

# Eliminar intervalos vacíos

TDF_CMP <- subset(
  TDF_CMP,
  ni > 0
)

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

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

# Ajustar para que sume 100 %

TDF_CMP$hi[nrow(TDF_CMP)] <-
  round(
    100 -
      sum(TDF_CMP$hi[-nrow(TDF_CMP)]),
    2
  )

# =============================================
# FRECUENCIAS ACUMULADAS
# =============================================

TDF_CMP$Ni_asc <- cumsum(TDF_CMP$ni)

TDF_CMP$Ni_desc <- rev(cumsum(rev(TDF_CMP$ni)))

TDF_CMP$Hi_asc <- round(cumsum(TDF_CMP$hi), 2)

TDF_CMP$Hi_desc <- round(rev(cumsum(rev(TDF_CMP$hi))), 2)

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

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

TDF_CMP_total <- rbind(
  TDF_CMP,
  Totales
)

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

TDF_CMP_total %>%
  gt() %>%
  tab_header(
    title = md("**Tabla N°2**"),
    subtitle = md(
      "**Distribución de frecuencias simplificada del porcentaje de metales en el estudio de la calidad de agua en Europa (1991-2017)**"
    )
  ) %>%
  cols_label(
    Li = "Li",
    Ls = "Ls",
    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")
  ) %>%
  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"
  )

Tabla N°2
Distribución de frecuencias simplificada del porcentaje de metales en el estudio de la calidad de agua en Europa (1991-2017)
Li	Ls	Intervalo	MC	ni	hi (%)	Ni ↑	Ni ↓	Hi ↑ (%)	Hi ↓ (%)
1	2	[1 - 2)	1.5	1663	8.43	1663	19722	8.43	100
2	3	[2 - 3)	2.5	13271	67.29	14934	18059	75.72	91.57
3	4	[3 - 4)	3.5	4004	20.30	18938	4788	96.02	24.28
4	5	[4 - 5)	4.5	196	0.99	19134	784	97.01	3.98
6	7	[6 - 7)	6.5	109	0.55	19243	588	97.56	2.99
8	10	[8 - 10]	8.5	479	2.44	19722	479	100	2.44
-	-	TOTAL	-	19722	100.00	-	-	-	-
Autor: Grupo 3

Limites <- histoCMP$breaks
Limites[length(Limites)] <- 10

5. Gráficas

5.1 Histograma (ni)

bp <- barplot(
  TDF_CMP$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$ni) * 1.10),
  cex.main = 0.9
)

axis(
  1,
  at = bp,
  labels = TDF_CMP$Intervalo,
  las = 2,
  cex.axis = 0.8
)

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

grid()

5.2 Histograma general (ni)

bp <- barplot(
  TDF_CMP$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 = bp,
  labels = TDF_CMP$Intervalo,
  las = 2,
  cex.axis = 0.8
)

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

grid()

5.3 Histograma porcentual (hi)

bp <- barplot(
  TDF_CMP$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$hi) * 1.15),
  cex.main = 0.9
)

axis(
  1,
  at = bp,
  labels = TDF_CMP$Intervalo,
  las = 2,
  cex.axis = 0.8
)

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

grid()

5.4 Histograma porcentual general (hi)

bp <- barplot(
  TDF_CMP$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 = bp,
  labels = TDF_CMP$Intervalo,
  las = 2,
  cex.axis = 0.8
)

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

grid()

5.5 Polígono de frecuencias (hi)

bp <- barplot(
  TDF_CMP$hi,
  space = 0,
  names.arg = FALSE,
  xaxt = "n",
  yaxt = "n",
  main = "Gráfica N°5: 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$hi) * 1.15)
)

axis(
  1,
  at = bp,
  labels = TDF_CMP$Intervalo,
  las = 2,
  cex.axis = 0.8
)

axis(2, las = 1)

lines(
  bp,
  TDF_CMP$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°6: 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 ascendente y descendente

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

par(mar = c(9,4,4,2))

# Agregar punto inicial
x_pos <- 0:nrow(TDF_CMP)

Ni_asc <- c(0, TDF_CMP$Ni_asc)
Ni_desc <- c(sum(TDF_CMP$ni), TDF_CMP$Ni_desc)

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

lines(
  x_pos,
  Ni_desc,
  type = "b",
  pch = 19,
  lwd = 2,
  col = "red"
)

axis(
  1,
  at = x_pos,
  labels = c("", TDF_CMP$Intervalo),
  las = 2,
  cex.axis = 0.8
)

axis(
  2,
  at = pretty(c(0, sum(TDF_CMP$ni))),
  las = 1
)

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

grid()

5.8 Ojiva de frecuencia relativa

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

par(mar = c(9,4,4,2))

# Agregar punto inicial
x_pos <- 0:nrow(TDF_CMP)

Hi_asc <- c(0, TDF_CMP$Hi_asc)
Hi_desc <- c(100, TDF_CMP$Hi_desc)

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

lines(
  x_pos,
  Hi_desc,
  type = "b",
  pch = 19,
  lwd = 2,
  col = "orange"
)

axis(
  1,
  at = x_pos,
  labels = c("", TDF_CMP$Intervalo),
  las = 2,
  cex.axis = 0.8
)

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

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

grid()

6. Indicadores estadísticos

6.1 Indicadores de tendencia central

# Media
media <- round(mean(CMP), 2)

# Mediana
mediana <- round(median(CMP), 2)

# Moda (intervalo modal)
indice_moda <- which.max(TDF_CMP$ni)

moda <- paste0(
  "[",
  TDF_CMP$Li[indice_moda],
  " ; ",
  TDF_CMP$Ls[indice_moda],
  "]"
)
atipicos <- boxplot.stats(CMP)$out

n_atipicos <- length(atipicos)

if(n_atipicos > 0){

  rango_atipicos <- paste0(
    "[",
    round(min(atipicos), 2),
    " ; ",
    round(max(atipicos), 2),
    "] (",
    n_atipicos,
    " valores)"
  )

}else{

  rango_atipicos <- "No existen"

}

6.2 Dispersión

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

# Varianza
varianza <- round(var(CMP), 2)

# Desviación estándar
desv_est <- round(sd(CMP), 2)

# Coeficiente de variación
cv <- round((desv_est / media) * 100, 2)

6.3 Asimetría y curtosis

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

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

6.4 Tabla de indicadores

tabla_indicadores <- data.frame(

  Variable = "Porcentaje de metales",

  Rango = rango,

  X = media,

  Me = mediana,

  Mo = moda,

  V = varianza,

  Sd = desv_est,

  Cv = cv,

  As = asimetria,

  K = curtosis,

  Valores_Atipicos = rango_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",
    X = "X",
    Me = "Me",
    Mo = "Mo",
    V = "V",
    Sd = "Sd",
    Cv = "Cv (%)",
    As = "As",
    K = "K",
    Valores_Atipicos = "Rango 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"
  )

Tabla N°3
Indicadores estadísticos del porcentaje de metales 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 de metales	[1.38 ; 9.2]	3.2	3	[2 ; 3]	1.28	1.13	35.31	3.53	15.3	[1.38 ; 9.2] (7069 valores)
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 mediana de 3. El coeficiente de variación de 35.36 % indica una variabilidad moderada. La distribución presenta una asimetría positiva y una curtosis elevada, evidenciando la presencia de valores altos poco frecuentes. Además, los 7069 valores atípicos resultan perjudiciales para la calidad del agua, ya que reflejan cuerpos hídricos con concentraciones de metales superiores al comportamiento general observado en Europa.