VARIABLE CUALITATIVA ORDINAL: PERÍODO
Markdown Estadística descriptiva
Variable cualitativa ordinal: Período (agrupación de la
fecha)
Autor: Samantha Pacheco
Fecha: 11/11/2026
0.- Carga de librerías
library(dplyr)
library(knitr)
library(kableExtra)1.- Leer Datos
load("pollution_2000_2023.RData")
datos <- as.data.frame(pollution_2000_2023)
n_filas <- nrow(datos)
n_filas## [1] 6654142.- Selección de la variable
La fecha de cada registro (día, mes y año) es una variable demasiado detallada para resumirla en una tabla. Por eso se agrupa en una jerarquía de tiempo: Día > Mes > Año > Período. Los períodos son grupos de años consecutivos de igual amplitud, y tienen un orden natural (del más antiguo al más reciente). Esa ventaja de ordenarse es lo que la convierte en una variable cualitativa ordinal.
ANIOS_POR_PERIODO <- 4 # ancho de cada período: 4 -> 6 períodos; 6 -> 4; 8 -> 3
fecha_all <- as.Date(datos$Date)
n_sin_fecha <- sum(is.na(fecha_all)) # registros sin fecha válida
fecha <- fecha_all[!is.na(fecha_all)]
anio <- as.integer(format(fecha, "%Y"))
n <- length(fecha) # tamaño muestral
anio_ini <- min(anio)
anio_fin <- max(anio)
inicio <- anio_ini + ANIOS_POR_PERIODO * ((anio - anio_ini) %/% ANIOS_POR_PERIODO)
fin <- pmin(inicio + ANIOS_POR_PERIODO - 1, anio_fin)
etiqueta <- paste0(inicio, "-", fin)
# Variable ordinal: las categorías quedan en orden cronológico
niveles <- unique(etiqueta[order(inicio)])
Periodo <- factor(etiqueta, levels = niveles, ordered = TRUE)
jerarquia <- data.frame(
Nivel = c("Día", "Mes", "Año", "Período"),
`Categorías distintas` = c(n_distinct(fecha),
n_distinct(format(fecha, "%Y-%m")),
n_distinct(anio),
nlevels(Periodo)),
check.names = FALSE
)
kable(jerarquia, align = "lr", format.args = list(big.mark = ",")) %>%
kable_styling(full_width = FALSE)| Nivel | Categorías distintas |
|---|---|
| Día | 8,674 |
| Mes | 285 |
| Año | 24 |
| Período | 6 |
- Rango de años: 2000 a 2023.
- Registros sin fecha válida: 0.
- Tamaño muestral: n = 665,414.
3.- Conteo (frecuencias)
t <- table(Periodo) # conserva el orden cronológico
conteo <- data.frame(Periodo = names(t), ni = as.numeric(t),
stringsAsFactors = FALSE)
conteo## Periodo ni
## 1 2000-2003 93762
## 2 2004-2007 97788
## 3 2008-2011 112323
## 4 2012-2015 129796
## 5 2016-2019 124162
## 6 2020-2023 1075834.- Tabla de distribución de frecuencias
Los cálculos se hacen con todos los decimales y solo se redondea al mostrar (hi con 4 decimales y %hi con 2 decimales). Como la variable es ordinal, las categorías se presentan en orden cronológico, no de mayor a menor frecuencia.
# Tabla con todos los decimales (con esta se construyen los gráficos)
tdf_final_periodos <- conteo
tdf_final_periodos$hi <- tdf_final_periodos$ni / n
tdf_final_periodos$pct_hi <- 100 * tdf_final_periodos$hi
# Frecuencias acumuladas (solo tienen sentido porque hay orden)
tdf_final_periodos$Ni_ac <- cumsum(tdf_final_periodos$ni)
tdf_final_periodos$Hi_ac <- cumsum(tdf_final_periodos$hi)
tdf_final_periodos$pct_Hi_ac <- cumsum(tdf_final_periodos$pct_hi)
# Verificación de totales
stopifnot(sum(tdf_final_periodos$ni) == n,
isTRUE(all.equal(sum(tdf_final_periodos$hi), 1)),
isTRUE(all.equal(sum(tdf_final_periodos$pct_hi), 100)))
# Presentación (redondeo solo aquí)
fmt <- function(v) format(v, big.mark = ",", scientific = FALSE, trim = TRUE)
salida <- data.frame(
i = c(seq_len(nrow(tdf_final_periodos)), ""),
v = c(tdf_final_periodos$Periodo, "TOTAL"),
ni = c(fmt(tdf_final_periodos$ni), fmt(sum(tdf_final_periodos$ni))),
hi = sprintf("%.4f", c(tdf_final_periodos$hi, sum(tdf_final_periodos$hi))),
pct = paste0(sprintf("%.2f", c(tdf_final_periodos$pct_hi,
sum(tdf_final_periodos$pct_hi))), "%"),
stringsAsFactors = FALSE
)
names(salida) <- c("i", "Período", "ni", "hi", "%hi")
kable(salida, align = "clrrr", row.names = FALSE,
caption = "Tabla 1. Distribución de frecuencias de la variable Período") %>%
kable_styling(bootstrap_options = c("striped", "condensed"), full_width = FALSE) %>%
row_spec(0, background = "#404040", color = "white") %>%
row_spec(nrow(salida), bold = TRUE, background = "#D9D9D9")| i | Período | ni | hi | %hi |
|---|---|---|---|---|
| 1 | 2000-2003 | 93,762 | 0.1409 | 14.09% |
| 2 | 2004-2007 | 97,788 | 0.1470 | 14.70% |
| 3 | 2008-2011 | 112,323 | 0.1688 | 16.88% |
| 4 | 2012-2015 | 129,796 | 0.1951 | 19.51% |
| 5 | 2016-2019 | 124,162 | 0.1866 | 18.66% |
| 6 | 2020-2023 | 107,583 | 0.1617 | 16.17% |
| TOTAL | 665,414 | 1.0000 | 100.00% |
Fuente: Índice de Calidad del Aire (ICA), EE. UU.,
2000–2023.
Conjunto de datos: https://www.kaggle.com/datasets/guslovesmath/us-pollution-data-200-to-2022/data
Autor: Samantha Pacheco
Al ser una variable ordinal, también se pueden calcular las frecuencias acumuladas (Ni, Hi y %Hi), que indican cuántos registros hay hasta cada período inclusive.
salida2 <- data.frame(
i = seq_len(nrow(tdf_final_periodos)),
v = tdf_final_periodos$Periodo,
Ni = fmt(tdf_final_periodos$Ni_ac),
Hi = sprintf("%.4f", tdf_final_periodos$Hi_ac),
pct = paste0(sprintf("%.2f", tdf_final_periodos$pct_Hi_ac), "%"),
stringsAsFactors = FALSE
)
names(salida2) <- c("i", "Período", "Ni", "Hi", "%Hi")
kable(salida2, align = "clrrr", row.names = FALSE,
caption = "Tabla 2. Frecuencias acumuladas de la variable Período") %>%
kable_styling(bootstrap_options = c("striped", "condensed"), full_width = FALSE) %>%
row_spec(0, background = "#404040", color = "white")| i | Período | Ni | Hi | %Hi |
|---|---|---|---|---|
| 1 | 2000-2003 | 93,762 | 0.1409 | 14.09% |
| 2 | 2004-2007 | 191,550 | 0.2879 | 28.79% |
| 3 | 2008-2011 | 303,873 | 0.4567 | 45.67% |
| 4 | 2012-2015 | 433,669 | 0.6517 | 65.17% |
| 5 | 2016-2019 | 557,831 | 0.8383 | 83.83% |
| 6 | 2020-2023 | 665,414 | 1.0000 | 100.00% |
5.- Gráficos de distribución de frecuencias
- Gráficas 1 y 3 (locales): el eje vertical se ajusta a las barras de la tabla.
- Gráficas 2 y 4 (globales): el eje vertical llega hasta el tamaño muestral (n en ni, y 100% en hi) para poder comparar cada barra con el total. La línea punteada marca ese total.
- Gráfica 5: diagrama circular con los porcentajes de la tabla.
- Los períodos se muestran en orden cronológico y el gris se oscurece conforme el período es más reciente.
grises <- gray.colors(nrow(tdf_final_periodos), start = 0.85, end = 0.25)
armar_titulo <- function(num, linea2) {
paste0("Gráfica Nro. ", num, "\n", linea2,
"\npara el análisis estadístico de la contaminación de EE. UU.")
}
graf_barras <- function(num, tipo, alcance) {
y <- tdf_final_periodos[[tipo]]
nombres <- tdf_final_periodos$Periodo
if (tipo == "ni") {
nom <- "absoluta (ni)"
ylab <- "Frecuencia absoluta (ni)"
etq <- format(y, big.mark = ",", scientific = FALSE, trim = TRUE)
tope_g <- n
l_tope <- paste0("n = ", format(n, big.mark = ",", scientific = FALSE))
f_eje <- function(v) format(v, big.mark = ",", scientific = FALSE, trim = TRUE)
} else {
y <- tdf_final_periodos$pct_hi # hi expresado en porcentaje
nom <- "relativa porcentual (%hi)"
ylab <- "Frecuencia relativa porcentual (%hi)"
etq <- paste0(sprintf("%.2f", y), "%")
tope_g <- 100
l_tope <- "Total = 100%"
f_eje <- function(v) paste0(v, "%")
}
tope <- if (alcance == "global") tope_g else max(y) * 1.15
par(mar = c(5, 7, 7, 2))
b <- barplot(y, names.arg = nombres, ylim = c(0, tope),
col = grises, border = "black", axes = FALSE, las = 1,
main = armar_titulo(num, paste0("Distribución de la frecuencia ", nom,
" ", alcance, " de la variable Período")),
xlab = "Período (años)", ylab = "", cex.main = 1.05)
ticks <- pretty(c(0, tope))
axis(2, at = ticks, labels = f_eje(ticks), las = 1)
mtext(ylab, side = 2, line = 5)
text(b, y, labels = etq, pos = 3, cex = 0.9, xpd = TRUE)
if (alcance == "global") {
abline(h = tope, lty = 2, col = "gray30")
text(par("usr")[2], tope, labels = l_tope, adj = c(1.05, 1.6), cex = 0.9)
}
}
graf_circular <- function(num) {
par(mar = c(2, 2, 7, 2))
etq <- paste0(sprintf("%.2f", tdf_final_periodos$pct_hi), " %")
pie(tdf_final_periodos$ni, labels = etq, col = grises, border = "black",
clockwise = TRUE, init.angle = 90, radius = 0.85, cex = 1.05,
main = armar_titulo(num, "Distribución circular de la variable Período"),
cex.main = 1.05)
legend("right",
legend = paste0(tdf_final_periodos$Periodo, " (",
format(tdf_final_periodos$ni, big.mark = ","), ")"),
fill = grises, title = "Leyenda", bty = "o", cex = 1)
}graf_barras(1, "ni", "local")
graf_barras(2, "ni", "global")
graf_barras(3, "hi", "local")
graf_barras(4, "hi", "global")
graf_circular(5)
6.- Medidas de tendencia central y de posición
Como la variable es ordinal, además de la moda se pueden calcular la mediana y los cuartiles, porque las categorías tienen orden. Se obtienen con las frecuencias relativas acumuladas: la mediana es el primer período donde se llega al 50% de los registros, Q1 al 25% y Q3 al 75%. La media no aplica, porque no hay valores numéricos.
tdf <- tdf_final_periodos
max_ni <- max(tdf$ni)
moda <- tdf$Periodo[tdf$ni == max_ni]
cat_acum <- function(p) tdf$Periodo[which(tdf$Hi_ac >= p - 1e-12)[1]]
q1 <- cat_acum(0.25)
mediana <- cat_acum(0.50)
q3 <- cat_acum(0.75)
kable(data.frame(Medida = c("Moda", "Primer cuartil (Q1)", "Mediana (Q2)", "Tercer cuartil (Q3)"),
Período = c(paste(moda, collapse = " ; "), q1, mediana, q3)),
align = "ll") %>%
kable_styling(full_width = FALSE)| Medida | Período |
|---|---|
| Moda | 2012-2015 |
| Primer cuartil (Q1) | 2004-2007 |
| Mediana (Q2) | 2012-2015 |
| Tercer cuartil (Q3) | 2016-2019 |
7.- Conclusiones
- El período con más registros (moda) es 2012-2015, con 129,796 observaciones, es decir 19.51% de los n = 665,414 registros.
- La mediana se ubica en el período 2012-2015: hasta ese período se acumula al menos el 50% de los registros.
- El período con menos registros es 2000-2003, con 14.09% de la muestra.
- (Escribe aquí tu propia interpretación de las tablas y gráficos.)