CLASE N. 21: Tablas de Frecuencias Agrupadas, Histograma y Polígono de Frecuencias

1. Datos de Entrada (Edades de 50 Personas)

edades <- c(
  38, 15, 12, 42, 35, 62, 18, 47, 28, 27,
  36, 11, 22, 19, 42, 38, 25, 32, 16, 10,
  42, 35, 28, 11, 16, 21, 35, 32, 28, 47,
  18, 31, 26, 16, 52, 19, 23, 35, 41, 62,
  16, 10, 31, 18, 38, 28, 31, 16, 42, 31
)

n <- length(edades)

2. Parámetros y Tabla de Frecuencias (Semana 21)

k <- round(1 + 3.322 * log10(n))

valor_max <- max(edades)
valor_min <- min(edades)

rango <- valor_max - valor_min

amplitud <- ceiling(rango / k)

cortes <- seq(
  valor_min,
  valor_min + k * amplitud,
  by = amplitud
)

intervalos <- cut(
  edades,
  breaks = cortes,
  right = FALSE,
  include.lowest = TRUE
)

frec_abs <- table(intervalos)

frec_rel <- prop.table(frec_abs)

frec_rel_pct <- frec_rel * 100

marcas_clase <- cortes[-length(cortes)] + amplitud / 2

tabla_s21 <- data.frame(
  Clase = names(frec_abs),
  Marca_xi = marcas_clase,
  Frec_Abs_ni = as.numeric(frec_abs),
  Frec_Rel_fi = round(as.numeric(frec_rel), 3),
  Porcentaje_pct = paste0(round(as.numeric(frec_rel_pct), 1), "%")
)

knitr::kable(
  tabla_s21,
  caption = "Tabla de Frecuencias Agrupadas - Semana 21"
)
Tabla de Frecuencias Agrupadas - Semana 21
Clase Marca_xi Frec_Abs_ni Frec_Rel_fi Porcentaje_pct
[10,18) 14 11 0.22 22%
[18,26) 22 9 0.18 18%
[26,34) 30 12 0.24 24%
[34,42) 38 9 0.18 18%
[42,50) 46 6 0.12 12%
[50,58) 54 1 0.02 2%
[58,66] 62 2 0.04 4%

3. Gráficos - Semana 21

par(mfrow = c(1, 2))

hist(
  edades,
  breaks = cortes,
  right = FALSE,
  col = "skyblue",
  border = "white",
  main = "Histograma y Polígono",
  xlab = "Edad (años)",
  ylab = "Frecuencia Absoluta (ni)",
  xaxt = "n"
)

axis(1, at = cortes)

lines(
  marcas_clase,
  frec_abs,
  type = "b",
  col = "forestgreen",
  pch = 19,
  lwd = 2
)

plot(
  marcas_clase,
  frec_abs,
  type = "o",
  col = "forestgreen",
  pch = 19,
  lwd = 2,
  main = "Polígono de Frecuencias",
  xlab = "Marca de Clase (xi)",
  ylab = "Frecuencia Absoluta (ni)",
  xaxt = "n"
)

axis(1, at = marcas_clase)

grid()

polygon(
  c(min(marcas_clase), marcas_clase, max(marcas_clase)),
  c(0, frec_abs, 0),
  col = rgb(0.1, 0.7, 0.3, 0.25),
  border = NA
)

par(mfrow = c(1, 1))

CLASE N. 22: Frecuencias Acumuladas, Histograma Acumulado y Ojiva

4. Tabla de Frecuencias Acumuladas

frec_abs_acum <- cumsum(frec_abs)

frec_rel_acum <- cumsum(frec_rel)

frec_rel_acum_pct <- cumsum(frec_rel_pct)

tabla_s22 <- data.frame(
  Clase = names(frec_abs),
  Marca_xi = marcas_clase,
  Frec_Abs_ni = as.numeric(frec_abs),
  Frec_Rel_fi = round(as.numeric(frec_rel), 3),
  Porcentaje_pct = paste0(round(as.numeric(frec_rel_pct), 1), "%"),
  Frec_Acum_Ni = as.numeric(frec_abs_acum),
  Porcentaje_Acum_Fi = paste0(round(as.numeric(frec_rel_acum_pct), 1), "%")
)

knitr::kable(
  tabla_s22,
  caption = "Tabla de Frecuencias Acumuladas - Semana 22"
)
Tabla de Frecuencias Acumuladas - Semana 22
Clase Marca_xi Frec_Abs_ni Frec_Rel_fi Porcentaje_pct Frec_Acum_Ni Porcentaje_Acum_Fi
[10,18) 14 11 0.22 22% 11 22%
[18,26) 22 9 0.18 18% 20 40%
[26,34) 30 12 0.24 24% 32 64%
[34,42) 38 9 0.18 18% 41 82%
[42,50) 46 6 0.12 12% 47 94%
[50,58) 54 1 0.02 2% 48 96%
[58,66] 62 2 0.04 4% 50 100%

5. Gráficos - Semana 22

par(mfrow = c(1, 2))

barplot(
  frec_abs_acum,
  space = 0,
  col = "palegreen3",
  border = "darkgreen",
  main = "Histograma de Frecuencias Acumuladas",
  xlab = "Intervalos de Clase",
  ylab = "Frecuencia Acumulada (Ni)"
)

limites_superiores <- cortes[-1]

plot(
  limites_superiores,
  frec_rel_acum_pct,
  type = "b",
  col = "blue4",
  pch = 18,
  lwd = 2,
  main = "Ojiva (Porcentaje Acumulado)",
  xlab = "Edad (Límite Superior)",
  ylab = "Porcentaje Acumulado (%)",
  ylim = c(0, 100)
)

grid()

abline(
  h = c(25, 50, 75, 100),
  col = "gray60",
  lty = 2
)

par(mfrow = c(1, 1))

6. Función de Distribución Empírica (ECDF)

plot(
  ecdf(edades),
  col = "purple",
  lwd = 2,
  main = "Función de Distribución Empírica (ECDF)",
  xlab = "Edad (años)",
  ylab = "Fn(Edad)"
)

grid()