Porcentaje de otros residuos

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

COP <- na.omit(datos$composition_other_percent)

3. Frecuencia

3.1 Rango

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

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 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(
      COP >= Li[i] &
      COP < Ls[i]
    )
    
  }else{
    
    ni[i] <- sum(
      COP >= Li[i] &
      COP <= 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_COP <- data.frame(
  Li,
  Ls,
  Intervalo,
  MC,
  ni,
  hi,
  Ni_asc,
  Ni_desc,
  Hi_asc,
  Hi_desc
)

4 Tabla de distribución de frecuencias

4.1 Tabla generada con Sturges

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

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

TDF_COP_total <- rbind(
  TDF_COP,
  Totales
)

TDF_COP_total %>%
  gt() %>%
  tab_header(
    title = md("**Tabla N°1**"),
    subtitle = md(
      "**Distribución de frecuencias del porcentaje de otros residuos 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")
  )

Tabla N°1
Distribución de frecuencias del porcentaje de otros residuos en el estudio de la calidad de agua en Europa (1991-2017)
Li	Ls	Intervalo	MC	ni	hi (%)	Ni ↑	Ni ↓	Hi ↑ (%)	Hi ↓ (%)
0	2.75	[0 - 2.75)	1.38	171	0.86	171	19893	0.86	100.02
2.75	5.51	[2.75 - 5.51)	4.13	0	0.00	171	19722	0.86	99.16
5.51	8.26	[5.51 - 8.26)	6.88	0	0.00	171	19722	0.86	99.16
8.26	11.01	[8.26 - 11.01)	9.63	199	1.00	370	19722	1.86	99.16
11.01	13.77	[11.01 - 13.77)	12.39	401	2.02	771	19523	3.88	98.16
13.77	16.52	[13.77 - 16.52)	15.14	3721	18.71	4492	19122	22.59	96.14
16.52	19.27	[16.52 - 19.27)	17.9	1083	5.44	5575	15401	28.03	77.43
19.27	22.02	[19.27 - 22.02)	20.64	7	0.04	5582	14318	28.07	71.99
22.02	24.78	[22.02 - 24.78)	23.4	82	0.41	5664	14311	28.48	71.95
24.78	27.53	[24.78 - 27.53)	26.16	9721	48.87	15385	14229	77.35	71.54
27.53	30.28	[27.53 - 30.28)	28.91	4014	20.18	19399	4508	97.53	22.67
30.28	33.04	[30.28 - 33.04)	31.66	0	0.00	19399	494	97.53	2.49
33.04	35.79	[33.04 - 35.79)	34.42	5	0.03	19404	494	97.56	2.49
35.79	38.54	[35.79 - 38.54)	37.16	0	0.00	19404	489	97.56	2.46
38.54	41.3	[38.54 - 41.3)	39.92	261	1.31	19665	489	98.87	2.46
41.3	44.05	[41.3 - 44.05]	42.67	228	1.15	19893	228	100.02	1.15
-	-	TOTAL	-	19893	100.00	-	-	-	-
Autor: Grupo 3

4.2 Tabla simplificada

# =========================
# REDUCCIÓN A 10 INTERVALOS
# =========================

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(
      COP>=Li2[i] &
      COP<Ls2[i]
    )
    
  }else{
    
    ni2[i] <- sum(
      COP>=Li2[i] &
      COP<=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_COP_10 <- data.frame(
  Li = Li2,
  Ls = Ls2,
  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(
  Li = "-",
  Ls = "-",
  Intervalo = "TOTAL",
  MC = "-",
  ni = sum(ni2),
  hi = 100,
  Ni_asc = "-",
  Ni_desc = "-",
  Hi_asc = "-",
  Hi_desc = "-"
)

TDF_COP_10_total <- rbind(
  TDF_COP_10,
  Totales2
)

TDF_COP_10_total %>%
  gt() %>%
  tab_header(
    title = md("**Tabla N°2**"),
    subtitle = md(
      "**Distribución de frecuencias simplificada del porcentaje de otros
      residuos 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")
  )

Tabla N°2
**Distribución de frecuencias simplificada del porcentaje de otros residuos en el estudio de la calidad de agua en Europa (1991-2017) **
Li	Ls	Intervalo	MC	ni	hi (%)	Ni ↑	Ni ↓	Hi ↑ (%)	Hi ↓ (%)
0	4.4	[0 - 4.4)	2.2	171	0.86	171	19893	0.86	100.01
4.4	8.81	[4.4 - 8.81)	6.61	0	0.00	171	19722	0.86	99.15
8.81	13.21	[8.81 - 13.21)	11.01	600	3.02	771	19722	3.88	99.15
13.21	17.62	[13.21 - 17.62)	15.42	3850	19.35	4621	19122	23.23	96.13
17.62	22.02	[17.62 - 22.02)	19.82	961	4.83	5582	15272	28.06	76.78
22.02	26.43	[22.02 - 26.43)	24.23	9787	49.20	15369	14311	77.26	71.95
26.43	30.83	[26.43 - 30.83)	28.63	4030	20.26	19399	4524	97.52	22.75
30.83	35.24	[30.83 - 35.24)	33.03	5	0.03	19404	494	97.55	2.49
35.24	39.64	[35.24 - 39.64)	37.44	0	0.00	19404	489	97.55	2.46
39.64	44.05	[39.64 - 44.05]	41.84	489	2.46	19893	489	100.01	2.46
-	-	TOTAL	-	19893	100.00	-	-	-	-
Autor: Grupo 3

5. Gráficas

5.1 Histograma (ni)

# =========================
# HISTOGRAMA DE CANTIDAD
# =========================

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

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

axis(
  1,
  at = bp,
  labels = TDF_COP_10$Intervalo,
  las = 2,
  cex.axis = 0.75
)

# Eje Y
axis(
  2,
  at = pretty(c(0, max(TDF_COP_10$ni))),
  las = 1
)

grid()
mtext(
  "Porcentaje de otros residuos",
  side = 1,
  line = 8,
  cex = 1
)

5.2 Histograma general (ni)

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

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

axis(
  1,
  at = bp,
  labels = TDF_COP_10$Intervalo,
  las = 2,
  cex.axis = 0.75
)

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

grid()
mtext(
  "Porcentaje de otros residuos",
  side = 1,
  line = 8,
  cex = 1
)

5.3 Histograma porcentual (hi)

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

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

axis(
  1,
  at = bp,
  labels = TDF_COP_10$Intervalo,
  las = 2,
  cex.axis = 0.75
)

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

grid()
mtext(
  "Porcentaje de otros residuos",
  side = 1,
  line = 8,
  cex = 1
)

5.4 Histograma porcentual general (hi)

par(mar = c(14,4,4,2))
## 5.4 Histograma porcentual general

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

axis(
  1,
  at = bp,
  labels = TDF_COP_10$Intervalo,
  las = 2,
  cex.axis = 0.75
)

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

grid()
mtext(
  "Porcentaje de otros residuos",
  side = 1,
  line = 8,
  cex = 1
)

5.5 Polígono de frecuencias (hi)

# =========================
# POLÍGONO DE FRECUENCIAS
# PORCENTUAL
# =========================
par(mar = c(14,4,4,2))
bp <- barplot(
  TDF_COP_10$hi,
  space = 0,
  names.arg = FALSE,
  xaxt = "n",
  yaxt = "n",
  main = "Gráfica N°5: Polígono porcentual del porcentaje de otros
  residuos en el estudio de la calidad de agua en Europa (1991-2017)",
  xlab = "",
  ylab = "Porcentaje (%)",
  col = "lightgreen",
  border = "black",
  ylim = c(0, max(TDF_COP_10$hi) * 1.15),
  cex.main = 0.9
)

# Eje X
axis(
  1,
  at = bp,
  labels = TDF_COP_10$Intervalo,
  las = 2,
  cex.axis = 0.75
)
# Eje Y
axis(
  2,
  at = pretty(c(0, max(TDF_COP_10$hi))),
  las = 1
)

# Polígono porcentual
lines(
  bp,
  TDF_COP_10$hi,
  type = "b",
  pch = 16,
  lwd = 2,
  col = "blue"
)

grid()
mtext(
  "Porcentaje de otros residuos",
  side = 1,
  line = 8,
  cex = 1
)

5.6 Diagrama de caja

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

boxplot(
  COP,
  horizontal = TRUE,
  col = "lightskyblue",
  border = "steelblue4",
  main = "Gráfica N°6: Diagrama de caja del porcentaje de otros residuos en el estudio de la calidad de agua en Europa (1991-2017)",
  xlab = "Porcentaje de otros residuos"
)

grid()

5.7 Ojiva ascendente y descendente

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

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

x_pos <- 1:nrow(TDF_COP_10)

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

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

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

mtext(
  "Porcentaje de otros residuos",
  side = 1,
  line = 8,
  cex = 1
)

axis(
  2,
  at = pretty(c(0, n)),
  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(11,4,4,2))

x_pos <- 1:nrow(TDF_COP_10)

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

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

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

mtext(
  "Porcentaje de otros residuos",
  side = 1,
  line = 8,
  cex = 1
)

axis(
  2,
  at = seq(0,100,20),
  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(COP), 2)

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

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

moda <- paste0(
  "[",
  TDF_COP_10$Li[indice_moda],
  " ; ",
  TDF_COP_10$Ls[indice_moda],
  "]"

)
atipicos <- boxplot.stats(COP)$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(COP), 2),
  " ; ",
  round(max(COP), 2),
  "]"
)

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

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

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

6.3 Asimetría y curtosis

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

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

6.4 Tabla de indicadores

tabla_indicadores <- data.frame(

  Variable = "Porcentaje de otros residuos",

  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 otros residuos 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 otros residuos 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 otros residuos	[0 ; 44.05]	23.52	26	[22.02 ; 26.43]	42.92	6.55	27.85	-0.48	1.27	[0 ; 44.05] (660 valores)
Autor: Grupo 3

7. Conclusión

La variable porcentaje de otros residuos fluctúa entre 0.00 % y 44.05 %, con una media de 23.52 % y una mediana de 26 %, lo que evidencia una variabilidad moderada. Asimismo, la ligera asimetría negativa y los 660 valores atípicos indican la presencia de cuerpos hídricos con concentraciones inusuales de otros residuos, lo que puede resultar perjudicial para la calidad del agua en Europa.