#craga de librerias
library(kableExtra)
library(knitr)
library(magrittr)
library(dplyr)
##
## Attaching package: 'dplyr'
## The following object is masked from 'package:kableExtra':
##
## group_rows
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
#carga de datos
getwd()
## [1] "/cloud/project"
setwd("/cloud/project")
datos<- read.csv("china_water_pollution_data.csv",header = TRUE, sep = ",",
dec = ".")
#extraccion variable cuantitativa continua
Nitrógeno_Total <- datos$Total_Nitrogen_mg_L
# Eliminar NA y valores negativos si los hubiera
Nitrógeno_Total<- na.omit(Nitrógeno_Total)
Nitrógeno_Total_mayores_cero <- subset(Nitrógeno_Total, Nitrógeno_Total > 0)
# Crear objeto boxplot
bp <- boxplot(Nitrógeno_Total_mayores_cero, horizontal = TRUE,
main = "Gráfica Nº 1: Diagrama de caja del Nitrógeno Total
en las porciones de agua de China en el año 2023",
xlab = "Nitrógeno Total")
# Obtener los outliers identificados por el boxplot
outliers <- bp$out
# Separar valores atípicos
Nitrógeno_Total_outliers <- Nitrógeno_Total_mayores_cero[Nitrógeno_Total_mayores_cero %in% outliers]
# Separar valores comunes
Nitrógeno_Total_comunes <- Nitrógeno_Total_mayores_cero[!Nitrógeno_Total_mayores_cero %in% outliers]
bpcomunes <- boxplot(Nitrógeno_Total_comunes, horizontal = TRUE,
main = "Gráfica Nº 2: Diagrama de caja de valores comunes de
Nitrógeno Total
en las porciones de agua de China en el año 2023 ",
xlab = "Nitrógeno Total")
outliers <- bpcomunes$out
Nitrógeno_Total_comunes_outliers <- Nitrógeno_Total_comunes[Nitrógeno_Total_comunes %in% outliers]
Nitrógeno_Total_comunes_comunes <- Nitrógeno_Total_comunes[!Nitrógeno_Total_comunes %in% outliers]
boxplot(Nitrógeno_Total_comunes_comunes, horizontal = TRUE,
main = "Gráfica Nº 3: Diagrama de caja de valores comunes de Nitrógeno Total
en las porciones de agua de China en el año 2023",
xlab = "Nitrógeno Total")
length(Nitrógeno_Total_comunes_comunes)
## [1] 2983
max <- max(Nitrógeno_Total_comunes_comunes)
min <- min(Nitrógeno_Total_comunes_comunes)
R <- max - min
k <- floor(1 + 3.3 * log10(length(Nitrógeno_Total_comunes_comunes))) # Regla de Sturges
A <- R / k
breaks_Nitrógeno_Total <- seq(max, min, length.out = 13)
liminf <- seq(from = min(Nitrógeno_Total_comunes_comunes), by = A, length.out = k)
limsup <- liminf + A
MC <- (liminf + limsup) / 2
ni <- sapply(1:length(liminf), function(i) sum(Nitrógeno_Total_comunes_comunes >= liminf[i] & Nitrógeno_Total_comunes_comunes < limsup[i]))
ni[length(liminf)] <- sum(Nitrógeno_Total_comunes_comunes >= liminf[length(liminf)] & Nitrógeno_Total_comunes_comunes <= limsup[length(liminf)])
sum(ni)
## [1] 2983
hi <- (ni / sum(ni)) * 100
sum(hi)
## [1] 100
Niasc <- cumsum(ni)
Hiasc <- cumsum(hi)
Nides <- rev(cumsum(rev(ni)))
Hides <- rev(cumsum(rev(hi)))
TDF_Nitrógeno_Total <- data.frame(round(liminf, 2), round(limsup, 2), round(MC, 2), round(ni, 2),
round(hi, 2), round(Niasc, 2), round(Nides, 2), round(Hiasc, 2), round(Hides, 2))
colnames(TDF_Nitrógeno_Total) <- c("Liminf", "Limsup", "MC", "ni", "hi(%)",
"Ni asc", "Ni desc", "Hi asc(%)", "Hi desc(%)")
totales <- c(liminf = "TOTAL", limsup = "-", MC = "-", ni = sum(ni), hi = sum(hi),
Ni_asc = "-", Ni_des = "-", Hi_asc = "-", Hi_des = "-")
TDF_Nitrógeno_Total <- rbind(TDF_Nitrógeno_Total, totales)
TDF_Nitrógeno_Total
## Liminf Limsup MC ni hi(%) Ni asc Ni desc Hi asc(%) Hi desc(%)
## 1 1.67 1.89 1.78 22 0.74 22 2983 0.74 100
## 2 1.89 2.11 2 71 2.38 93 2961 3.12 99.26
## 3 2.11 2.34 2.23 157 5.26 250 2890 8.38 96.88
## 4 2.34 2.56 2.45 289 9.69 539 2733 18.07 91.62
## 5 2.56 2.78 2.67 449 15.05 988 2444 33.12 81.93
## 6 2.78 3 2.89 500 16.76 1488 1995 49.88 66.88
## 7 3 3.23 3.12 487 16.33 1975 1495 66.21 50.12
## 8 3.23 3.45 3.34 453 15.19 2428 1008 81.39 33.79
## 9 3.45 3.67 3.56 298 9.99 2726 555 91.38 18.61
## 10 3.67 3.9 3.78 143 4.79 2869 257 96.18 8.62
## 11 3.9 4.12 4.01 80 2.68 2949 114 98.86 3.82
## 12 4.12 4.34 4.23 34 1.14 2983 34 100 1.14
## 13 TOTAL - - 2983 100 - - - -
# Histograma
Hist_Nitrógeno <- hist(
Nitrógeno_Total_comunes_comunes,
main = "Gráfica Nº 4: Histograma de Nitrógeno Total en las porciones de agua
de China en 2023",
xlab = "Nitrógeno Total (mg/L)",
ylab = "Cantidad",
col = "gray"
)
# Limites reales del histograma
limites <- Hist_Nitrógeno$breaks
# Crear límites inferiores y superiores
liminf <- limites[-length(limites)] # todos menos el último
limsup <- limites[-1] # todos menos el primero
# Puntos medios
MC <- Hist_Nitrógeno$mids
# Frecuencias
ni <- Hist_Nitrógeno$counts
# Frecuencias relativas
hi <- (ni / sum(ni)) * 100
# Acumuladas
Niasc <- cumsum(ni)
Hiasc <- cumsum(hi)
Nides <- rev(cumsum(rev(ni)))
Hides <- rev(cumsum(rev(hi)))
# Data frame final
TDF_hist_Nitrógeno_Total <- data.frame(
liminf = round(liminf, 2),
limsup = round(limsup, 2),
MC = round(MC, 2),
ni = ni,
hi = round(hi, 2),
Niasc = Niasc,
Nides = Nides,
Hiasc = round(Hiasc, 2),
Hides = round(Hides, 2)
)
# Agregar fila TOTAL
totales <- c(
liminf = "TOTAL", limsup = "-", MC = "-",
ni = sum(ni), hi = sum(hi),
Niasc = "-", Nides = "-", Hiasc = "-", Hides = "-"
)
TDF_hist_Nitrógeno_Total <- rbind(TDF_hist_Nitrógeno_Total, totales)
TDF_hist_Nitrógeno_Total
## liminf limsup MC ni hi Niasc Nides Hiasc Hides
## 1 1.6 1.8 1.7 11 0.37 11 2983 0.37 100
## 2 1.8 2 1.9 40 1.34 51 2972 1.71 99.63
## 3 2 2.2 2.1 101 3.39 152 2932 5.1 98.29
## 4 2.2 2.4 2.3 173 5.8 325 2831 10.9 94.9
## 5 2.4 2.6 2.5 306 10.26 631 2658 21.15 89.1
## 6 2.6 2.8 2.7 402 13.48 1033 2352 34.63 78.85
## 7 2.8 3 2.9 455 15.25 1488 1950 49.88 65.37
## 8 3 3.2 3.1 453 15.19 1941 1495 65.07 50.12
## 9 3.2 3.4 3.3 417 13.98 2358 1042 79.05 34.93
## 10 3.4 3.6 3.5 280 9.39 2638 625 88.43 20.95
## 11 3.6 3.8 3.7 188 6.3 2826 345 94.74 11.57
## 12 3.8 4 3.9 86 2.88 2912 157 97.62 5.26
## 13 4 4.2 4.1 53 1.78 2965 71 99.4 2.38
## 14 4.2 4.4 4.3 18 0.6 2983 18 100 0.6
## 15 TOTAL - - 2983 100 - - - -
#### Histograma con la regla de Sturges ####
hist(Nitrógeno_Total_comunes_comunes, breaks = breaks_Nitrógeno_Total,
main = "Gráfica Nº 5: Histograma de Nitrógeno Total en las porciones
de agua de China en 2023 ",
col = "blue",
xlab = "Nitrógeno Total (mg/L)",
ylab = "Cantidad")
#### Diagramas de caja y histogramas generales y locales ####
boxplot(Nitrógeno_Total_comunes_comunes, horizontal = TRUE,
main = "Gráfica Nº 6: Diagrama de caja de Nitrógeno Total en las porciones
de agua de China en 2023",
xlab = "Nitrógeno Total (mg/L)")
hist(Nitrógeno_Total_comunes_comunes,
main = "Gráfica Nº 7: Histograma de Nitrógeno Total en las porciones
de agua de China en 2023 ",
col = "skyblue",
xlab = "Nitrógeno Total (mg/L)",
ylab = "Cantidad")
hist(Nitrógeno_Total_comunes_comunes,
main = "Gráfica Nº 8: Histograma de Nitrógeno Total en las porciones
de agua de China en 2023 ",
col = "blue",
xlab = "Nitrógeno Total (mg/L)",
ylab = "Cantidad",
ylim = c(0, 3505))
# Excluir la última fila (TOTAL)
MC_sin_total <- TDF_hist_Nitrógeno_Total$MC[1:(nrow(TDF_hist_Nitrógeno_Total) - 1)]
hi_sin_total <- hi[1:length(hi)] # hi ya no necesita la fila TOTAL
barplot(hi_sin_total,
space = 0,
col = "green",
main = "Gráfica Nº 9: Histograma de Nitrógeno Total en las porciones
de agua de China en 2023 ",
ylab = "Porcentaje (%)",
xlab = "Nitrógeno Total (mg/L)",
names.arg = MC_sin_total)
# Eliminar la última fila (TOTAL)
MC_sin_total <- TDF_hist_Nitrógeno_Total$MC[1:(nrow(TDF_hist_Nitrógeno_Total)-1)]
hi_sin_total <- hi # hi ya solo tiene las clases reales del histograma
barplot(hi_sin_total,
space = 0,
col = "blue",
main = "Gráfica Nº 10: Histograma de Nitrógeno Total en las porciones
de agua de China en 2023",
ylab = "Porcentaje (%)",
xlab = "Nitrógeno Total (mg/L)",
names.arg = MC_sin_total,
ylim = c(0, 100))
#### Ojivas acumuladas ####
plot(MC, Nides,
main = "Gráfica Nº 11: Ojiva acumulada absoluta (Ni asc y Ni desc)
de Nitrógeno Total en las porciones
de agua de China en 2023",
xlab = "Nitrógeno Total (mg/L)",
ylab = "Cantidad",
col = "orange",
type = "o",
lwd = 3,
pch = 16)
lines(MC, Niasc, col = "green", type = "o", pch = 16, lwd = 3)
plot(MC, Hides,
main = "Gráfica Nº 12: Ojiva acumulada relativa (Hi asc y Hi desc)
de Nitrógeno Total en las porciones
de agua de China en 2023 ",
xlab = "Nitrógeno Total (mg/L)",
ylab = "Porcentaje (%)",
col = "orange",
type = "o",
lwd = 3,
pch = 16)
lines(MC, Hiasc, col = "green", type = "o", pch = 16, lwd = 3)
### Indicadores estadísticos ###
library(e1071)
# Tendencia central
x <- mean(Nitrógeno_Total_comunes_comunes)
Me <- median(Nitrógeno_Total_comunes_comunes)
# Dispersión
varianza <- var(Nitrógeno_Total_comunes_comunes)
sd <- sd(Nitrógeno_Total_comunes_comunes)
CV <- (sd / x) * 100
# Forma
As <- skewness(Nitrógeno_Total_comunes_comunes)
K <- kurtosis(Nitrógeno_Total_comunes_comunes)
tabla_indicadores <- data.frame(
"Variable" = "Nitrógeno Total",
"Rango" = "[0.0001 ; 2.42]",
"X" = round(x, 3),
"Me" = round(Me, 3),
"Mo" = "[0.0 ; 0.2]",
"Sd" = round(sd, 4),
"Cv" = round(CV, 1),
"As" = round(As, 3),
"K" = round(K, 3),
"Valores Atípicos" = "[1.6 ; 2.42]"
)
library(knitr)
kable(tabla_indicadores, align = 'c',
caption = "Conclusiones de la variable Nitrógeno Total")
Conclusiones de la variable Nitrógeno Total
| Nitrógeno Total |
[0.0001 ; 2.42] |
3.008 |
3.01 |
[0.0 ; 0.2] |
0.4865 |
16.2 |
0.049 |
-0.301 |
[1.6 ; 2.42] |