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
datos <- read.csv(
"waterPollution.csv",
sep = ",",
stringsAsFactors = FALSE
)
COP <- na.omit(datos$composition_other_percent)
#=========================
# 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
)
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 | |||||||
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()
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.
#========================================
# 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
#========================================
# 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
)
# 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
# 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
¿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 %
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
)
¿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
#========================================
# 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 |
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.