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

CRP <- na.omit(datos$composition_rubber_leather_percent)

3. Frecuencias

3.1 Rango

n <- length(CRP)

n

## [1] 19893

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

R <- maximo - minimo

R

## [1] 6

3.2 Regla de Sturges

k <- 1 + (3.3 * log10(n))
k <- floor(k)

k

## [1] 15

3.3 Limites de clase

A <- R / k

A

## [1] 0.4

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

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

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

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

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

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

3.4 Creación de columnas

# Frecuencia absoluta

ni <- numeric(length(Li))

for(i in 1:length(Li)){

  ni[i] <- sum(
    CRP >= Li[i] &
    CRP < Ls[i]
  )

}

# Incluir el valor máximo en el último Intervalo

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

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

# Ajuste para que la suma sea exactamente 100
hi[length(hi)] <- round(100 - sum(hi[-length(hi)]), 2)

# Frecuencias acumuladas

Ni_asc <- cumsum(ni)

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

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

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

# Tabla

TDF_CRP <- data.frame(

  Li,
  Ls,
  Intervalo,
  MC,
  ni,
  hi,
  Ni_asc,
  Ni_desc,
  Hi_asc,
  Hi_desc

)

4. Tablas de distribución de frecuencias

4.1 Tabla generada con Sturgues

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

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

# Unir la fila TOTAL a la tabla
TDF_CRP_total <- rbind(
  TDF_CRP,
  Totales
)

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

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

Li	Ls	Intervalo	MC	ni	hi (%)	Ni ↑	Ni ↓	Hi ↑ (%)	Hi ↓ (%)
Tabla N°1
Distribución de frecuencias del porcentaje de caucho y cuero en el estudio de la calidad del agua en Europa (1991-2017)
0	0.4	[0 - 0.4)	0.2	18814	94.58	18814	19893	94.58	100
0.4	0.8	[0.4 - 0.8)	0.6	129	0.65	18943	1079	95.23	5.42
0.8	1.2	[0.8 - 1.2)	1	0	0.00	18943	950	95.23	4.77
1.2	1.6	[1.2 - 1.6)	1.4	0	0.00	18943	950	95.23	4.77
1.6	2	[1.6 - 2)	1.8	322	1.62	19265	950	96.85	4.77
2	2.4	[2 - 2.4)	2.2	0	0.00	19265	628	96.85	3.15
2.4	2.8	[2.4 - 2.8)	2.6	0	0.00	19265	628	96.85	3.15
2.8	3.2	[2.8 - 3.2)	3	0	0.00	19265	628	96.85	3.15
3.2	3.6	[3.2 - 3.6)	3.4	0	0.00	19265	628	96.85	3.15
3.6	4	[3.6 - 4)	3.8	82	0.41	19347	628	97.26	3.15
4	4.4	[4 - 4.4)	4.2	541	2.72	19888	546	99.98	2.74
4.4	4.8	[4.4 - 4.8)	4.6	0	0.00	19888	5	99.98	0.02
4.8	5.2	[4.8 - 5.2)	5	0	0.00	19888	5	99.98	0.02
5.2	5.6	[5.2 - 5.6)	5.4	0	0.00	19888	5	99.98	0.02
5.6	6	[5.6 - 6]	5.8	5	0.02	19893	5	100	0.02
-	-	TOTAL	-	19893	100.00	-	-	-	-
Autor: Grupo 3

4.2 Tabla simplificada

# =========================
# ELIMINAR INTERVALOS VACÍOS
# =========================

TDF_CRP_simple <- subset(
  TDF_CRP,
  ni > 0
)

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

Totales_simple <- data.frame(
  Li = "-",
  Ls = "-",
  Intervalo = "TOTAL",
  MC = "-",
  ni = sum(TDF_CRP_simple$ni),
  hi = round(sum(TDF_CRP_simple$hi), 2),
  Ni_asc = "-",
  Ni_desc = "-",
  Hi_asc = "-",
  Hi_desc = "-"
)

TDF_CRP_simple_total <- rbind(
  TDF_CRP_simple,
  Totales_simple
)

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

TDF_CRP_simple_total %>%
  gt() %>%
  tab_header(
    title = md("**Tabla N°2**"),
    subtitle = md("**Distribución simplificada del porcentaje de caucho y cuero en el estudio de la calidad del 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(
      "**Nota:** Se eliminaron los intervalos con frecuencia absoluta igual a cero para facilitar la interpretación de la distribución. Para la elaboración de las gráficas descriptivas se omitirá el intervalo **0.00–0.4**, debido a que concentra la mayor parte de las observaciones y dificulta la visualización del comportamiento de los demás intervalos. Esta modificación será únicamente gráfica y no altera los indicadores estadísticos ni las conclusiones del análisis.<br>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"
  )

Li	Ls	Intervalo	MC	ni	hi (%)	Ni ↑	Ni ↓	Hi ↑ (%)	Hi ↓ (%)
Tabla N°2
Distribución simplificada del porcentaje de caucho y cuero en el estudio de la calidad del agua en Europa (1991-2017)
0	0.4	[0 - 0.4)	0.2	18814	94.58	18814	19893	94.58	100
0.4	0.8	[0.4 - 0.8)	0.6	129	0.65	18943	1079	95.23	5.42
1.6	2	[1.6 - 2)	1.8	322	1.62	19265	950	96.85	4.77
3.6	4	[3.6 - 4)	3.8	82	0.41	19347	628	97.26	3.15
4	4.4	[4 - 4.4)	4.2	541	2.72	19888	546	99.98	2.74
5.6	6	[5.6 - 6]	5.8	5	0.02	19893	5	100	0.02
-	-	TOTAL	-	19893	100.00	-	-	-	-
Nota: Se eliminaron los intervalos con frecuencia absoluta igual a cero para facilitar la interpretación de la distribución. Para la elaboración de las gráficas descriptivas se omitirá el intervalo 0.00–0.4, debido a que concentra la mayor parte de las observaciones y dificulta la visualización del comportamiento de los demás intervalos. Esta modificación será únicamente gráfica y no altera los indicadores estadísticos ni las conclusiones del análisis. Autor: Grupo 3

5. Gráficas

5.1 Histograma (ni)

# ==========================================
# TABLA PARA LAS GRÁFICAS
# ==========================================

TDF_Graf <- TDF_CRP_simple

# Se elimina el primer Intervalo únicamente
# para facilitar la visualización
TDF_Graf <- TDF_Graf[-1, ]

# ==========================================
# HISTOGRAMA
# ==========================================

barplot(
  height = TDF_Graf$ni,
  names.arg = TDF_Graf$Intervalo,
  space = 0,
  col = "skyblue",
  border = "black",
  main = "Gráfica N°1: Histograma del porcentaje de caucho y cuero
en el estudio de la calidad de agua en Europa (1991-2017)",
  xlab = "Porcentaje de caucho y cuero",
  ylab = "Cantidad",
  ylim = c(0, max(TDF_Graf$ni) * 1.10),
  las = 2,
cex.names = 0.7
)

5.2 Histograma general (ni)

TDF_Graf <- TDF_CRP_simple
TDF_Graf <- TDF_Graf[-1, ]

barplot(
  height = TDF_Graf$ni,
  names.arg = TDF_Graf$Intervalo,
  space = 0,
  col = "red",
  border = "black",
  main = "Gráfica N°2: Histograma general del porcentaje de caucho y cuero
en el estudio de la calidad de agua en Europa (1991-2017)",
  xlab = "Porcentaje de caucho y cuero",
  ylab = "Cantidad",
  ylim = c(0, 20000),
  las = 2,
cex.names = 0.7
)

5.3 Histograma porcentual (hi)

TDF_Graf <- TDF_CRP_simple
TDF_Graf <- TDF_Graf[-1, ]

barplot(
  height = TDF_Graf$hi,
  names.arg = TDF_Graf$Intervalo,
  space = 0,
  col = "lightgreen",
  border = "black",
  main = "Gráfica N°3: Histograma porcentual del porcentaje de caucho y cuero
en el estudio de la calidad de agua en Europa (1991-2017)",
  xlab = "Porcentaje de caucho y cuero",
  ylab = "Porcentaje (%)",
  ylim = c(0, max(TDF_Graf$hi) * 1.10),
  las = 2,
cex.names = 0.7
)

5.4 Histograma porcentual general (hi)

TDF_Graf <- TDF_CRP_simple
TDF_Graf <- TDF_Graf[-1, ]

barplot(
  height = TDF_Graf$hi,
  names.arg = TDF_Graf$Intervalo,
  space = 0,
  col = "forestgreen",
  border = "black",
  main = "Gráfica N°4: Histograma porcentual general del porcentaje de caucho y cuero
en el estudio de la calidad de agua en Europa (1991-2017)",
  xlab = "Porcentaje de caucho y cuero",
  ylab = "Porcentaje (%)",
  ylim = c(0, 100),
  las = 2,
cex.names = 0.7
)

5.5 Polígono de frecuencias (hi)

TDF_Graf <- TDF_CRP_simple
TDF_Graf <- TDF_Graf[-1, ]

bp <- barplot(
  height = TDF_Graf$hi,
  names.arg = TDF_Graf$Intervalo,
  space = 0,
  col = "lightgreen",
  border = "black",
  main = "Gráfica N°6: Polígono porcentual del porcentaje de caucho y cuero
en el estudio de la calidad de agua en Europa (1991-2017)",
  xlab = "Porcentaje de caucho y cuero",
  ylab = "Porcentaje (%)",
  ylim = c(0, max(TDF_Graf$hi) * 1.10),
  las = 2,
cex.names = 0.7
)

lines(
  bp,
  TDF_Graf$hi,
  type = "b",
  pch = 19,
  lwd = 2,
  col = "darkgreen"
)

5.6 Diagrama de caja

boxplot(
  CRP,
  horizontal = TRUE,
  col = "plum",
  border = "purple4",
  main = "Gráfica N°7: Diagrama de caja del porcentaje de caucho y cuero
en el estudio de la calidad de agua en Europa (1991-2017)",
  xlab = "Porcentaje de caucho y cuero"
)

#Nota: La caja aparece comprimida debido a que la mayor parte de las observaciones (94.58 %) se concentra en valores cercanos a cero. En consecuencia, los cuartiles presentan muy poca dispersión y los valores restantes se representan como atípicos.

5.7 Ojiva ascendente y descendente

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

TDF_Graf <- TDF_CRP_simple
TDF_Graf <- TDF_Graf[-1, ]

# Recalcular frecuencias acumuladas
TDF_Graf$Ni_asc <- cumsum(TDF_Graf$ni)
TDF_Graf$Ni_desc <- rev(cumsum(rev(TDF_Graf$ni)))

# Agregar punto inicial
x <- c(TDF_Graf$Li[1], TDF_Graf$Ls)

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

plot(
  x,
  Ni_asc,
  type = "b",
  pch = 19,
  lwd = 2,
  col = "blue",
  ylim = c(0, sum(TDF_Graf$ni)),
  xaxt = "n",
  yaxt = "n",
  xlab = "Límites de clase",
  ylab = "Frecuencia acumulada",
  main = "Gráfica N°8: Ojiva de frecuencias del porcentaje de caucho y cuero\nen el estudio de la calidad de agua en Europa (1991-2017)"
)

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

axis(
  1,
  at = x,
  labels = round(x, 2)
)

axis(
  2,
  at = pretty(c(0, sum(TDF_Graf$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
# =========================

TDF_Graf <- TDF_CRP_simple
TDF_Graf <- TDF_Graf[-1, ]

# Recalcular porcentajes
n_graf <- sum(TDF_Graf$ni)

TDF_Graf$hi <- round((TDF_Graf$ni / n_graf) * 100, 2)

# Ajustar para que termine exactamente en 100
TDF_Graf$hi[length(TDF_Graf$hi)] <-
  100 - sum(TDF_Graf$hi[-length(TDF_Graf$hi)])

TDF_Graf$Hi_asc <- cumsum(TDF_Graf$hi)
TDF_Graf$Hi_desc <- rev(cumsum(rev(TDF_Graf$hi)))

# Agregar punto inicial
x <- c(TDF_Graf$Li[1], TDF_Graf$Ls)

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

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

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

axis(
  1,
  at = x,
  labels = round(x, 2)
)

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

library(e1071)

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

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

# Moda (intervalo modal)

indice_moda <- which.max(TDF_CRP$ni)

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

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

# Varianza

varianza <- round(var(CRP), 2)

# Desviación estándar

desv_est <- round(sd(CRP), 2)

# Coeficiente de variación

cv <- round((desv_est / media) * 100, 2)

6.3 Asimetría y curtosis

# Asimetría

asimetria <- round(
  e1071::skewness(CRP),
  2
)

# Curtosis

curtosis <- round(
  e1071::kurtosis(CRP, type = 2),
  2
)

6.4 Tabla de indicadores

tabla_indicadores <- data.frame(

  Variable = "Porcentaje de caucho y cuero",

  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 caucho y cuero en el estudio de la calidad del 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"
  )

Variable	Rango	X	Me	Mo	V	Sd	Cv (%)	As	K	Rango atípicos
Tabla N°3
Indicadores estadísticos del porcentaje de caucho y cuero en el estudio de la calidad del agua en Europa (1991-2017)
Porcentaje de caucho y cuero	[0 ; 6]	0.16	0	[0 ; 0.4]	0.54	0.73	456.25	4.72	21.28	[0.4 ; 6] (1079 valores)
Autor: Grupo 3

7. Conclusión

La variable porcentaje de caucho y cuero fluctúa entre 0.00 % y 6.00 %, con una media de 0.16 % y una mediana de 0 %, lo que evidencia una alta concentración de observaciones en valores bajos. El coeficiente de variación de 456.25 % indica una distribución extremadamente heterogénea. Asimismo, la asimetría positiva y los 1079 valores atípicos evidencian concentraciones elevadas en algunos cuerpos hídricos, lo que puede resultar perjudicial para la calidad del agua en Europa.

Porcentaje de caucho y cuero

Universidad Central del Ecuador

06/05/2026