# Estadística Descriptiva: Nivel de Contaminación
# Autor: Camila Zambrano
# Fecha: 03/12/2025
# Carga de librerías
library(knitr)
library(kableExtra)
#Carga de datos
getwd()
## [1] "C:/Users/Usuario/Documents/Camila/Estadística"
## [1] "~/Camila/Estadística/R"
# Establecer directorio y cargar datos
setwd("~/Camila/Estadística/R")
datos<- read.csv("china_water_pollution_data.csv",header = TRUE, sep = ";",
dec = ",")
#Extracción Variable Cuantitativa Discreta
Conductividad<-datos$Conductivity_uS_cm
#Tabla de distribución de frecuencia
#Manualmente
min <-min(Conductividad)
max <-max(Conductividad)
R <-max-min
K <- floor(1+3.33*log10(length(Conductividad)))
A <-R/K
Li <-round(seq(from=min,to=max-A,by=A),2)
Li[1] <- min(Conductividad)
Ls <-round(seq(from=min+A,to=max,by=A),2)
Mc <-(Li+Ls)/2
tol <- 1e-9
ni <- numeric(K)
for (i in 1:K) {
if (i < K) {
ni[i] <- sum(Conductividad >= Li[i] - tol & Conductividad < Ls[i] + tol)
} else {
ni[i] <- sum(Conductividad >= Li[i] - tol & Conductividad <= Ls[i] + tol)
}
}
sum(ni)
## [1] 3000
## [1] 3000
hi <-ni/sum(ni)*100
Ni_asc<-cumsum(ni)
Hi_asc<-cumsum(hi)
Ni_desc<-rev(cumsum(rev(ni)))
Hi_desc<-rev(cumsum(rev(hi)))
TDF_Conductividad <- data.frame(
Li, Ls, Mc, ni, round(hi, 2), Ni_asc, Ni_desc, round(Hi_asc, 2), round(Hi_desc, 2)
)
colnames(TDF_Conductividad)<-
c("Li","Ls","Mc","ni","hi","Ni_asc(%)","Ni_desc(%)","Hi_asc","Hi_desc")
#Crear fila de totales
totales<-c(
Li="-",
Ls="-",
Mc="-",
ni=sum(ni),
hi=sum(hi),
Ni_asc="-",
Ni_desc="-",
Hi_asc="-",
Hi_desc="-")
TDF_Conductividad<-rbind(TDF_Conductividad,totales)
#Simplificación con el histograma
Hist_Conductividad<-hist(Conductividad,breaks = 8,plot = F)
k<-length(Hist_Conductividad$breaks)
Li<-Hist_Conductividad$breaks[1:(length(Hist_Conductividad$breaks)-1)]
Ls<-Hist_Conductividad$breaks[2:length(Hist_Conductividad$breaks)]
ni<-Hist_Conductividad$counts
sum(ni)
## [1] 3000
## [1] 3000
Mc<-Hist_Conductividad$mids
hi<-(ni/sum(ni))
sum(hi)
## [1] 1
## [1] 1
Ni_asc<-cumsum(ni)
Hi_asc<-cumsum(hi)
Ni_desc<-rev(cumsum(rev(ni)))
Hi_desc<-rev(cumsum(rev(hi)))
TDF_Conductividad<-data.frame(Li=round(Li,2),
Ls=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))
colnames(TDF_Conductividad)<-c("Lim inf","Lim sup","MC","ni","hi(%)","Ni asc",
"Ni desc","Hi asc(%)","Hi desc(%)")
#Crear fila de totales
totales<-c(Li="TOTAL",
Ls="-",
Mc="-",
ni=sum(ni),
hi=sum(hi*100),
Ni_asc="-",
Ni_desc="-",
Hi_asc="-",
Hi_desc="-")
TDF_Conductividad_total<-rbind(TDF_Conductividad,totales)
library(knitr)
library(kableExtra)
kable(TDF_Conductividad_total, align = 'c', caption = "Tabla de Frecuencias de Conductividad
de 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 de Frecuencias de Conductividad de 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(%)
|
|
100
|
200
|
150
|
6
|
0.2
|
6
|
3000
|
0.2
|
100
|
|
200
|
300
|
250
|
70
|
2.33
|
76
|
2994
|
2.53
|
99.8
|
|
300
|
400
|
350
|
411
|
13.7
|
487
|
2924
|
16.23
|
97.47
|
|
400
|
500
|
450
|
1056
|
35.2
|
1543
|
2513
|
51.43
|
83.77
|
|
500
|
600
|
550
|
1006
|
33.53
|
2549
|
1457
|
84.97
|
48.57
|
|
600
|
700
|
650
|
396
|
13.2
|
2945
|
451
|
98.17
|
15.03
|
|
700
|
800
|
750
|
53
|
1.77
|
2998
|
55
|
99.93
|
1.83
|
|
800
|
900
|
850
|
2
|
0.07
|
3000
|
2
|
100
|
0.07
|
|
TOTAL
|
|
|
3000
|
100
|
|
|
|
|
# GRAFICAS
#Histograma
hist(Conductividad,breaks = 10,
main = "Gráfica N°1: Distribución de la cantidad de conductividad
de estudio de contaminación del agua en China en el año 2023",
xlab = "Conductividad (µS/cm)",
ylab = "Cantidad",
ylim = c(0,max(ni)),
col = "pink",
cex.main=1.3,
cex.lab=1,
cex.axis=0.9,
xaxt="n")
axis(1,at=Hist_Conductividad$breaks,labels = Hist_Conductividad$breaks,las=1,
cex.axis=0.9)
#Global
hist(Conductividad, breaks = 10,
main = "Gráfica N°2: Distribución de la cantidad de conductividad
de estudio de contaminación del agua en China en el año 2023",
xlab = "Conductividad (µS/cm)",
ylab = "Cantidad",
ylim = c(0, length(Conductividad)),
col = "lightgreen",
cex.main = 1.3,
cex.lab = 1,
cex.axis = 0.9,
xaxt = "n")
axis(1, at = Hist_Conductividad$breaks,
labels = Hist_Conductividad$breaks, las = 1,
cex.axis = 0.9)
# Barplot de porcentajes
barplot(TDF_Conductividad$hi,
space=0,
col = "skyblue",
main ="Gráfica N°3: Distribución porcentual de frecuencias relativas
para la conductividad de estudio de contaminación del agua en China en el año 2023 ",
xlab="Conductividad (µS/cm)",
ylab="Porcentaje",
names.arg =round(TDF_Conductividad$MC),
ylim = c(0,100))
# Local
hist(Conductividad, breaks = 10,
main ="Gráfica N°4: Distribución porcentual para la conductividadd
de estudio de contaminación del agua en China en el año 2023",
xlab = "Conductividad (µS/cm)",
ylab = "Cantidad",
ylim = c(0,max(ni)),
col = "purple",
cex.main = 1.3,
cex.lab = 1,
cex.axis = 0.9,
xaxt = "n")
axis(1, at = Hist_Conductividad$breaks,
labels = Hist_Conductividad$breaks, las = 1,
cex.axis = 0.9)
# Barplot de porcentajes
barplot(TDF_Conductividad$hi,space=0,
col = "lightblue",
main ="Gráfica N°5: Distribución porcentual para la conductividad
de estudio de contaminación del agua en China en el año 2023",
xlab="Conductividad (µS/cm)",
ylab="Porcentaje",
ylim = c(0,40),
names.arg = round(TDF_Conductividad$MC))
# Diagrama de Caja
boxplot(Conductividad,
horizontal = TRUE,
main = "Gráfica N°6: Distribución de frecuencia para la conductividad
de estudio de contaminación del agua en China
en el año 2023 ",
xlab = "Conductividad (µS/cm)",
col = "purple",
outline = TRUE,
pch = 1)
# Diagrama de Ojiva Ascendente y Descendente
plot(Li, Ni_asc,
main = "Gráfica N°7: Distribución de frecuencias acumuladas Ascendente y
Descendente para la conductividad de estudio de contaminación del agua en China
en el año 2023",
xlab = "Conductividad (µS/cm)",
ylab = "Cantidad",
xlim = c(min(Li), max(Ls)),
col = "lightblue",
cex.axis = 0.8,
type = "o",
lwd = 3,
las = 1,
xaxt = "n")
lines(Ls, Ni_desc,
col = "pink",
type = "o",
lwd = 3)
axis(1, at = Li, las = 1)
# Diagrama de Ojiva Ascendente y Descendente Porcentual
plot(Li, Hi_desc *100,
main = "Gráfica N°8: Distribución porcentual acumulada Ascendente y
Descendente para la conductividad de estudio de contaminación del agua en China
en el año 2023",
xlab = "Conductividad (µS/cm)",
ylab = "Cantidad",
xlim = c(min(Li), max(Ls)),
col = "red",
cex.axis = 0.8,
type = "o",
lwd = 3,
las = 1,
xaxt = "n")
lines(Ls, Hi_asc *100,
col = "blue",
type = "o",
lwd = 3)
axis(1, at = Li, las = 1)
# INDICADORES ESTADISTICOS
# Indicadores de Tendencia Central
# Media aritmética
media <- round(mean(Conductividad), 2)
media
## [1] 496.56
## [1] 496.56
# Moda
max_ni <- max(TDF_Conductividad$ni)
moda <- TDF_Conductividad$MC[TDF_Conductividad$ni == max_ni]
moda
## [1] 450
## [1] 450
# Mediana
mediana <- median(Conductividad)
mediana
## [1] 496.315
## [1] 496.315
# INDICADORES DE DISPERSIÓN
# Varianza
varianza <- var(Conductividad)
varianza
## [1] 9776.187
## [1] 9776.187
# Desviación Estándar
sd <- sd(Conductividad)
sd
## [1] 98.8746
## [1] 98.8746
# Coeficiente de Variación
cv <- round((sd / media) * 100, 2)
cv
## [1] 19.91
## [1] 19.91
# INDICADORES DE FORMA
# Asimetría
library(e1071)
asimetria <- skewness(Conductividad, type = 2)
asimetria
## [1] -0.03012506
## [1] -0.03012506
#Curtosis
curtosis <- kurtosis(Conductividad)
curtosis
## [1] 0.03063271
## [1] 0.03063271
tabla_indicadores <- data.frame("Variable" =c("Conductividad (µS/cm)"),
"Rango" = c("[136.85;842.49]"),
"X" = c(media),
"Me" = c(round(mediana,2)),
"Mo" = c(round(moda,2)),
"V" = c(round(varianza,2)),
"Sd" = c(round(sd,2)),
"Cv" = c(cv),
"As" = c(round(asimetria,2)),
"K" = c(round(curtosis,2)),
"Valores Atipicos" = "Sí existen")
library(knitr)
kable(tabla_indicadores, align = 'c', caption = "Conclusiones de la variable
conductividad en (µS/cm)")
Conclusiones de la variable conductividad en (µS/cm)
| Conductividad (µS/cm) |
[136.85;842.49] |
496.56 |
496.32 |
450 |
9776.19 |
98.87 |
19.91 |
-0.03 |
0.03 |
Sí existen |