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. LECTURA DE LOS DATOS

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

2. SELECCIÓN DE LA VARIABLE ALEATORIA

COP <- na.omit(datos$composition_other_percent)

3. TABLA DE DISTRIBUCIÓN DE FRECUENCIAS

#=========================
# TAMAÑO DE MUESTRA
#=========================

n <- length(COP)

#=========================
# VALOR MÍNIMO Y MÁXIMO
#=========================

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

#=========================
# RANGO
#=========================

R <- maximo - minimo

#=========================
# TABLA SIMPLIFICADA
#=========================

k <- 10

A <- R / k

Li <- seq(minimo, maximo - A, by = A)

Ls <- c(
  seq(minimo + A, maximo - A, by = A),
  maximo
)

Li <- round(Li, 2)
Ls <- round(Ls, 2)

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

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

  }

}

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)

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

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

TDF_COP <- data.frame(

Intervalo,

MC,

ni,

hi,

Ni_asc,

Ni_desc,

Hi_asc,

Hi_desc

)

Totales <- data.frame(

Intervalo="TOTAL",

MC="-",

ni=sum(ni),

hi=100,

Ni_asc="-",

Ni_desc="-",

Hi_asc="-",

Hi_desc="-"

)

TDF_COP_total <- rbind(
TDF_COP,
Totales
)

Tabla N°1

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(

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)
Intervalo MC ni hi (%) Ni ↑ Ni ↓ Hi ↑ (%) Hi ↓ (%)
[0 - 4.4) 2.2 171 0.86 171 19893 0.86 100.01
[4.4 - 8.81) 6.61 0 0.00 171 19722 0.86 99.15
[8.81 - 13.21) 11.01 600 3.02 771 19722 3.88 99.15
[13.21 - 17.62) 15.42 3850 19.35 4621 19122 23.23 96.13
[17.62 - 22.02) 19.82 961 4.83 5582 15272 28.06 76.78
[22.02 - 26.43) 24.23 9787 49.20 15369 14311 77.26 71.95
[26.43 - 30.83) 28.63 4030 20.26 19399 4524 97.52 22.75
[30.83 - 35.24) 33.03 5 0.03 19404 494 97.55 2.49
[35.24 - 39.64) 37.44 0 0.00 19404 489 97.55 2.46
[39.64 - 44.05] 41.84 489 2.46 19893 489 100.01 2.46
TOTAL - 19893 100.00 - - - -
Autor: Grupo 3

4.- GRAFICA DE DISTRIBUCION DE FRECUENCIA

bp <- barplot(

  TDF_COP$hi,

  space = 0,

  names.arg = FALSE,

  xaxt = "n",

  yaxt = "n",

  main = "Gráfica N°1: Distribución del porcentaje de otros residuos\nen el estudio de la calidad de agua en Europa (1991-2017)",

  xlab = "Porcentaje de otros residuos",

  ylab = "Porcentaje (%)",

  col = "darkseagreen3",

  border = "black",

  ylim = c(0,55),

  cex.main = 0.85

)

# Etiquetas del eje X

Etiquetas <- paste0(

  "[",

  round(Li,2),

  " - ",

  round(Ls,2),

  ")"

)

Etiquetas[length(Etiquetas)] <- paste0(

  "[",

  round(Li[length(Li)],2),

  " - ",

  round(Ls[length(Ls)],2),

  "]"

)

axis(

  1,

  at = bp,

  labels = Etiquetas,

  las = 2,

  cex.axis = 0.75

)

axis(

  2,

  at = seq(0,50,10),

  las = 1

)

grid()

5. CONJETURA

Al observar la distribución de frecuencias, se aprecia que los intervalos comprendidos entre 8.81 % y 22.02 % presentan un comportamiento similar al de una campana. Por ello, se plantea la conjetura de que el porcentaje de otros residuos puede aproximarse mediante una distribución Normal.

6. PARÁMETROS

#========================================
# SELECCIÓN DEL INTERVALO
#========================================

COP1 <- COP[
  COP >= 8.81 &
  COP < 22.02
]

#========================================
# PARÁMETROS DEL MODELO NORMAL
#========================================

# Media
mu <- mean(COP1)
mu
## [1] 14.65213
# Desviación estándar
sigma <- sd(COP1)
sigma
## [1] 1.773809

7. SOBREPOSICIÓN DE LA REALIDAD CON EL MODELO NORMAL

#========================================
# CORTES DE LOS TRES INTERVALOS
#========================================

cortes_limpios <- c(
  8.81,
  13.21,
  17.62,
  22.02
)

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

hist(
  COP1,
  breaks = cortes_limpios,
  freq = FALSE,
  main = "Gráfica N°2: Comparación de la realidad con el modelo Normal\npara el porcentaje de otros residuos en el estudio de la calidad de agua en Europa (1991-2017)",
  xlab = "Porcentaje de otros residuos",
  ylab = "Densidad de probabilidad",
  col = "gray80",
  border = "black",
  ylim = c(0,0.25),
  xaxt = "n"
)

# Eje X

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

#========================================
# CURVA NORMAL
#========================================

x <- seq(
  8.81,
  22.02,
  by = 0.01
)

lines(
  x,
  dnorm(x, mu, sigma),
  col = "steelblue",
  lwd = 3
)

8. TEST DE BONDAD

8.1 Test de Pearson

# Frecuencia observada

Fo <- as.numeric(
  table(
    cut(
      COP1,
      breaks = cortes_limpios,
      include.lowest = TRUE
    )
  )
)

Fo
## [1]  600 3850  961
# Tamaño de muestra

n <- length(COP1)

# Probabilidades esperadas

p <- diff(
  pnorm(
    cortes_limpios,
    mean = mu,
    sd = sigma
  )
)

# Frecuencia esperada

Fe <- p * n

Fe
## [1] 1123.3835 4029.8246  255.0268
# Coeficiente de Pearson

Correlacion <- cor(Fo, Fe) * 100

Correlacion
## [1] 94.83113

8.2 Test de Chi-cuadrado

# Frecuencias en fracción

Fo_fraccion <- Fo / n
Fo_fraccion
## [1] 0.1108852 0.7115136 0.1776012
Fe_fraccion <- p
Fe_fraccion
## [1] 0.20761107 0.74474674 0.04713118
# Chi-cuadrado

x2 <- sum(
  (Fo_fraccion - Fe_fraccion)^2 /
  Fe_fraccion
)

x2
## [1] 0.4077187
# Número de clases

k <- length(Fo)

# Grados de libertad

grados_libertad <- k - 1

grados_libertad
## [1] 2
# Chi crítico

umbral_aceptacion <- qchisq(
  0.95,
  df = grados_libertad
)

umbral_aceptacion
## [1] 5.991465
# Comparación

x2 < umbral_aceptacion
## [1] TRUE

9.- CALCULO DE PROBABILIDADES

9.1 Probabilidad

¿Cuál es la probabilidad de que el porcentaje de otros residuos se encuentre entre 13.21 % y 17.62 %, de acuerdo con el modelo Normal ajustado?

# Límites

a <- 13.21
b <- 17.62

# Probabilidad

Probabilidad <- pnorm(b, mu, sigma) -
                pnorm(a, mu, sigma)

cat(
  "Probabilidad:",
  round(Probabilidad*100,2),
  "%"
)
## Probabilidad: 74.47 %

Demostración gráfica

x <- seq(
  8.81,
  22.02,
  by = 0.01
)

y <- dnorm(
  x,
  mu,
  sigma
)

plot(
  x,
  y,
  type="l",
  lwd=3,
  col="steelblue",
  main="Gráfica N°3: Probabilidad del modelo Normal",
  xlab="Porcentaje de otros residuos",
  ylab="Densidad"
)

x1 <- seq(
  a,
  b,
  by=0.01
)

y1 <- dnorm(
  x1,
  mu,
  sigma
)

polygon(
  c(a,x1,b),
  c(0,y1,0),
  col="lightblue",
  border="lightblue"
)

lines(
  x,
  y,
  col="steelblue",
  lwd=3
)

9.2 Pregunta de cantidad

¿Cuántas observaciones se espera que presenten un porcentaje de otros residuos entre 13.21 % y 17.62 %, de acuerdo con el modelo Normal ajustado?

Esperadas <- Probabilidad * n

cat(
  "Número esperado de observaciones:",
  round(Esperadas)
)
## Número esperado de observaciones: 4030

10. INTERVALO DE CONFIANZA

#========================================
# PARÁMETROS
#========================================

media <- mean(COP1)

sigma <- sd(COP1)

n <- length(COP1)

#========================================
# ERROR DE ESTIMACIÓN
#========================================

error <- qnorm(0.975) * (sigma / sqrt(n))

#========================================
# LÍMITES DEL INTERVALO
#========================================

limite_inferior <- round(media - error, 2)

limite_superior <- round(media + error, 2)

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

tabla_intervalo <- data.frame(

  Intervalo = paste0(
    "P [",
    limite_inferior,
    " < µ < ",
    limite_superior,
    "] = 95%"
  )

)

tabla_intervalo %>%

  gt() %>%

  tab_header(

    title = md("**Tabla N°2**"),

    subtitle = md("**Intervalo de confianza del porcentaje de otros residuos en el estudio de la calidad del 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",

    table.border.top.style = "solid",

    table.border.bottom.style = "solid",

    column_labels.border.top.color = "black",

    column_labels.border.bottom.color = "black",

    column_labels.border.bottom.width = px(2),

    row.striping.include_table_body = TRUE,

    heading.border.bottom.color = "black",

    heading.border.bottom.width = px(2),

    table_body.hlines.color = "gray",

    table_body.border.bottom.color = "black"

  )
Tabla N°2
Intervalo de confianza del porcentaje de otros residuos en el estudio de la calidad del agua en Europa (1991-2017)
Intervalo
P [14.6 < µ < 14.7] = 95%
Autor: Grupo 3

11. CONCLUSIÓN

El modelo Normal resultó adecuado para representar el comportamiento del porcentaje de otros residuos en el intervalo analizado. Los resultados del coeficiente de Pearson y del test de Chi-cuadrado respaldaron el ajuste del modelo. Asimismo, fue posible estimar probabilidades e intervalos de confianza para la variable estudiada.