0. Librerías
# -------------------------
# Cargar librerías
# -------------------------
library(dplyr)
##
## Adjuntando el paquete: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(gt)
library(e1071)
3. Tabla de distribución de frecuencias
3.1 Tabla de frecuencias
# -------------------------
# Tabla de frecuencias
# -------------------------
tabla_freq <- as.data.frame(table(Sequias))
# Renombrar columnas
colnames(tabla_freq) <- c("Sequias", "ni")
# Frecuencia relativa (hi)
tabla_freq$hi <- round(
(tabla_freq$ni / sum(tabla_freq$ni)) * 100,
2
)
# Frecuencias acumuladas ascendentes (Corregido para dar exactamente 100)
tabla_freq$Ni_asc <- cumsum(tabla_freq$ni)
tabla_freq$Hi_asc <- round(
(tabla_freq$Ni_asc / sum(tabla_freq$ni)) * 100,
2
)
# Frecuencias acumuladas descendentes (Corregido para dar exactamente 100)
tabla_freq$Ni_dsc <- rev(cumsum(rev(tabla_freq$ni)))
tabla_freq$Hi_dsc <- round(
(tabla_freq$Ni_dsc / sum(tabla_freq$ni)) * 100,
2
)
# -------------------------
# Agregar fila de totales
# -------------------------
fila_total <- data.frame(
Sequias = "TOTAL",
ni = sum(tabla_freq$ni),
hi = 100,
Ni_asc = "",
Hi_asc = "",
Ni_dsc = "",
Hi_dsc = ""
)
tabla_final <- rbind(tabla_freq, fila_total)
# -------------------------
# Crear tabla gt
# -------------------------
tabla_gt <- tabla_final %>%
gt() %>%
tab_header(
title = md("**Tabla N°1**"),
subtitle = md("**Distribución de frecuencias de sequías en el estudio de la calidad de agua en Europa (1991-2017)**")
) %>%
cols_label(
Sequias = "Sequías",
ni = "ni",
hi = "hi (%)",
Ni_asc = "Ni ↑",
Hi_asc = "Hi ↑ (%)",
Ni_dsc = "Ni ↓",
Hi_dsc = "Hi ↓ (%)"
) %>%
tab_style(
style = cell_text(weight = "bold"),
locations = cells_body(
rows = Sequias == "TOTAL"
)
) %>%
opt_row_striping()
# Mostrar tabla
tabla_gt
| Tabla N°1 |
| Distribución de frecuencias de sequías en el estudio de la calidad de agua en Europa (1991-2017) |
| Sequías |
ni |
hi (%) |
Ni ↑ |
Hi ↑ (%) |
Ni ↓ |
Hi ↓ (%) |
| 0 |
1318 |
6.63 |
1318 |
6.63 |
19893 |
100 |
| 1 |
10240 |
51.48 |
11558 |
58.1 |
18575 |
93.37 |
| 2 |
5 |
0.03 |
11563 |
58.13 |
8335 |
41.9 |
| 3 |
4499 |
22.62 |
16062 |
80.74 |
8330 |
41.87 |
| 4 |
91 |
0.46 |
16153 |
81.2 |
3831 |
19.26 |
| 8 |
117 |
0.59 |
16270 |
81.79 |
3740 |
18.8 |
| 16 |
479 |
2.41 |
16749 |
84.2 |
3623 |
18.21 |
| 27 |
3 |
0.02 |
16752 |
84.21 |
3144 |
15.8 |
| 73 |
3141 |
15.79 |
19893 |
100 |
3141 |
15.79 |
| TOTAL |
19893 |
100.00 |
|
|
|
|
4 Gráficas
4.1 Histograma (ni)
# =========================
# HISTOGRAMA (ni)
# =========================
barplot(tabla_freq$ni,
main = "Gráfica N°1: Distribución de sequías en el estudio de la\ncalidad de agua en Europa (1991-2017)",
xlab = "Sequías",
ylab = "Cantidad",
col = "skyblue",
ylim = c(0, max(tabla_freq$ni) * 1.1),
names.arg = tabla_freq$Sequias,
las = 1,
cex.names = 0.8)

4.2 Histograma General (ni)
# =========================
# HISTOGRAMA GENERAL (ni)
# =========================
barplot(tabla_freq$ni,
main = "Gráfica N°2: Distribución general de sequías en el estudio de\nla calidad de agua en Europa (1991-2017)",
xlab = "Sequías",
ylab = "Cantidad",
col = "lightgreen",
ylim = c(0, 20000),
names.arg = tabla_freq$Sequias,
las = 1,
cex.names = 0.8)

4.3 Histograma (hi)
# =========================
# HISTOGRAMA (hi)
# =========================
barplot(tabla_freq$hi,
main = "Gráfica N°3: Distribución porcentual de sequías en el estudio de\nla calidad de agua en Europa (1991-2017)",
xlab = "Sequías",
ylab = "Porcentaje",
col = "skyblue",
ylim = c(0, max(tabla_freq$hi) * 1.1),
names.arg = tabla_freq$Sequias,
las = 1,
cex.names = 0.8)

4.4 Histograma General (hi)
# =========================
# HISTOGRAMA GENERAL (hi)
# =========================
barplot(tabla_freq$hi,
main = "Gráfica N°4: Distribución porcentual general de sequías en el\nestudio de la calidad de agua en Europa (1991-2017)",
xlab = "Sequías",
ylab = "Porcentaje",
col = "lightgreen",
ylim = c(0, 100),
names.arg = tabla_freq$Sequias,
las = 1,
cex.names = 0.8)

4.5 Diagrama de Caja
# =========================
# DIAGRAMA DE CAJA
# =========================
boxplot(
Sequias,
horizontal = TRUE,
col = "orange",
main = "Gráfica Nº5: Distribución de sequías en el estudio de\nla calidad de agua en Europa (1991-2017)",
xlab = "Porcentaje de sequías (%)"
)
points(
mean(Sequias),
1,
pch = 19,
col = "red"
)
legend(
"topright",
legend = "Media",
pch = 19,
col = "red"
)

4.6 Ojivas ascendentes y descendentes (Ni)
# ======================================
# OJIVAS ASCENDENTES Y DESCENDENTES (Ni)
# ======================================
# Posiciones en el eje X
x_pos <- 1:length(tabla_freq$Sequias)
# Ojiva descendente (Corregido a type = "p" y quitadas las líneas)
plot(x_pos,
tabla_freq$Ni_dsc,
main = "Gráfica N°6: Ojiva ascendente y descendente de las sequías en el\nestudio de la calidad de agua en Europa (1991-2017)",
xlab = "Sequías",
ylab = "Cantidad",
col = "orange",
type = "p",
pch = 19,
cex = 1.5,
xaxt = "n",
ylim = c(0, max(tabla_freq$Ni_dsc) * 1.05))
# Ojiva ascendente (Graficada como puntos aislados)
points(x_pos,
tabla_freq$Ni_asc,
col = "green",
pch = 19,
cex = 1.5)
# Etiquetas del eje X
axis(side = 1,
at = x_pos,
labels = tabla_freq$Sequias,
las = 1,
cex.axis = 0.9)
# Leyenda (Corregida sin líneas que crucen los puntos)
legend("topright",
legend = c("Descendente", "Ascendente"),
col = c("orange", "green"),
pch = 19,
pt.cex = 1.5,
lty = 0)

4.7 Ojivas ascendentes y descendentes (Hi)
# =======================================
# OJIVAS ASCENDENTES Y DESCENDENTES (Hi)
# =======================================
# Posiciones en el eje X
x_pos <- 1:length(tabla_freq$Sequias)
# Ojiva descendente (Corregido a type = "p" y quitadas las líneas)
plot(x_pos,
tabla_freq$Hi_dsc,
main = "Gráfica N°7: Ojiva ascendente y descendente de las sequías en el\nestudio de la calidad de agua en Europa (1991-2017)",
xlab = "Sequías",
ylab = "Porcentaje",
col = "red",
type = "p",
pch = 19,
cex = 1.5,
xaxt = "n",
ylim = c(0, 100))
# Ojiva ascendente (Graficada como puntos aislados)
points(x_pos,
tabla_freq$Hi_asc,
col = "blue",
pch = 19,
cex = 1.5)
# Etiquetas del eje X
axis(side = 1,
at = x_pos,
labels = tabla_freq$Sequias,
las = 1,
cex.axis = 0.9)
# Leyenda (Corregida sin líneas que crucen los puntos)
legend("topright",
legend = c("Descendente", "Ascendente"),
col = c("red", "blue"),
pch = 19,
pt.cex = 1.5,
lty = 0)

5. Indicadores Estadísticos
5.1 Indicadores de Tendencia Central
# =========================
# INDICADORES ESTADÍSTICOS
# Variable: Referencia de tiempo
# =========================
# =========================
# MEDIDAS DE TENDENCIA CENTRAL
# =========================
# Media
media <- round(mean(Sequias), 2)
# Moda
tabla_moda <- table(Sequias)
max_frecuencia <- max(tabla_moda)
moda <- names(tabla_moda)[tabla_moda == max_frecuencia]
# Mediana
mediana <- median(Sequias)
5.2 Dispersión
# =========================
# MEDIDAS DE DISPERSIÓN
# =========================
# Varianza
varianza <- var(Sequias)
# Desviación estándar
desviacion <- sd(Sequias)
# Coeficiente de variación
cv <- round((desviacion / media) * 100, 2)
5.3 Asimetría
# =========================
# MEDIDAS DE FORMA
# =========================
n <- length(Sequias)
# Asimetría
asimetria <- sum((Sequias - media)^3) / ((n - 1) * desviacion^3)
# Curtosis
curtosis <- sum((Sequias - media)^4) / ((n - 1) * desviacion^4) - 3
# =========================
# VALORES ATÍPICOS
# =========================
Q1 <- quantile(Sequias, 0.25)
Q3 <- quantile(Sequias, 0.75)
RIQ <- Q3 - Q1
LI <- Q1 - 1.5 * RIQ
LS <- Q3 + 1.5 * RIQ
atipicos <- Sequias[Sequias < LI | Sequias > LS]
if(length(atipicos) > 0){
mensaje_atipicos <- length(atipicos)
} else {
mensaje_atipicos <- 0
}
5.4 Tabla de indicadores
# =========================
# TABLA RESUMEN
# =========================
tabla_indicadores_sequias <- data.frame(
Variable = "Sequías",
Rango = paste0("[", min(Sequias), " ; ", max(Sequias), "]"),
X = media,
Me = mediana,
Mo = paste(moda, collapse = ", "),
V = round(varianza, 2),
Sd = round(desviacion, 2),
Cv = cv,
As = round(asimetria, 2),
K = round(curtosis, 2),
Valores_Atipicos = mensaje_atipicos,
stringsAsFactors = FALSE
)
# =========================
# TABLA GT
# =========================
fila_sequias <- which(
tabla_indicadores_sequias$Variable == "Sequías"
)
tabla_indicadores_sequias_gt <- tabla_indicadores_sequias %>%
gt() %>%
tab_header(
title = md("**Tabla N°3**"),
subtitle = md(
"**Indicadores estadísticos de las sequías en el estudio de la calidad de agua en Europa (1991-2017)**"
)
) %>%
tab_source_note(
source_note = md("Autor: Grupo 3")
) %>%
tab_options(
table.border.top.color = "black",
table.border.bottom.color = "black",
column_labels.border.bottom.width = px(2),
row.striping.include_table_body = TRUE
) %>%
tab_style(
style = cell_text(weight = "bold"),
locations = cells_body(
rows = fila_sequias
)
)
# Mostrar tabla
tabla_indicadores_sequias_gt
| Tabla N°3 |
| Indicadores estadísticos de las sequías en el estudio de la calidad de agua en Europa (1991-2017) |
| Variable |
Rango |
X |
Me |
Mo |
V |
Sd |
Cv |
As |
K |
Valores_Atipicos |
| Sequías |
[0 ; 73] |
13.17 |
1 |
1 |
677.16 |
26.02 |
197.59 |
1.84 |
1.45 |
3740 |
| Autor: Grupo 3 |
6. Conclusión
La variable Sequías fluctúa en un rango de 0 a 73, y sus valores
giran en torno a una mediana de 1, con una desviación estándar de 26.02.
Dado que el coeficiente de variación es de 197.59%, se trata de un
conjunto de valores extremadamente heterogéneo con una alta dispersión.
Los datos presentan una asimetría positiva (1.84), lo que indica que los
valores se acumulan de manera pronunciada en la parte baja de la
variable (cerca del cero). Con una curtosis de 1.45 y la presencia de
3740 valores atípicos, se observa una alta variabilidad en los
registros. Por lo anterior, lo cual es un indicador crítico de tipo
heterogeneo para el estudio de la calidad del agua en Europa
(1991-2017).