Composición Porcentual de Plásticos

0. Librerías

# -------------------------
# Cargar 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

# -------------------------
# Cargar datos
# -------------------------

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

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

# ================================
# VARIABLE CUANTITATIVA CONTINUA
# ================================

CPP <- na.omit(datos$composition_plastic_percent)

# Datos para gráficos

CPP_graf <- CPP[CPP >= 0.01]

3. Frecuencia

3.1 Rango

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

3.2 Uso de la Regla de Sturges

# Regla de Sturges
k <- 1 + (3.3 * log10(length(CPP)))
k <- floor(k)

# Rango y amplitud
R <- maximo - minimo
A <- R / k

3.3 Límites de clase

# Límites de clase
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

## 3.4 Creación de columnas   
ni <- numeric(length(Li))

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

ni[length(Li)] <- sum(CPP >= Li[length(Li)] & CPP <= maximo)

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

# Crear tabla con nombre corregido (TDF_CPP)
TDF_CPP <- data.frame(
  Li, Ls, MC, ni, hi
)

# ================================
# ELIMINAR INTERVALOS CON ni = 0
# ================================
TDF_CPP <- TDF_CPP[TDF_CPP$ni > 0, ]

# Recalcular acumuladas
TDF_CPP$Niasc <- cumsum(TDF_CPP$ni)
TDF_CPP$Nidsc <- rev(cumsum(rev(TDF_CPP$ni)))
TDF_CPP$Hiasc <- round(cumsum(TDF_CPP$hi))
TDF_CPP$Hidsc <- round(rev(cumsum(rev(TDF_CPP$hi))))

4. Tabla de distribución de frecuencia

4.1 Tabla general con Sturges

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

tabla_CPP <- TDF_CPP_Completo %>%
  gt() %>%
  tab_header(
    title = md("*Tabla Nº1*"),
    subtitle = md("**Distribución de frecuencias de la composición porcentual de plásticos en el estudio de la calidad de agua en Europa (1991-2017)**")
  ) %>%
  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_CPP

Tabla Nº1
Distribución de frecuencias de la composición porcentual de plásticos en el estudio de la calidad de agua en Europa (1991-2017)
Li	Ls	MC	ni	hi	Niasc	Nidsc	Hiasc	Hidsc
1.45	2.88	2.16	943	4.74	943	19893	5	100
5.74	7.17	6.46	174	0.87	1117	18950	6	95
7.17	8.6	7.88	82	0.41	1199	18776	6	94
8.6	10.03	9.31	12802	64.35	14001	18694	70	94
10.03	11.46	10.75	354	1.78	14355	5892	72	30
11.46	12.89	12.18	719	3.61	15074	5538	76	28
12.89	14.32	13.61	806	4.05	15880	4819	80	24
14.32	15.75	15.04	22	0.11	15902	4013	80	20
17.18	18.61	17.9	15	0.08	15917	3991	80	20
20.04	21.47	20.75	3957	19.89	19874	3976	100	20
21.47	22.9	22.18	19	0.10	19893	19	100	0
Total			19893	100.00
Autor: Grupo 3

4.2 Tabla Simplificada

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

# 1. Calcular el histograma 
histoP <- hist(
  CPP,
  breaks = 10,
  plot = FALSE 
)

Limites <- histoP$breaks
LimInf <- Limites[1:(length(Limites) - 1)]
LimSup <- Limites[2:length(Limites)]
Mc <- histoP$mids
ni <- histoP$counts
hi <- round((ni / sum(ni)) * 100, 2)

# DataFrame base simplificado corregido (TDF_Histo_CPP)
TDF_Histo_CPP <- data.frame(
  LimInf,
  LimSup,
  Mc,
  ni,
  hi
)

TDF_Histo_CPP <- TDF_Histo_CPP[TDF_Histo_CPP$ni > 0, ]

TDF_Histo_CPP$Ni_asc <- cumsum(TDF_Histo_CPP$ni)
TDF_Histo_CPP$Ni_dsc <- rev(cumsum(rev(TDF_Histo_CPP$ni)))
TDF_Histo_CPP$Hi_asc <- round(cumsum(TDF_Histo_CPP$hi), 2)
TDF_Histo_CPP$Hi_dsc <- round(rev(cumsum(rev(TDF_Histo_CPP$hi))), 2)

TDF_Histo_CPP_Completo <- rbind(
  TDF_Histo_CPP,
  data.frame(
    LimInf = "Total",
    LimSup = " ",
    Mc = " ",
    ni = sum(TDF_Histo_CPP$ni),
    hi = 100,
    Ni_asc = " ",
    Ni_dsc = " ",
    Hi_asc = " ",
    Hi_dsc = " "
  )
)

tabla_Histo_CPP <- TDF_Histo_CPP_Completo %>%
  gt() %>%
  tab_header(
    title = md("*Tabla Nº2*"),
    subtitle = md("**Distribución simplificada de frecuencias de la composición porcentual de plásticos en el estudio de la calidad de agua en Europa (1991-2017)**")
  ) %>%
  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_CPP

Tabla Nº2
Distribución simplificada de frecuencias de la composición porcentual de plásticos en el estudio de la calidad de agua en Europa (1991-2017)
LimInf	LimSup	Mc	ni	hi	Ni_asc	Ni_dsc	Hi_asc	Hi_dsc
0	2	1	437	2.20	437	19893	2.2	100
2	4	3	506	2.54	943	19456	4.74	97.8
6	8	7	256	1.29	1199	18950	6.03	95.26
8	10	9	12802	64.35	14001	18694	70.38	93.97
10	12	11	460	2.31	14461	5892	72.69	29.62
12	14	13	1419	7.13	15880	5432	79.82	27.31
14	16	15	22	0.11	15902	4013	79.93	20.18
16	18	17	15	0.08	15917	3991	80.01	20.07
20	22	21	3957	19.89	19874	3976	99.9	19.99
22	24	23	19	0.10	19893	19	100	0.1
Total			19893	100.00
Autor: Grupo 3

5. Gráficas

5.1 Histograma (ni)

# =========================================
# Histograma generado por RStudio 
# =========================================
hist(
  CPP,
  breaks = histoP$breaks,
  main = "Gráfica Nº1: Distribución de frecuencias de la composición 
  porcentual de plásticos en el estudio de la calidad de 
  agua en Europa (1991-2017)",
  xlab = "Porcentaje de plásticos (%)",
  ylab = "Cantidad",
  col = "forestgreen",
  border = "black",
  xaxt = "n" 
)

axis(
  side = 1,
  at = histoP$breaks,
  labels = round(histoP$breaks, 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_CPP$ni,
  col = "limegreen",
  border = "black",
  main = "Gráfica Nº2: Distribución de frecuencias de la composición 
  porcentual de plásticos en el estudio de la calidad de 
  agua en Europa (1991-2017)",
  xlab = "Porcentaje de plásticos (%)",
  ylab = "Cantidad",
  space = 0,
  xaxt = "n",
  ylim = c(0, 20000)
)

limites_etiquetas_cpp <- c(TDF_Histo_CPP$LimInf, tail(TDF_Histo_CPP$LimSup, 1))

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

grid()

5.3 Histograma Porcentual (hi)

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

limites_etiquetas_cpp <- c(TDF_Histo_CPP$LimInf, tail(TDF_Histo_CPP$LimSup, 1))

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

grid()

5.4 Histograma Porcentual General (hi)

# ===========================================================
# Histograma porcentual con relación a la totalidad 
# ===========================================================
hi_global_cpp <- round((TDF_Histo_CPP$ni / length(CPP)) * 100, 2)

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

limites_etiquetas_cpp <- c(TDF_Histo_CPP$LimInf, tail(TDF_Histo_CPP$LimSup, 1))

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

grid()

5.5 Polígono de frecuencias (hi)

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

limites_etiquetas_cpp <- c(TDF_Histo_CPP$LimInf, tail(TDF_Histo_CPP$LimSup, 1))

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

# 4. Polígono superpuesto
lines(
  bp,
  TDF_Histo_CPP$hi,
  type = "o",
  pch = 16,
  lwd = 2,
  col = "darkred"
)

# 5. Etiquetas de texto
text(
  bp,
  TDF_Histo_CPP$hi,
  labels = round(TDF_Histo_CPP$hi, 2),
  pos = 3,
  cex = 0.8,
  col = "black"
)

grid()

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

5.6 Boxplot

# =============================
# BOXPLOT CON VALORES ATÍPICOS
# =============================
boxplot(
  CPP,
  horizontal = TRUE,
  col = "forestgreen",
  main = "Gráfica Nº6: Diagrama de caja de la composición porcentual de plásticos 
  en el estudio de la calidad de agua en Europa (1991-2017)",
  xlab = "Porcentaje de plásticos (%)"
)

points(
  mean(CPP),
  1,
  pch = 19,
  col = "red"
)

legend(
  "topright",
  legend = "Media",
  pch = 19,
  col = "red"
)

5.7 Ojiva ascendente y descendente (Ni)

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

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

# Ojiva Ascendente
x_asc_cpp <- c(TDF_Histo_CPP$LimInf[1], TDF_Histo_CPP$LimSup)
y_asc_cpp <- c(0, TDF_Histo_CPP$Ni_asc)

# Ojiva Descendente
x_dsc_cpp <- c(TDF_Histo_CPP$LimInf, tail(TDF_Histo_CPP$LimSup, 1))
y_dsc_cpp <- c(TDF_Histo_CPP$Ni_dsc, 0)

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

# 4. Dibujar la ojiva ascendente
lines(
  x_asc_cpp,
  y_asc_cpp,
  col = "forestgreen",
  type = "o",
  lwd = 2
)

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

grid()

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

5.8 Ojiva ascendente y descendente (Hi)

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

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

# Ojiva Ascendente
x_asc_p_cpp <- c(TDF_Histo_CPP$LimInf[1], TDF_Histo_CPP$LimSup)
y_asc_p_cpp <- c(0, TDF_Histo_CPP$Hi_asc)

# Ojiva Descendente
x_dsc_p_cpp <- c(TDF_Histo_CPP$LimInf, tail(TDF_Histo_CPP$LimSup, 1))
y_dsc_p_cpp <- c(TDF_Histo_CPP$Hi_dsc, 0)

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

# 4. Ojiva Descendente
lines(
  x_dsc_p_cpp,
  y_dsc_p_cpp,
  type = "o",
  col = "red",
  pch = 17,
  lwd = 2
)

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

grid()

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

6 Indicadores Estadísticos

6.1 Indicadores de Tendencia Central

# =========================
# INDICADORES ESTADISTICOS
# =========================

CPP <- na.omit(datos$composition_plastic_percent)
CPP <- as.numeric(CPP)

# Obtener valores atípicos según el criterio del boxplot
atipicos_cpp <- boxplot.stats(CPP)$out
n_atipicos_cpp <- length(atipicos_cpp)

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

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

# =========================
# MODA (INTERVALO MODAL)
# =========================
# Moda basada en Intervalo Modal 
fila_modal <- which.max(TDF_Histo_CPP$ni)
moda_intervalar <- paste0(
  "[", round(TDF_Histo_CPP$LimInf[fila_modal], 2),  
  " ; ", round(TDF_Histo_CPP$LimSup[fila_modal], 2), "]"
)

6.2 Dispersión

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

6.3 Asimetría

library(e1071)

asimetria <- skewness(CPP, type = 2)
curtosis <- kurtosis(CPP)

6.4 Tabla de Indicadores

# =========================
# TABLA RESUMEN FINAL
# =========================
tabla_indicadores <- data.frame(
  Variable = "Composición Plástica (%)",
  Rango = paste0("[", round(min(CPP), 2), " ; ", round(max(CPP), 2), "]"),
  X = media,
  Me = mediana,
  Mo = moda_intervalar,
  V = round(varianza, 2),
  Sd = round(desv_est, 2),
  Cv = cv,
  As = round(asimetria, 2),
  K = round(curtosis, 2),
  Valores_Atipicos = rango_atipicos_cpp
)

tabla_indicadores_gt <- tabla_indicadores %>%
  gt() %>%
  tab_header(
    title = md("*Tabla Nº3*"),
    subtitle = md("**Indicadores estadísticos de la variable composición porcentual de plásticos 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")
  ) %>%
  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_indicadores_gt

Tabla Nº3
Indicadores estadísticos de la variable composición porcentual de plásticos 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
Composición Plástica (%)	[1.45 ; 22.9]	11.21	9	[8 ; 10]	24.02	4.9	43.72	0.85	-0.04	[1.45 ; 22.9] (Valores: 4934)
Autor: Grupo 3

7. Conclusión

La variable Composición Plástica (%) fluctúa entre 1.45 y 22.9, y sus valores giran en torno a una mediana de 9, con una desviación estándar de 4.9. Dado que el coeficiente de variación es de 43.72%, se trata de un conjunto de valores heterogéneo. Los datos presentan una asimetría positiva, lo que indica que los valores se acumulan de manera pronunciada en la parte baja de la variable. Con la presencia de valores atípicos en el intervalo de 1.45 a 22.9 (4934 valores), resulta perjudicial para la gestión ambiental, ya que evidencia una contaminación o concentración de plásticos extrema y focalizada en ciertos cuerpos hídricos de Europa.