fecha:
#Cargar datos
setwd("C:/Users/KEVIN/OneDrive - Universidad Central del Ecuador/Escritorio/kevin/Estadistica/mundial/Rstudio")
datos <- read.csv("water_pollution_disease.csv",header = TRUE,sep = ",",dec = ".")
#Extraccion variable Cuantitativa Continua
Precipitacion <- datos$Rainfall..mm.per.year.
# Tabla de distribución de frecuencia
# Manualmente
min <- min(Precipitacion)
max <- max(Precipitacion)
R <- max-min
k <- floor(1+3.33*log10(length(Precipitacion)))
A <- R/k
lim_inf <- seq(from=min,to=max-A,by=A)
lim_sup <- seq(from=min+A,to=max,by=A)
MC <- (lim_inf+lim_sup)/2
ni <- c()
for (i in 1:k) {
if (i < k) {
ni[i] <- length(subset(Precipitacion, Precipitacion >= lim_inf[i] & Precipitacion < lim_sup[i]))
} else {
ni[i] <- length(subset(Precipitacion, Precipitacion >= lim_inf[i] & Precipitacion <= lim_sup[i]))
}
}
sum(ni)
## [1] 3000
hi <- ni/sum(ni)*100
sum(hi)
## [1] 100
Ni_asc <- cumsum(ni)
Hi_asc <- cumsum(hi)
Ni_desc <- rev(cumsum(rev(ni)))
Hi_desc <- rev(cumsum(rev(hi)))
TDF_Precipitacion <- data.frame(round(lim_inf,2),
round(lim_sup,2),
MC,ni,
round(hi,2),
Ni_asc,
Ni_desc,
round(Hi_asc,2),
round(Hi_desc,2))
colnames(TDF_Precipitacion) <- c("Lim inf","Lim sup","MC","ni","hi(%)",
"Ni asc","Ni desc","Hi asc(%)","Hi desc(%)")
# crear de fila de totales
totales <- c( lim_inf= "TOTAL",
lim_sup= "-",
MC= "-",
ni= sum(ni),
hi= sum(hi),
Ni_asc= "-",
Ni_des= "-",
Hi_asc= "-",
Hi_des= "-")
TDF_Precipitacion_total <- rbind(TDF_Precipitacion,totales)
# Tabla mas estetica
library(knitr)
## Warning: package 'knitr' was built under R version 4.4.2
library(kableExtra)
## Warning: package 'kableExtra' was built under R version 4.4.2
kable(TDF_Precipitacion_total, align = 'c',
caption = "Tabla de Distribucion de Frecuencias de la Precipitación (mm/año)
de los países del estudiode la contaminación") %>%
kable_styling(full_width = FALSE, position = "center",
bootstrap_options = c("striped", "hover", "condensed"))
Tabla de Distribucion de Frecuencias de la Precipitación (mm/año) de los
países del estudiode la contaminación
|
Lim inf
|
Lim sup
|
MC
|
ni
|
hi(%)
|
Ni asc
|
Ni desc
|
Hi asc(%)
|
Hi desc(%)
|
|
200
|
433.25
|
316.625
|
274
|
9.13
|
274
|
3000
|
9.13
|
100
|
|
433.25
|
666.5
|
549.875
|
237
|
7.9
|
511
|
2726
|
17.03
|
90.87
|
|
666.5
|
899.75
|
783.125
|
272
|
9.07
|
783
|
2489
|
26.1
|
82.97
|
|
899.75
|
1133
|
1016.375
|
236
|
7.87
|
1019
|
2217
|
33.97
|
73.9
|
|
1133
|
1366.25
|
1249.625
|
270
|
9
|
1289
|
1981
|
42.97
|
66.03
|
|
1366.25
|
1599.5
|
1482.875
|
238
|
7.93
|
1527
|
1711
|
50.9
|
57.03
|
|
1599.5
|
1832.75
|
1716.125
|
216
|
7.2
|
1743
|
1473
|
58.1
|
49.1
|
|
1832.75
|
2066
|
1949.375
|
236
|
7.87
|
1979
|
1257
|
65.97
|
41.9
|
|
2066
|
2299.25
|
2182.625
|
267
|
8.9
|
2246
|
1021
|
74.87
|
34.03
|
|
2299.25
|
2532.5
|
2415.875
|
257
|
8.57
|
2503
|
754
|
83.43
|
25.13
|
|
2532.5
|
2765.75
|
2649.125
|
253
|
8.43
|
2756
|
497
|
91.87
|
16.57
|
|
2765.75
|
2999
|
2882.375
|
244
|
8.13
|
3000
|
244
|
100
|
8.13
|
|
TOTAL
|
|
|
3000
|
100
|
|
|
|
|
# Simplificación con el histograma
Hist_Precipitacion <- hist(Precipitacion,breaks = 8,plot = F)
k <- length(Hist_Precipitacion$breaks)
Li <- Hist_Precipitacion$breaks[1:(length(Hist_Precipitacion$breaks) - 1)]
Ls <- Hist_Precipitacion$breaks[2:length(Hist_Precipitacion$breaks)]
ni <- Hist_Precipitacion$counts
sum(ni)
## [1] 3000
MC <- Hist_Precipitacion$mids
hi <- (ni/sum(ni))
sum(hi)
## [1] 1
Ni_asc <- cumsum(ni)
Hi_asc <- cumsum(hi)
Ni_desc <- rev(cumsum(rev(ni)))
Hi_desc <- rev(cumsum(rev(hi)))
TDF_Precipitacion <- 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_Precipitacion) <- c("Lim inf","Lim sup","MC","ni","hi(%)",
"Ni asc","Ni desc","Hi asc(%)","Hi desc(%)")
# crear de fila de totales
totales <- c( lim_inf= "TOTAL",
lim_sup= "-",
MC= "-",
ni= sum(ni),
hi= sum(hi*100),
Ni_asc= "-",
Ni_des= "-",
Hi_asc= "-",
Hi_des= "-")
TDF_Precipitacion_total <- rbind(TDF_Precipitacion,totales)
kable(TDF_Precipitacion_total, align = 'c',
caption = "Tabla de Distribucion de Frecuencias de la Precipitación (mm/año)
de los países del estudio de la contaminación") %>%
kable_styling(full_width = FALSE, position = "center",
bootstrap_options = c("striped", "hover", "condensed"))
Tabla de Distribucion de Frecuencias de la Precipitación (mm/año) de los
países del estudio de la contaminación
|
Lim inf
|
Lim sup
|
MC
|
ni
|
hi(%)
|
Ni asc
|
Ni desc
|
Hi asc(%)
|
Hi desc(%)
|
|
0
|
500
|
250
|
344
|
11.47
|
344
|
3000
|
11.47
|
100
|
|
500
|
1000
|
750
|
552
|
18.4
|
896
|
2656
|
29.87
|
88.53
|
|
1000
|
1500
|
1250
|
524
|
17.47
|
1420
|
2104
|
47.33
|
70.13
|
|
1500
|
2000
|
1750
|
478
|
15.93
|
1898
|
1580
|
63.27
|
52.67
|
|
2000
|
2500
|
2250
|
561
|
18.7
|
2459
|
1102
|
81.97
|
36.73
|
|
2500
|
3000
|
2750
|
541
|
18.03
|
3000
|
541
|
100
|
18.03
|
|
TOTAL
|
|
|
3000
|
100
|
|
|
|
|
# GRAFICAS
# Histograma
hist(Precipitacion, breaks = 9,
main = "Gráfica N°1: Distribución de Precipitación (mm/año) de los países
del estudio de la contaminación",
xlab = "Precipitación (mm/año)",
ylab = "Cantidad",
ylim = c(0, max(ni)),
col = "purple",
cex.main = 0.9,
cex.lab = 1,
cex.axis = 0.9,
xaxt = "n")
axis(1, at = Hist_Precipitacion$breaks,
labels = Hist_Precipitacion$breaks, las = 1,
cex.axis = 0.9)
# Global
hist(Precipitacion, breaks = 9,
main = "Gráfica N°2: Distribución de Precipitación (mm/año) de los países
del estudio de la contaminación",
xlab = "Precipitación (mm/año)",
ylab = "Cantidad",
ylim = c(0, length(Precipitacion)),
col = "purple",
cex.main = 0.9,
cex.lab = 1,
cex.axis = 0.9,
xaxt = "n")
axis(1, at = Hist_Precipitacion$breaks,
labels = Hist_Precipitacion$breaks, las = 1,
cex.axis = 0.9)
barplot(TDF_Precipitacion$`hi(%)`,
space=0,
col = "skyblue",
main ="Gráfica N°3: Distribución porcentual de la Precipitación (mm/año)
de los países del estudio de la contaminación",
xlab="Precipitación (mm/año)",
ylab="Porcentaje (%)",
names.arg= TDF_Precipitacion$MC,
ylim = c(0,100))
# Local
hist(Precipitacion, breaks = 9,
main = "Gráfica N°4: Distribución de la Precipitación (mm/año) de los países
del estudio de la contaminación",
xlab = "Precipitación (mm/año)",
ylab = "Cantidad",
ylim = c(0,600),
col = "purple",
cex.main = 0.9,
cex.lab = 1,
cex.axis = 0.9,
xaxt = "n")
axis(1, at = Hist_Precipitacion$breaks,
labels = Hist_Precipitacion$breaks, las = 1,
cex.axis = 0.9)
barplot(TDF_Precipitacion$`hi(%)`,space=0,
col = "lightblue",
main ="Gráfica N°5: Distribución porcentual de la Precipitación (mm/año)
de los países del estudio de la contaminación",
xlab="Precipitación (mm/año)",
ylab="Porcentaje (%)",
ylim = c(0,20),
names.arg = TDF_Precipitacion$MC)
# Diagrama de Ojiva Ascendente y Descendente
plot(Ls,Ni_asc,
main = "Gráfica N°6: ",
xlab = " Precipitación (mm/año)",
ylab = "Cantidad",
xlim = c(100,3000),
col = "orange",
cex.axis=0.8,
type = "o",
lwd = 3,
las=1,
xaxt="n")
lines(Li ,Ni_desc,
col = "green",
type = "o",
lwd = 3)
axis(1, at = seq(0, 3000, by = 500))
# Diagrama de Ojiva Ascendente y Descendente Porcentual
plot(Ls, Hi_asc * 100,
main = "Gráfica N°7: ",
xlab = " Precipitación (mm/año)",
ylab = "Porcentaje (%)",
xlim = c(100,3000),
col = "red",
type = "o",
lwd = 2,
xaxt="n")
lines(Li, Hi_desc * 100,
col = "blue",
type = "o",
lwd = 3)
axis(1, at = seq(0,3000,by=500))
# Diagrama de Caja
boxplot(Precipitacion,
horizontal = TRUE,
main = "Gráfica N°4:distribucion de la Precipitación (mm/año)
de los países del estudio de la contaminación",
xlab = " Precipitación (mm/año)",
col = "purple",
outline = TRUE,
pch = 1)
# INDICADORES ESTADISTICOS
# Indicadores de Tendencia Central
# Media aritmética
media <- round(mean(Precipitacion), 2)
media
## [1] 1591.85
# Moda
max_frecuencia <- max(TDF_Precipitacion$ni)
moda <- TDF_Precipitacion$MC[TDF_Precipitacion$ni == max_frecuencia]
moda
## [1] 2250
# Mediana
mediana <- median(Precipitacion)
mediana
## [1] 1572
# INDICADORES DE DISPERSIÓN #
# Varianza
varianza <- var(Precipitacion)
varianza
## [1] 668310.2
# Desviación Estándar
sd <- sd(Precipitacion)
sd
## [1] 817.5024
# Coeficiente de Variación
cv <- round((sd / media) * 100, 2)
cv
## [1] 51.36
# INDICADORES DE FORMA #
# Asimetría
library(e1071)
## Warning: package 'e1071' was built under R version 4.4.3
asimetria <- skewness(Precipitacion, type = 2)
asimetria
## [1] 0.00851344
#Curtosis
curtosis <- kurtosis(Precipitacion)
curtosis
## [1] -1.236449
tabla_indicadores <- data.frame("Variable" =c("Precipitación (mm/año)"),
"Rango" = c("[200 ;2999]"),
"X" = c(media),
"Me" = c(round(mediana,2)),
"Mo" = c("[2000;2500]"),
"V" = c(round(varianza,2)),
"Sd" = c(round(sd,2)),
"Cv" = c(cv),
"As" = c(round(asimetria,4)),
"K" = c(round(curtosis,2)),
"Valores Atipicos" = "No hay presencia de valores atípicos")
library(knitr)
kable(tabla_indicadores, align = 'c', caption = "Conclusiones de la variable
Precipitación (mm/año) de los países del estudio de contaminación del agua")
Conclusiones de la variable Precipitación (mm/año) de los
países del estudio de contaminación del agua
| Precipitación (mm/año) |
[200 ;2999] |
1591.85 |
1572 |
[2000;2500] |
668310.2 |
817.5 |
51.36 |
0.0085 |
-1.24 |
No hay presencia de valores atípicos |