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 de la variable

CRP <- na.omit(datos$composition_rubber_leather_percent)

3. Construcción de la distribución de frecuencias

3.1 Tamaño de muestra

n <- length(CRP)

n

## [1] 19893

3.2 Rango

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

R <- maximo - minimo

R

## [1] 6

3.3 Regla de Sturges

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

k

## [1] 15

3.4 Amplitud

A <- R / k

A

## [1] 0.4

3.5 Construcción de intervalos

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 <- paste0(
  "[",
  Li,
  " - ",
  Ls,
  ")"
)

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

3.6 Tabla de frecuencias

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

# =========================
# 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 = "-"
)

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",
    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"
  )

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

# ==========================================
# 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$MC,
  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 = "Marcas de clase",
  ylab = "Cantidad",
  ylim = c(0, max(TDF_Graf$ni) * 1.10),
  las = 1
)

5.2 Histograma general

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

barplot(
  height = TDF_Graf$ni,
  names.arg = TDF_Graf$MC,
  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 = "Marcas de clase",
  ylab = "Cantidad",
  ylim = c(0, 20000),
  las = 1
)

5.3 Histograma porcentual

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

barplot(
  height = TDF_Graf$hi,
  names.arg = TDF_Graf$MC,
  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 = "Marcas de clase",
  ylab = "Porcentaje (%)",
  ylim = c(0, max(TDF_Graf$hi) * 1.10),
  las = 1
)

5.4 Histograma porcentual general

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

barplot(
  height = TDF_Graf$hi,
  names.arg = TDF_Graf$MC,
  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 = "Marcas de clase",
  ylab = "Porcentaje (%)",
  ylim = c(0, 100),
  las = 1
)

5.5 Polígono porcentual

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

bp <- barplot(
  height = TDF_Graf$hi,
  names.arg = TDF_Graf$MC,
  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 = "Marcas de clase",
  ylab = "Porcentaje (%)",
  ylim = c(0, max(TDF_Graf$hi) * 1.10),
  las = 1
)

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 de frecuencias

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

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)))

# ==========================================
# OJIVA
# ==========================================

plot(
  TDF_Graf$Ls,
  TDF_Graf$Ni_asc,
  type = "b",
  pch = 19,
  lwd = 2,
  col = "blue",
  xlab = "Límite superior del intervalo",
  ylab = "Frecuencia acumulada",
  main = "Gráfica N°8: Ojiva de frecuencias del porcentaje de caucho y cuero
en el estudio de la calidad de agua en Europa (1991-2017)"
)

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

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

grid()

#Nota: La ojiva se construyó excluyendo el intervalo [0.0 – 0.4), debido a que concentra la mayor parte de las observaciones (94.58 %). En consecuencia, la frecuencia acumulada final corresponde a las 1 079 observaciones restantes consideradas para el análisis gráfico. Esta modificación se realizó únicamente para facilitar la interpretación de la distribución y no altera los resultados estadísticos ni las conclusiones del estudio.

5.9 Ojiva porcentual

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

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

# Nuevo tamaño muestral para las gráficas
n_graf <- sum(TDF_Graf$ni)

# Recalcular frecuencias relativas (%)
TDF_Graf$hi <- round((TDF_Graf$ni / n_graf) * 100, 2)

# Recalcular porcentajes acumulados
TDF_Graf$Hi_asc <- round(cumsum(TDF_Graf$hi), 2)
TDF_Graf$Hi_desc <- round(rev(cumsum(rev(TDF_Graf$hi))), 2)

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

plot(
  TDF_Graf$Ls,
  TDF_Graf$Hi_asc,
  type = "b",
  pch = 19,
  lwd = 2,
  col = "darkgreen",
  ylim = c(0, 100),
  xlab = "Límite superior del intervalo",
  ylab = "Porcentaje acumulado (%)",
  main = "Gráfica N°9: Ojiva porcentual del porcentaje de caucho y cuero
en el estudio de la calidad de agua en Europa (1991-2017)"
)

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

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

grid()

6. Indicadores estadísticos

library(e1071)
library(gt)

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

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

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

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

# Varianza
Varianza <- round(var(CRP), 2)

# Desviación estándar
DesvEst <- round(sd(CRP), 2)

# Coeficiente de variación
CV <- round((DesvEst / Media) * 100, 2)

# Asimetría
As <- round(
  e1071::skewness(CRP),
  2
)

# Curtosis
K <- round(
  e1071::kurtosis(CRP, type = 2),
  2
)

# Valores atípicos
Q1 <- quantile(CRP, 0.25)

Q3 <- quantile(CRP, 0.75)

RIC <- Q3 - Q1

LimInf <- Q1 - 1.5 * RIC

LimSup <- Q3 + 1.5 * RIC

Atipicos <- sum(
  CRP < LimInf |
  CRP > LimSup
)

#=========================================
# TABLA DE INDICADORES
#=========================================

Indicadores <- data.frame(

  Variable = "Porcentaje de caucho y cuero",

  Rango = sprintf(
"[%.2f - %.2f]",
min(CRP),
max(CRP)
),

  Media = Media,

  Mediana = Mediana,

  Moda = Moda,

  Varianza = Varianza,

  DesvEst = DesvEst,

  CV = CV,

  As = As,

  K = K,

  Atipicos = 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",

    Media = "Media",

    Mediana = "Mediana",

    Moda = "Moda",

    Varianza = "Varianza",

    DesvEst = "Desv.\nEst.",

    CV = "CV\n(%)",

    As = "As",

    K = "K",

    Atipicos = "Valores\nAtí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 caucho y cuero en el estudio de la calidad del agua en Europa (1991-2017)
Porcentaje de caucho y cuero	[0.00 - 6.00]	0.16	0	[0 - 0.4)	0.54	0.73	456.25	4.72	21.28	1079
Autor: Grupo 3

7. Conclusión

#El porcentaje de caucho y cuero varía entre 0.00 y 6.00 %, con una media de 0.16 % y una mediana de 0 %, lo que refleja una marcada concentración de datos en valores bajos. El CV de 456.25 % indica una distribución altamente heterogénea, mientras que la asimetría positiva (As = 4.72) y la curtosis (K = 21.28) evidencian una distribución fuertemente sesgada hacia la derecha. Finalmente, se identificaron 1 079 valores atípicos.

Porcentaje de caucho y cuero

Universidad Central del Ecuador

06/05/2026

0. Carga de librerías

1. Leer datos

2. Extracción de la variable

3. Construcción de la distribución de frecuencias

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 Tabla de frecuencias

4. Tablas de distribución 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.9 Ojiva porcentual

6. Indicadores estadísticos

7. Conclusión