# LIBRERÍAS
# -----------------------------
library(knitr)
library(kableExtra)
library(e1071)
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
library(gt)
# -----------------------------
# CARGA DE DATOS
# -----------------------------
datos <- read.csv("china_water_pollution_data.csv",
header = TRUE, sep = ",", dec = ".")
Latitud <- na.omit(datos$Latitude)
# -----------------------------
# TABLA DE FRECUENCIAS (K = 8)
# -----------------------------
K <- 8
Hist_Latitud <- hist(Latitud, breaks = K, plot = FALSE)
Li <- Hist_Latitud$breaks[-length(Hist_Latitud$breaks)]
Ls <- Hist_Latitud$breaks[-1]
ni <- Hist_Latitud$counts
Mc <- Hist_Latitud$mids
n <- sum(ni)
hi <- ni / n
Ni_asc <- cumsum(ni)
Hi_asc <- cumsum(hi)
Ni_desc <- rev(cumsum(rev(ni)))
Hi_desc <- rev(cumsum(rev(hi)))
TDFLatitud <- data.frame(
`Lim inf` = round(Li, 2),
`Lim sup` = round(Ls, 2),
MC = round(Mc, 2),
ni = ni,
`hi (%)` = round(hi * 100, 2),
`Ni asc` = Ni_asc,
`Ni desc` = Ni_desc,
`Hi asc (%)` = round(Hi_asc * 100, 2),
`Hi desc (%)`= round(Hi_desc * 100, 2)
)
totales <- data.frame(
`Lim inf` = "TOTAL",
`Lim sup` = "-",
MC = "-",
ni = sum(ni),
`hi (%)` = 100,
`Ni asc` = "-",
`Ni desc` = "-",
`Hi asc (%)` = "-",
`Hi desc (%)`= "-"
)
TDFLatitud_total <- rbind(TDFLatitud, totales)
# ============================================================
# TABLA N°1
# ============================================================
kable(TDFLatitud_total, align = "c",
caption = "Tabla N°1: Tabla de distribución de frecuencias de la Latitud del agua en el estudio de contaminación del agua en China en el año 2023") %>%
kable_styling(full_width = FALSE, position = "center",
bootstrap_options = c("striped","hover","condensed"))
Tabla N°1: Tabla de distribución de frecuencias de la Latitud del agua
en el estudio de contaminación del agua en China en el año 2023
|
Lim.inf
|
Lim.sup
|
MC
|
ni
|
hi….
|
Ni.asc
|
Ni.desc
|
Hi.asc….
|
Hi.desc….
|
|
20
|
25
|
22.5
|
625
|
20.83
|
625
|
3000
|
20.83
|
100
|
|
25
|
30
|
27.5
|
620
|
20.67
|
1245
|
2375
|
41.5
|
79.17
|
|
30
|
35
|
32.5
|
589
|
19.63
|
1834
|
1755
|
61.13
|
58.5
|
|
35
|
40
|
37.5
|
594
|
19.80
|
2428
|
1166
|
80.93
|
38.87
|
|
40
|
45
|
42.5
|
572
|
19.07
|
3000
|
572
|
100
|
19.07
|
|
TOTAL
|
|
|
3000
|
100.00
|
|
|
|
|
# ============================================================
# GRÁFICA N°1
# ============================================================
hist(Latitud, breaks = Hist_Latitud$breaks,
main = "Gráfica N°1: Distribución de la Latitud del agua
en el estudio de contaminación del agua en China en el año 2023",
xlab = "Latitud (°)",
ylab = "Cantidad de muestras",
col = "pink",
xaxt = "n")
axis(1, at = Hist_Latitud$breaks,
labels = round(Hist_Latitud$breaks,1), las = 1)

# ============================================================
# TABLA N°2
# ============================================================
kable(TDFLatitud_total, align = "c",
caption = "Tabla N°2: Tabla de distribución de frecuencias de la Latitud del agua posterior a la representación gráfica en el estudio de contaminación del agua en China en el año 2023") %>%
kable_styling(full_width = FALSE, position = "center",
bootstrap_options = c("striped","hover","condensed"))
Tabla N°2: Tabla de distribución de frecuencias de la Latitud del agua
posterior a la representación gráfica en el estudio de contaminación del
agua en China en el año 2023
|
Lim.inf
|
Lim.sup
|
MC
|
ni
|
hi….
|
Ni.asc
|
Ni.desc
|
Hi.asc….
|
Hi.desc….
|
|
20
|
25
|
22.5
|
625
|
20.83
|
625
|
3000
|
20.83
|
100
|
|
25
|
30
|
27.5
|
620
|
20.67
|
1245
|
2375
|
41.5
|
79.17
|
|
30
|
35
|
32.5
|
589
|
19.63
|
1834
|
1755
|
61.13
|
58.5
|
|
35
|
40
|
37.5
|
594
|
19.80
|
2428
|
1166
|
80.93
|
38.87
|
|
40
|
45
|
42.5
|
572
|
19.07
|
3000
|
572
|
100
|
19.07
|
|
TOTAL
|
|
|
3000
|
100.00
|
|
|
|
|
# ============================================================
# GRÁFICA N°2
# ============================================================
hist(Latitud, breaks = Hist_Latitud$breaks,
main = "Gráfica N°2: Distribución global de la Latitud del agua
en el estudio de contaminación del agua en China en el año 2023",
xlab = "Latitud (°)",
ylab = "Cantidad de muestras",
col = "pink",
xaxt = "n")
axis(1, at = Hist_Latitud$breaks,
labels = round(Hist_Latitud$breaks,1), las = 1)

# ============================================================
# GRÁFICA N°3
# ============================================================
hist(Latitud, breaks = Hist_Latitud$breaks,
main = "Gráfica N°3: Distribución comparativa de la Latitud del agua
en el estudio de contaminación del agua en China en el año 2023",
xlab = "Latitud (°)",
ylab = "Cantidad de muestras",
col = "green",
xaxt = "n")
axis(1, at = Hist_Latitud$breaks,
labels = round(Hist_Latitud$breaks,1), las = 1)

# ============================================================
# GRÁFICA N°4
# ============================================================
hist(Latitud, breaks = Hist_Latitud$breaks,
main = "Gráfica N°4: Distribución local de frecuencia de la Latitud del agua
en el estudio de contaminación del agua en China en el año 2023",
xlab = "Latitud (°)",
ylab = "Cantidad de muestras",
col = "purple",
xaxt = "n")
axis(1, at = Hist_Latitud$breaks,
labels = round(Hist_Latitud$breaks,1), las = 1)

# ============================================================
# GRÁFICA N°5
# ============================================================
intervalos <- paste0("[", round(Li,1), " - ", round(Ls,1), ")")
barplot(round(hi * 100, 2),
names.arg = intervalos,
col = "lightblue",
main = "Gráfica N°5: Distribución porcentual de la Latitud del agua
en el estudio de contaminación del agua en China en el año 2023",
xlab = "Intervalos de Latitud (°)",
ylab = "Porcentaje (%)",
las = 2,
cex.names = 0.7)

# ============================================================
# GRÁFICA N°6
# ============================================================
plot(Li, Ni_asc, type = "o",
main = "Gráfica N°6: Distribución de frecuencias acumuladas de la Latitud del agua
en el estudio de contaminación del agua en China en el año 2023",
xlab = "Latitud (°)",
ylab = "Frecuencia acumulada",
col = "orange",
xaxt = "n")
lines(Ls, Ni_desc, col = "green", type = "o")
axis(1, at = Li, labels = round(Li,1), las = 1)

# ============================================================
# GRÁFICA N°7
# ============================================================
plot(Li, Hi_asc * 100, type = "o",
main = "Gráfica N°7: Distribución porcentual acumulada de la Latitud del agua
en el estudio de contaminación del agua en China en el año 2023",
xlab = "Latitud (°)",
ylab = "Porcentaje acumulado (%)",
col = "blue",
xaxt = "n")
lines(Ls, Hi_desc * 100, col = "red", type = "o")
axis(1, at = Li, labels = round(Li,1), las = 1)

# ============================================================
# GRÁFICA N°8
# ============================================================
boxplot(Latitud, horizontal = TRUE,
main = "Gráfica N°8: Diagrama de caja de la Latitud del agua
en el estudio de contaminación del agua en China en el año 2023",
xlab = "Latitud (°)",
col = "purple")

# ============================================================
# TABLA N°3: INDICADORES ESTADÍSTICOS
# ============================================================
media <- round(mean(Latitud), 2)
mediana <- round(median(Latitud), 2)
varianza <- round(var(Latitud), 2)
sd_lat <- round(sd(Latitud), 2)
cv <- round((sd(Latitud)/mean(Latitud))*100, 2)
asim <- round(skewness(Latitud, type = 2), 2)
curt <- round(kurtosis(Latitud), 2)
max_frec <- max(TDFLatitud$ni)
moda <- paste(TDFLatitud$MC[TDFLatitud$ni == max_frec], collapse = ", ")
out <- boxplot.stats(Latitud)$out
val_atip <- ifelse(length(out)==0,"No hay presencia de valores atípicos",
paste(length(out),"valores atípicos"))
tabla_indicadores <- data.frame(
Variable = "Latitud (°)",
Rango = paste0("[",round(min(Latitud),2)," ; ",round(max(Latitud),2),"]"),
X = media,
Me = mediana,
Mo = moda,
V = varianza,
Sd = sd_lat,
Cv = cv,
As = asim,
K = curt,
Valores_Atipicos = val_atip
)
tabla_indicadores %>%
gt() %>%
tab_header(
title = md("Tabla N°3"),
subtitle = md("*Indicadores estadísticos de la variable Latitud (°)*")
)
| Tabla N°3 |
| Indicadores estadísticos de la variable Latitud (°) |
| Variable |
Rango |
X |
Me |
Mo |
V |
Sd |
Cv |
As |
K |
Valores_Atipicos |
| Latitud (°) |
[20.01 ; 45] |
32.3 |
32.29 |
22.5 |
52.16 |
7.22 |
22.36 |
0.04 |
-1.2 |
No hay presencia de valores atípicos |