# Tema: Estadística Descriptiva
# Autor: Grupo 1
# Fecha: 25/11/2025
setwd("C:/Users/LENOVO/OneDrive/Escritorio/ESTADISTICA")
datos <- read.csv("china_water_pollution_data.csv")
# Convertir la fecha correctamente
datos$Date <- as.Date(datos$Date)
# Extraer mes en número
datos$Month <- format(datos$Date, "%m")
# Crear tabla de frecuencias del mes
Mes <- datos$Month
TDF_mes <- data.frame(table(Mes))
# Frecuencia absoluta
ni <- TDF_mes$Freq
N <- sum(ni)
# Frecuencia relativa %
hi <- round((ni / N) * 100, 2)
# Ajustar para asegurar EXACTAMENTE 100%
hi[length(hi)] <- 100 - sum(hi[-length(hi)])
# Acumuladas
Ni_asc <- cumsum(ni)
Ni_desc <- rev(cumsum(rev(ni)))
Hi_asc <- round(cumsum(hi), 2)
Hi_asc[length(Hi_asc)] <- 100
Hi_desc <- round(rev(cumsum(rev(hi))), 2)
Hi_desc[1] <- 100
# Tabla final
Tabla_Final <- data.frame(
Mes = TDF_mes$Mes,
ni = ni,
"hi(%)" = hi,
"Ni asc" = Ni_asc,
"Ni desc" = Ni_desc,
"Hi asc(%)" = Hi_asc,
"Hi desc(%)" = Hi_desc,
check.names = FALSE
)
# Agregar fila de TOTAL
Total <- data.frame(
Mes = "TOTAL",
ni = N,
"hi(%)" = 100,
"Ni asc" = "",
"Ni desc" = "",
"Hi asc(%)" = "",
"Hi desc(%)" = "",
check.names = FALSE
)
Tabla_Final <- rbind(Tabla_Final, Total)
# Mostrar tabla bonita
library(knitr)
## Warning: package 'knitr' was built under R version 4.5.2
library(kableExtra)
## Warning: package 'kableExtra' was built under R version 4.5.2
kable(
Tabla_Final,
align = "c",
caption = "Tabla Nº1: Tabla de Distribución de Frecuencias Simples y
Acumuladas del Mes de Contaminación del Agua en China (2023)"
) %>%
kable_styling(
full_width = FALSE,
position = "center",
bootstrap_options = c("striped", "hover", "condensed")
)
Tabla Nº1: Tabla de Distribución de Frecuencias Simples y Acumuladas del
Mes de Contaminación del Agua en China (2023)
|
Mes
|
ni
|
hi(%)
|
Ni asc
|
Ni desc
|
Hi asc(%)
|
Hi desc(%)
|
|
01
|
241
|
8.03
|
241
|
3000
|
8.03
|
100
|
|
02
|
226
|
7.53
|
467
|
2759
|
15.56
|
91.97
|
|
03
|
266
|
8.87
|
733
|
2533
|
24.43
|
84.44
|
|
04
|
232
|
7.73
|
965
|
2267
|
32.16
|
75.57
|
|
05
|
253
|
8.43
|
1218
|
2035
|
40.59
|
67.84
|
|
06
|
261
|
8.70
|
1479
|
1782
|
49.29
|
59.41
|
|
07
|
310
|
10.33
|
1789
|
1521
|
59.62
|
50.71
|
|
08
|
246
|
8.20
|
2035
|
1211
|
67.82
|
40.38
|
|
09
|
231
|
7.70
|
2266
|
965
|
75.52
|
32.18
|
|
10
|
258
|
8.60
|
2524
|
734
|
84.12
|
24.48
|
|
11
|
225
|
7.50
|
2749
|
476
|
91.62
|
15.88
|
|
12
|
251
|
8.38
|
3000
|
251
|
100
|
8.38
|
|
TOTAL
|
3000
|
100.00
|
|
|
|
|
# Tabla de frecuencias absolutas del mes
TDF_Mes <- data.frame(table(datos$Month))
ni_mes <- TDF_Mes$Freq
# Gráfico de barras - Frecuencia absoluta local
barplot(ni,
main = "Gráfica N°1: Distribución por Mes de la Contaminación del
Agua en China (2023)",
xlab = "Mes (01-12)",
ylab = "Cantidad",
col = "skyblue",
ylim = c(0, max(ni)),
names.arg = TDF_mes$Mes,
las = 2,
cex.names = 0.8)
# Gráfico de barras - Porcentaje local
barplot(hi,
main = "Gráfica N°2: Distribución porcentualor Mes de la
Contaminación del Agua en China (2023) ",
xlab = "Mes (01-12)",
ylab = "Porcentaje",
col = "lightgreen",
names.arg = TDF_mes$Mes,
las = 2,
cex.names = 0.8)
# Gráfico de barras - Frecuencia absoluta global
barplot(ni,
main = "Gráfica N°3: Distribución por Mes de la Contaminación del
Agua en China (2023)",
xlab = "Mes (01-12)",
ylab = "Cantidad",
col = "skyblue",
ylim = c(0,3000),
names.arg = TDF_mes$Mes,
cex.names = 0.8)
# Gráfico de barras - Porcentaje global
barplot(hi,
main = "Gráfica N°4: Distribución porcentual por Mes de la
Contaminación del Agua en China (2023)",
xlab = "Mes (01-12)",
ylab = "Porcentaje ",
col = "lightgreen",
ylim = c(0,100),
names.arg = TDF_mes$Mes,
las = 2,
cex.names = 0.8)
#Diagrama de caja y bigotes
Mes_num <- as.numeric(as.character(TDF_mes$Mes))
boxplot(Mes_num,
horizontal = TRUE,
main = "Gráfica N°5: Distribución de Frecuencias Simples y Acumuladas
del Mes de Contaminación del Agua en China (2023)",
xlab = "Mes",
col = "darkred",
pch = 1)
summary(Mes_num)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.00 3.75 6.50 6.50 9.25 12.00
# Diagrama de Ojiva Ascendente y Descendente
x_pos <- 1:length(TDF_mes$Mes)
plot(
x_pos, Ni_desc,
main = "Gráfica N°6: Distribución de Frecuencias Acumuladas Ascendentes y
Descendentes del Mes de Contaminación del Agua en China (2023)",
xlab = "Mes",
ylab = "Cantidad",
col = "orange",
type = "p", # SOLO puntos
lwd = 3,
xaxt = "n"
)
# Ojiva ascendente (solo puntos)
points(
x_pos, Ni_asc,
col = "green",
type = "p",
lwd = 3
)
# Nombres en el eje X, horizontales
axis(
side = 1,
at = x_pos,
labels = TDF_mes$Mes,
las = 1,
cex.axis = 0.9)
legend(
"top",
legend = c("Ojiva descendente", "Ojiva ascendente"),
col = c("orange", "green"),
pch = 2,
cex = 0.9,
horiz = TRUE)
#Graficar la ojiva ascendente (Hi_asc/dsc)
# Ojiva ascendente
plot(
x = 1:length(TDF_mes$Mes),
y = Hi_asc,
type = "p",
col = "green",
xlab = "Mes",
ylab = "Porcentaje acumulado",
main = "Gráfica Nº7:Distribución Porcentual Acumulada Ascendente
y Descendente del Mes de Contaminación del Agua en China (2023)",
xaxt = "n")
axis(
side = 1,
at = 1:length(TDF_mes$Mes),
labels = TDF_mes$Mes,
las = 1)
# Ojiva descendente
points(
x = 1:length(TDF_mes$Mes),
y = Hi_desc,
type = "p",
col = "orange")
# Leyenda
legend("top",
legend = c("Ojiva descendente", "Ojiva ascendente"),
col = c("green", "orange"),
pch = 1,
cex = 0.8)
