# 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