Taller 3 - Diseño Muestral

Universidad Surcolombiana - Especialización en Estadística

Author

Sergio Andres Beltran, William Steiner Morales, Daniel Santiago Ortiz, Juan Pablo Donato

Published

April 4, 2026

1 Planteamiento del Problema

Los estudiantes de la Universidad Surcolombiana afirman que el valor de la matrícula en pregrado (Acuerdo 050 de 2015) es muy costosa, señalando que más del 50% de los estudiantes pagan más de medio salario mínimo por concepto de matrícula.

Preguntas de investigación:

¿Existe evidencia suficiente para afirmar que el costo promedio de la matrícula en los programas de Pregrado está por encima de medio salario mínimo ($500.000)?
¿Más del 50% de los estudiantes de pregrado pagan más de medio salario mínimo?

Nota

El SMMLV 2022 en Colombia fue de $1.000.000, por lo tanto medio SMMLV = $500.000.

1.1 Objetivos

1.1.1 Objetivo General

Determinar, mediante cinco diseños muestrales distintos, si la percepción de los estudiantes sobre el alto costo de la matrícula es estadísticamente sustentable, comparando los resultados entre métodos probabilísticos y no probabilísticos.

1.1.2 Objetivos Específicos

Preparar el marco muestral con la base de datos completa de todos los programas de pregrado (N = 13.687).
Calcular el tamaño de muestra adecuado para estimar la media y la proporción con precisión.
Aplicar cinco métodos de muestreo: Aleatorio Simple (MAS), Sistemático, No Probabilístico, Estratificado y por Conglomerados.
Realizar inferencia estadística mediante intervalos de confianza al 95% y pruebas de hipótesis.
Comparar la eficiencia y sesgo de cada método frente a los parámetros poblacionales reales.

2 Limpieza y Preparación del Marco Muestral

Code

datos <- read.csv("C:/Users/ESTUDIANTES/Documents/Working Holydays/2.0Base dedatosMatriculaPreUSCO2022.csv",
  header = TRUE, sep = ";", fileEncoding = "latin1"
)
datos <- clean_names(datos)
names(datos) <- c("id_orig", "programas", "estrato_social", "declara_renta", "der_matricula")

N <- nrow(datos)
datos$id <- 1:N
mat <- datos$der_matricula

# Limpiar estrato social: agrupar valores atípicos
datos$estrato_clean <- as.character(datos$estrato_social)
datos$estrato_clean[datos$estrato_clean %in% c("0", "NULL", "")] <- "1"
datos$estrato_clean[datos$estrato_clean %in% c("5", "7")] <- "4"
datos$estrato_clean <- as.numeric(datos$estrato_clean)

cat("Población total N =", N, "\n")

Población total N = 13686

Code

cat("Programas únicos:", length(unique(datos$programas)), "\n")

Programas únicos: 54

Code

kable(head(datos[, c("id", "programas", "estrato_clean", "der_matricula")], 10),
  caption = "Primeras 10 filas del marco muestral",
  col.names = c("ID", "Programa", "Estrato", "Matrícula ($)"),
  format.args = list(big.mark = ".", decimal.mark = ",")
) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)

Primeras 10 filas del marco muestral
ID	Programa	Estrato	Matrícula ($)
1	NEIVA - LICENCIATURA EN LITERATURA Y LENGUA CASTELLANA	1	307.909
2	LA PLATA - PSICOLOGIA	1	287.764
3	NEIVA - ADMINISTRACION DE EMPRESAS (DIURNA)	2	1.564.376
4	NEIVA - INGENIERIA DE PETROLEOS	2	709.779
5	NEIVA - ENFERMERIA	2	1.188.128
6	NEIVA - ECONOMIA	3	1.899.080
7	NEIVA - DERECHO (NOCTURNA)	3	387.093
8	NEIVA - DERECHO (NOCTURNA)	3	387.093
9	NEIVA - CONTADURIA PUBLICA (NOCTURNA)	2	1.094.169
10	NEIVA - INGENIERIA DE PETROLEOS	2	1.567.952

3 Análisis Exploratorio de la Población

Code

media_pob <- mean(mat)
sd_pob <- sd(mat)
mediana_pob <- median(mat)

# Proporción que paga MÁS de $500.000
P_mayor_pob <- sum(mat > 500000) / N
P_menor_pob <- sum(mat < 500000) / N

fmt <- function(x, dec = 0) {
  formatC(round(x, dec), format = "f", digits = dec, big.mark = ".", decimal.mark = ",")
}

tabla_pob <- data.frame(
  Parametro = c(
    "N (población total)",
    "Media (\u03bc)",
    "Mediana",
    "Desviación estándar (\u03c3)",
    "Mínimo",
    "Máximo",
    "P(matrícula > $500.000)",
    "P(matrícula \u2264 $500.000)"
  ),
  Valor = c(
    fmt(N),
    paste0("$", fmt(media_pob)),
    paste0("$", fmt(mediana_pob)),
    paste0("$", fmt(sd_pob)),
    paste0("$", fmt(min(mat))),
    paste0("$", fmt(max(mat))),
    paste0(fmt(P_mayor_pob * 100, 2), "%"),
    paste0(fmt(P_menor_pob * 100, 2), "%")
  )
)

kable(tabla_pob, col.names = c("Parámetro", "Valor"),
  caption = "Parámetros Poblacionales - Todos los Programas de Pregrado",
  align = c("l", "r")) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
    full_width = FALSE) %>%
  row_spec(0, background = "#8F141B", color = "white", bold = TRUE)

Parámetros Poblacionales - Todos los Programas de Pregrado
Parámetro	Valor
N (población total)	13.686
Media (μ)	$632.540
Mediana	$420.386
Desviación estándar (σ)	$455.708
Mínimo	$117.922
Máximo	$3.776.068
P(matrícula > $500.000)	39,58%
P(matrícula ≤ $500.000)	60,42%

Code

p_plotly <- 
ggplot(datos, aes(x = der_matricula)) +
  geom_histogram(bins = 50, fill = "#2196F3", color = "white", alpha = 0.8) +
  geom_vline(xintercept = 500000, color = "red", linetype = "dashed", linewidth = 1) +
  geom_vline(xintercept = media_pob, color = "#e67e22", linetype = "dashed", linewidth = 1) +
  annotate("text", x = 500000, y = Inf, label = "Medio SMMLV", color = "red",
    hjust = -0.1, vjust = 2, fontface = "bold") +
  annotate("text", x = media_pob, y = Inf, label = paste0("Media = $", format(round(media_pob), big.mark = ".")),
    color = "#e67e22", hjust = -0.1, vjust = 4, fontface = "bold") +
  scale_x_continuous(labels = label_number(big.mark = ".", prefix = "$")) +
  labs(title = "Distribución de Matrículas - Todos los Programas de Pregrado",
    subtitle = paste0("N = ", format(N, big.mark = "."), " estudiantes"),
    x = "Derecho de Matrícula", y = "Frecuencia") +
  theme_minimal(base_size = 13) +
  theme(plot.title = element_text(face = "bold"))
ggplotly(p_plotly) %>%
  layout(margin = list(t = 80)) %>%
  config(displaylogo = FALSE)

Code

datos %>%
  group_by(estrato_clean) %>%
  summarise(n = n(), Media = round(mean(der_matricula)),
    Porcentaje = round(n() / N * 100, 2)) %>%
  kable(caption = "Distribución por Estrato Social",
    col.names = c("Estrato", "N", "Media Matrícula ($)", "% Población"),
    format.args = list(big.mark = ".", decimal.mark = ",")) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)

Distribución por Estrato Social
Estrato	N	Media Matrícula ($)	% Población
1	5.559	446.953	40,62
2	7.267	691.813	53,10
3	719	1.208.176	5,25
4	141	1.959.241	1,03

Code

p_plotly <- 
ggplot(datos, aes(x = factor(estrato_clean), y = der_matricula, fill = factor(estrato_clean))) +
  geom_boxplot(alpha = 0.7, outlier.alpha = 0.3) +
  scale_fill_brewer(palette = "Set2") +
  scale_y_continuous(labels = label_number(big.mark = ".", prefix = "$")) +
  labs(title = "Matrícula por Estrato Social", x = "Estrato", y = "Matrícula ($)") +
  theme_minimal(base_size = 13) +
  theme(plot.title = element_text(face = "bold"), legend.position = "none")
ggplotly(p_plotly) %>%
  layout(margin = list(t = 80)) %>%
  config(displaylogo = FALSE)

Code

top_prog <- datos %>%
  group_by(programas) %>%
  summarise(n = n(), Media = mean(der_matricula)) %>%
  arrange(desc(n)) %>%
  head(20)

p_plotly <- 
ggplot(top_prog, aes(x = reorder(programas, Media), y = Media)) +
  geom_bar(stat = "identity", fill = "#2196F3", alpha = 0.8) +
  geom_hline(yintercept = 500000, color = "red", linetype = "dashed") +
  coord_flip() +
  scale_y_continuous(labels = label_number(big.mark = ".", prefix = "$")) +
  labs(title = "Media de Matrícula por Programa (Top 20 más grandes)",
    x = "", y = "Media de Matrícula ($)") +
  theme_minimal(base_size = 11) +
  theme(plot.title = element_text(face = "bold"))
ggplotly(p_plotly) %>%
  layout(margin = list(t = 80)) %>%
  config(displaylogo = FALSE)

4 Cálculo del Tamaño de Muestra $n$

Nivel de confianza 95% ($Z = 1.96$), error del 5% sobre la media y 5 puntos porcentuales para la proporción, con tasa de no respuesta del 5%.

Code

Z <- 1.96
S2_pob <- var(mat)
S_pob_calc <- sd(mat)
P_piloto <- P_mayor_pob
Q_piloto <- 1 - P_piloto
e_media <- 0.05 * media_pob
e_prop <- 0.05

n_media <- ceiling((N * Z^2 * S2_pob) / ((N - 1) * e_media^2 + Z^2 * S2_pob))
n_prop <- ceiling((N * Z^2 * P_piloto * Q_piloto) / ((N - 1) * e_prop^2 + Z^2 * P_piloto * Q_piloto))

n_media_aj <- ceiling(n_media / (1 - 0.05))
n_prop_aj <- ceiling(n_prop / (1 - 0.05))
n_final <- max(n_media_aj, n_prop_aj)

tabla_n <- data.frame(
  Concepto = c("n para la media (sin ajuste)", "n para la proporción (sin ajuste)",
    "n media ajustado (5% NR)", "n proporción ajustado (5% NR)", "n final (máximo)"),
  Valor = c(n_media, n_prop, n_media_aj, n_prop_aj, n_final)
)
kable(tabla_n, caption = "Resumen de Tamaños de Muestra") %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)

Resumen de Tamaños de Muestra
Concepto	Valor
n para la media (sin ajuste)	754
n para la proporción (sin ajuste)	358
n media ajustado (5% NR)	794
n proporción ajustado (5% NR)	377
n final (máximo)	794

Justificación

Se selecciona n_final = 794 como el mayor entre los tamaños ajustados.

5 Selección de las Muestras (Cinco Métodos)

5.1 Muestreo Aleatorio Simple (MAS)

Code

set.seed(2022)
ids_mas <- sort(sample(1:N, n_final))
muestra_mas <- datos[datos$id %in% ids_mas, ]

kable(head(muestra_mas[, c("id", "programas", "estrato_clean", "der_matricula")], 10),
  caption = "Primeras 10 filas - Muestra MAS") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)

Primeras 10 filas - Muestra MAS
	id	programas	estrato_clean	der_matricula
17	17	NEIVA - BIOLOGIA APLICADA	2	1867583
69	69	NEIVA - INGENIERIA AGROINDUSTRIAL	2	522055
121	121	NEIVA - INGENIERIA CIVIL	1	1244008
123	123	NEIVA - LICENCIATURA EN MATEMATICAS	2	384701
130	130	NEIVA - DERECHO (DIURNA)	1	263368
191	191	GARZON - INGENIERIA AGRICOLA	2	431399
201	201	GARZON - DERECHO	2	928976
205	205	NEIVA - LICENCIATURA EN LENGUA CASTELLANA	2	400703
210	210	NEIVA - CONTADURIA PUBLICA (NOCTURNA)	2	505075
215	215	NEIVA - CONTADURIA PUBLICA (DIURNA)	2	402407

5.2 Muestreo Sistemático

Code

k <- ceiling(N / n_final)   # ceiling() para no superar n
cat("Paso sistemático K =", k, "\n")

Paso sistemático K = 18

Code

set.seed(2022)
r <- sample(1:k, 1)         # arranque aleatorio entre 1 y K
ids_sist <- seq(r, N, by = k)
ids_sist <- ids_sist[1:min(n_final, length(ids_sist))]
muestra_sist <- datos[datos$id %in% ids_sist, ]
cat("Tamaño muestra sistemática:", nrow(muestra_sist), "\n")

Tamaño muestra sistemática: 761

Code

kable(head(muestra_sist[, c("id", "programas", "estrato_clean", "der_matricula")], 10),
  caption = "Primeras 10 filas - Muestra Sistemática") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)

Primeras 10 filas - Muestra Sistemática
	id	programas	estrato_clean	der_matricula
4	4	NEIVA - INGENIERIA DE PETROLEOS	2	709779
22	22	PITALITO - ADMINISTRACION DE EMPRESAS (NOCTURNA)	2	503040
40	40	PITALITO - DERECHO	1	423259
58	58	PITALITO - INGENIERIA AGRICOLA	1	296694
76	76	NEIVA - MEDICINA	1	403830
94	94	NEIVA - MEDICINA	2	1759115
112	112	NEIVA - LICENCIATURA EN INGLES	2	1060241
130	130	NEIVA - DERECHO (DIURNA)	1	263368
148	148	NEIVA - LICENCIATURA EN MATEMATICAS	2	418691
166	166	NEIVA - LICENCIATURA EN MATEMATICAS	2	479608

5.3 Muestreo No Probabilístico por Conveniencia

Code

muestra_conv <- datos[1:n_final, ]

kable(head(muestra_conv[, c("id", "programas", "estrato_clean", "der_matricula")], 10),
  caption = "Primeras 10 filas - Muestra por Conveniencia") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)

Primeras 10 filas - Muestra por Conveniencia
id	programas	estrato_clean	der_matricula
1	NEIVA - LICENCIATURA EN LITERATURA Y LENGUA CASTELLANA	1	307909
2	LA PLATA - PSICOLOGIA	1	287764
3	NEIVA - ADMINISTRACION DE EMPRESAS (DIURNA)	2	1564376
4	NEIVA - INGENIERIA DE PETROLEOS	2	709779
5	NEIVA - ENFERMERIA	2	1188128
6	NEIVA - ECONOMIA	3	1899080
7	NEIVA - DERECHO (NOCTURNA)	3	387093
8	NEIVA - DERECHO (NOCTURNA)	3	387093
9	NEIVA - CONTADURIA PUBLICA (NOCTURNA)	2	1094169
10	NEIVA - INGENIERIA DE PETROLEOS	2	1567952

Advertencia

Este muestreo NO es probabilístico. Sus resultados NO son generalizables. Se incluye SOLO con fines comparativos.

5.4 Muestreo Aleatorio Estratificado

Se utiliza el Estrato Social como variable de estratificación con asignación proporcional: cada estrato aporta a la muestra en proporción a su peso en la población.

Code

# Tabla de estratos con tamaños y pesos
info_estratos <- datos %>%
  group_by(estrato_clean) %>%
  summarise(N_h = n(), Media_h = mean(der_matricula), S_h = sd(der_matricula),
    P_h = sum(der_matricula > 500000) / n()) %>%
  mutate(W_h = N_h / N, n_h = pmax(2, round(n_final * W_h)))

# Ajustar para que sumen n_final
diff_n <- n_final - sum(info_estratos$n_h)
if (diff_n != 0) {
  idx_max <- which.max(info_estratos$N_h)
  info_estratos$n_h[idx_max] <- info_estratos$n_h[idx_max] + diff_n
}

kable(info_estratos,
  caption = "Asignación Proporcional por Estrato",
  col.names = c("Estrato", "N_h", "Media ($)", "Desv. Est.", "P(>500k)", "W_h", "n_h"),
  digits = c(0, 0, 0, 0, 4, 4, 0),
  format.args = list(big.mark = ".", decimal.mark = ",")) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)

Asignación Proporcional por Estrato
Estrato	N_h	Media ($)	Desv. Est.	P(>500k)	W_h	n_h
1	5.559	446.953	271.467	0,1594	0,4062	323
2	7.267	691.813	432.480	0,5180	0,5310	421
3	719	1.208.176	648.621	0,8790	0,0525	42
4	141	1.959.241	696.203	0,9574	0,0103	8

Code

# Seleccionar muestra estratificada
set.seed(2022)
muestra_estrat <- data.frame()
for (i in 1:nrow(info_estratos)) {
  estrato_h <- datos[datos$estrato_clean == info_estratos$estrato_clean[i], ]
  idx_h <- sample(1:nrow(estrato_h), info_estratos$n_h[i])
  muestra_estrat <- rbind(muestra_estrat, estrato_h[idx_h, ])
}

cat("Tamaño muestra estratificada:", nrow(muestra_estrat), "\n")

Tamaño muestra estratificada: 794

Code

muestra_estrat %>%
  group_by(estrato_clean) %>%
  summarise(n_muestra = n(), Porcentaje = round(n() / nrow(muestra_estrat) * 100, 2)) %>%
  kable(caption = "Distribución de la Muestra Estratificada",
    col.names = c("Estrato", "n", "% Muestra")) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)

Distribución de la Muestra Estratificada
Estrato	n	% Muestra
1	323	40.68
2	421	53.02
3	42	5.29
4	8	1.01

5.5 Muestreo por Conglomerados

Se utilizan los programas académicos como conglomerados. Se presentan dos versiones:

Versión A (una etapa): Se seleccionan aleatoriamente $m$ programas y se incluyen todos los estudiantes.
Versión B (dos etapas): Se seleccionan los mismos $m$ programas, pero dentro de cada uno se toma una sub-muestra proporcional para alcanzar un $n$ comparable al de los demás diseños (~794).

5.5.1 Versión A — Una Etapa (censo dentro de cada cluster)

Code

M_total <- length(unique(datos$programas))
m_sel <- 10

# Información de todos los conglomerados
info_cong <- datos %>%
  group_by(programas) %>%
  summarise(M_i = n(), Media_i = mean(der_matricula), Total_i = sum(der_matricula)) %>%
  arrange(desc(M_i))

# Selección aleatoria de m programas (SRS de clusters)
set.seed(2022)
programas_sel <- sample(unique(datos$programas), m_sel)
muestra_cong_1e <- datos[datos$programas %in% programas_sel, ]

resumen_cong_1e <- muestra_cong_1e %>%
  group_by(programas) %>%
  summarise(
    n = n(),
    Media = fmt(mean(der_matricula)),
    P_mayor_500k = fmt(sum(der_matricula > 500000) / n() * 100, 2)
  )

kable(resumen_cong_1e,
  caption = paste0("Versión A — Programas seleccionados (m = ", m_sel, " de ", M_total, ")"),
  col.names = c("Programa", "n (todos)", "Media ($)", "P(>500k) %"),
  align = c("l", "r", "r", "r")) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE) %>%
  row_spec(0, background = "#8F141B", color = "white", bold = TRUE)

Versión A — Programas seleccionados (m = 10 de 54)
Programa	n (todos)	Media ($)	P(>500k) %
LA PLATA - INGENIERIA AGRICOLA	137	419.654	17,52
NEIVA - BIOLOGIA APLICADA	183	763.887	60,11
NEIVA - ECONOMIA	328	761.998	55,79
NEIVA - INGENIERIA AGRICOLA	301	557.799	31,56
NEIVA - INGENIERIA DE PETROLEOS	300	857.614	58,33
NEIVA - LICENCIATURA EN EDUCACION BASICA CON ENFASIS EN EDUCACION FISICA, RECREACION Y DEPORTE	12	357.982	0,00
NEIVA - LICENCIATURA EN EDUCACION BASICA CON ENFASIS EN HUMANIDADES, LENGUA EXTRANJERA-INGLES	32	468.951	12,50
NEIVA - LICENCIATURA EN INGLES	325	669.806	47,38
PITALITO - ADMINISTRACION DE EMPRESAS (NOCTURNA)	281	459.947	20,64
PITALITO - COMUNICACION SOCIAL Y PERIODISMO	125	470.970	18,40

Code

cat("Tamaño total muestra 1 etapa:", nrow(muestra_cong_1e), "\n")

Tamaño total muestra 1 etapa: 2024

5.5.2 Versión B — Dos Etapas (sub-muestreo proporcional dentro de cada cluster)

Code

# Mismos programas seleccionados, pero sub-muestreo proporcional
n_objetivo_cong <- n_final   # objetivo: mismo n que los otros diseños

# Calcular n por programa proporcional a su tamaño
cong_sel_info <- data.frame(
  programa = programas_sel,
  N_i = sapply(programas_sel, function(p) sum(datos$programas == p))
)
cong_sel_info$w_i <- cong_sel_info$N_i / sum(cong_sel_info$N_i)
cong_sel_info$n_i <- pmax(2, round(n_objetivo_cong * cong_sel_info$w_i))

# Ajustar para que sumen n_objetivo_cong
diff_cong <- n_objetivo_cong - sum(cong_sel_info$n_i)
if (diff_cong != 0) {
  idx_max_cong <- which.max(cong_sel_info$N_i)
  cong_sel_info$n_i[idx_max_cong] <- cong_sel_info$n_i[idx_max_cong] + diff_cong
}

# Extraer sub-muestras
set.seed(2022)
muestra_cong_2e <- data.frame()
for (j in 1:nrow(cong_sel_info)) {
  prog_j <- datos[datos$programas == cong_sel_info$programa[j], ]
  idx_j <- sample(1:nrow(prog_j), min(cong_sel_info$n_i[j], nrow(prog_j)))
  muestra_cong_2e <- rbind(muestra_cong_2e, prog_j[idx_j, ])
}

resumen_cong_2e <- muestra_cong_2e %>%
  group_by(programas) %>%
  summarise(
    n_sub = n(),
    Media = fmt(mean(der_matricula)),
    P_mayor_500k = fmt(sum(der_matricula > 500000) / n() * 100, 2)
  )

kable(cbind(
    resumen_cong_2e,
    N_programa = cong_sel_info$N_i[match(resumen_cong_2e$programas, cong_sel_info$programa)]
  ),
  caption = paste0("Versión B — Sub-muestreo proporcional (n objetivo ≈ ", n_objetivo_cong, ")"),
  col.names = c("Programa", "n sub-muestra", "Media ($)", "P(>500k) %", "N programa"),
  align = c("l", "r", "r", "r", "r")) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE) %>%
  row_spec(0, background = "#8F141B", color = "white", bold = TRUE)

Versión B — Sub-muestreo proporcional (n objetivo ≈ 794)
Programa	n sub-muestra	Media ($)	P(>500k) %	N programa
LA PLATA - INGENIERIA AGRICOLA	54	424.932	18,52	137
NEIVA - BIOLOGIA APLICADA	72	813.992	61,11	183
NEIVA - ECONOMIA	128	779.288	59,38	328
NEIVA - INGENIERIA AGRICOLA	118	577.972	33,90	301
NEIVA - INGENIERIA DE PETROLEOS	118	847.429	57,63	300
NEIVA - LICENCIATURA EN EDUCACION BASICA CON ENFASIS EN EDUCACION FISICA, RECREACION Y DEPORTE	5	347.997	0,00	12
NEIVA - LICENCIATURA EN EDUCACION BASICA CON ENFASIS EN HUMANIDADES, LENGUA EXTRANJERA-INGLES	13	488.708	7,69	32
NEIVA - LICENCIATURA EN INGLES	127	625.401	43,31	325
PITALITO - ADMINISTRACION DE EMPRESAS (NOCTURNA)	110	474.300	23,64	281
PITALITO - COMUNICACION SOCIAL Y PERIODISMO	49	488.922	20,41	125

Code

cat("Tamaño total muestra 2 etapas:", nrow(muestra_cong_2e), "\n")

Tamaño total muestra 2 etapas: 794

Code

# Para el resto del análisis, usar la versión 1 etapa como "Cong. 1 etapa"
# y la versión 2 etapas como "Cong. 2 etapas"
muestra_cong <- muestra_cong_1e   # mantener compatibilidad

6 Estimación Puntual y Error Estándar

Code

# Función para MAS, Sistemático y No Probabilístico
calc_ee <- function(muestra_x, N_pob, nombre) {
  n_m <- length(muestra_x)
  y_bar <- mean(muestra_x)
  s_m <- sd(muestra_x)
  ee_media <- sqrt((N_pob - n_m) / N_pob) * (s_m / sqrt(n_m))
  p_m <- sum(muestra_x > 500000) / n_m
  q_m <- 1 - p_m
  ee_prop <- sqrt((N_pob - n_m) / (N_pob - 1)) * sqrt(p_m * q_m / n_m)
  data.frame(Muestra = nombre, n = n_m,
    Media_y = round(y_bar, 2), EE_media = round(ee_media, 2),
    Prop_p = round(p_m, 4), EE_prop = round(ee_prop, 4))
}

ee_mas <- calc_ee(muestra_mas$der_matricula, N, "MAS")
ee_sist <- calc_ee(muestra_sist$der_matricula, N, "Sistemático")
ee_conv <- calc_ee(muestra_conv$der_matricula, N, "No Probabilístico")

Code

# Estimadores estratificados
y_bar_st <- sum(info_estratos$W_h * sapply(1:nrow(info_estratos), function(i) {
  mean(muestra_estrat$der_matricula[muestra_estrat$estrato_clean == info_estratos$estrato_clean[i]])
}))

ee_media_st <- sqrt(sum(sapply(1:nrow(info_estratos), function(i) {
  est_h <- info_estratos$estrato_clean[i]
  x_h <- muestra_estrat$der_matricula[muestra_estrat$estrato_clean == est_h]
  n_h <- length(x_h)
  N_h <- info_estratos$N_h[i]
  W_h <- info_estratos$W_h[i]
  W_h^2 * var(x_h) / n_h * (1 - n_h / N_h)
})))

p_bar_st <- sum(info_estratos$W_h * sapply(1:nrow(info_estratos), function(i) {
  x_h <- muestra_estrat$der_matricula[muestra_estrat$estrato_clean == info_estratos$estrato_clean[i]]
  sum(x_h > 500000) / length(x_h)
}))

ee_prop_st <- sqrt(sum(sapply(1:nrow(info_estratos), function(i) {
  est_h <- info_estratos$estrato_clean[i]
  x_h <- muestra_estrat$der_matricula[muestra_estrat$estrato_clean == est_h]
  n_h <- length(x_h)
  N_h <- info_estratos$N_h[i]
  W_h <- info_estratos$W_h[i]
  p_h <- sum(x_h > 500000) / n_h
  W_h^2 * p_h * (1 - p_h) / (n_h - 1) * (1 - n_h / N_h)
})))

ee_estrat <- data.frame(Muestra = "Estratificado", n = nrow(muestra_estrat),
  Media_y = round(y_bar_st, 2), EE_media = round(ee_media_st, 2),
  Prop_p = round(p_bar_st, 4), EE_prop = round(ee_prop_st, 4))

Code

# ── Versión A: Conglomerados 1 etapa (ratio estimator) ──
cong_stats_1e <- muestra_cong_1e %>%
  group_by(programas) %>%
  summarise(M_i = n(), t_i = sum(der_matricula), a_i = sum(der_matricula > 500000))

M_bar <- N / M_total
y_bar_cl1 <- sum(cong_stats_1e$t_i) / sum(cong_stats_1e$M_i)
p_bar_cl1 <- sum(cong_stats_1e$a_i) / sum(cong_stats_1e$M_i)
f_c <- m_sel / M_total

var_media_cl1 <- ((1 - f_c) / (m_sel * (m_sel - 1) * M_bar^2)) *
  sum((cong_stats_1e$t_i - y_bar_cl1 * cong_stats_1e$M_i)^2)
ee_media_cl1 <- sqrt(var_media_cl1)

var_prop_cl1 <- ((1 - f_c) / (m_sel * (m_sel - 1) * M_bar^2)) *
  sum((cong_stats_1e$a_i - p_bar_cl1 * cong_stats_1e$M_i)^2)
ee_prop_cl1 <- sqrt(var_prop_cl1)

ee_cong_1e <- data.frame(Muestra = "Cong. 1 etapa", n = nrow(muestra_cong_1e),
  Media_y = round(y_bar_cl1, 2), EE_media = round(ee_media_cl1, 2),
  Prop_p = round(p_bar_cl1, 4), EE_prop = round(ee_prop_cl1, 4))

# ── Versión B: Conglomerados 2 etapas ──
# Usa calc_ee (como MAS dentro de cada cluster, combinado)
cong_stats_2e <- muestra_cong_2e %>%
  group_by(programas) %>%
  summarise(M_i = n(), t_i = sum(der_matricula), a_i = sum(der_matricula > 500000))

y_bar_cl2 <- sum(cong_stats_2e$t_i) / sum(cong_stats_2e$M_i)
p_bar_cl2 <- sum(cong_stats_2e$a_i) / sum(cong_stats_2e$M_i)

# Varianza dos etapas: entre-clusters + dentro-clusters
# Componente entre-clusters
var_entre_media <- ((1 - f_c) / (m_sel * (m_sel - 1) * M_bar^2)) *
  sum((cong_stats_2e$t_i - y_bar_cl2 * cong_stats_2e$M_i)^2)
# Componente dentro-clusters
var_dentro_media <- (1 / (m_sel * M_bar)^2) * sum(sapply(1:nrow(cong_sel_info), function(j) {
  prog_data <- muestra_cong_2e[muestra_cong_2e$programas == cong_sel_info$programa[j], ]
  n_j <- nrow(prog_data)
  N_j <- cong_sel_info$N_i[j]
  N_j^2 * (1 - n_j / N_j) * var(prog_data$der_matricula) / n_j
}))
ee_media_cl2 <- sqrt(var_entre_media + var_dentro_media)

# Proporción 2 etapas
var_entre_prop <- ((1 - f_c) / (m_sel * (m_sel - 1) * M_bar^2)) *
  sum((cong_stats_2e$a_i - p_bar_cl2 * cong_stats_2e$M_i)^2)
var_dentro_prop <- (1 / (m_sel * M_bar)^2) * sum(sapply(1:nrow(cong_sel_info), function(j) {
  prog_data <- muestra_cong_2e[muestra_cong_2e$programas == cong_sel_info$programa[j], ]
  n_j <- nrow(prog_data)
  N_j <- cong_sel_info$N_i[j]
  p_j <- sum(prog_data$der_matricula > 500000) / n_j
  N_j^2 * (1 - n_j / N_j) * p_j * (1 - p_j) / (n_j - 1)
}))
ee_prop_cl2 <- sqrt(var_entre_prop + var_dentro_prop)

ee_cong_2e <- data.frame(Muestra = "Cong. 2 etapas", n = nrow(muestra_cong_2e),
  Media_y = round(y_bar_cl2, 2), EE_media = round(ee_media_cl2, 2),
  Prop_p = round(p_bar_cl2, 4), EE_prop = round(ee_prop_cl2, 4))

Code

tabla_ee <- bind_rows(ee_mas, ee_sist, ee_conv, ee_estrat, ee_cong_1e, ee_cong_2e)

kable(tabla_ee,
  caption = paste0("Estimación Puntual y Error Estándar (N = ", fmt(N), ")"),
  col.names = c("Método", "n", "Media (ȳ)", "EE(ȳ)", "Prop. p(>500k)", "EE(p)"),
  format.args = list(big.mark = ".", decimal.mark = ",")) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE) %>%
  row_spec(0, background = "#8F141B", color = "white", bold = TRUE)

Estimación Puntual y Error Estándar (N = 13.686)
Método	n	Media (ȳ)	EE(ȳ)	Prop. p(>500k)	EE(p)
MAS	794	635.092,7	15.886,19	0,3866	0,0168
Sistemático	761	641.725,5	16.037,10	0,4074	0,0173
No Probabilístico	794	665.464,7	17.280,30	0,4093	0,0169
Estratificado	794	630.982,9	14.020,27	0,3906	0,0152
Cong. 1 etapa	2.024	641.060,4	39.408,68	0,4081	0,0424
Cong. 2 etapas	794	646.283,7	17.922,77	0,4156	0,0191

Comentario

El muestreo estratificado típicamente produce el menor error estándar. El conglomerados de 1 etapa tiene mayor EE (correlación intra-cluster) pero usa todos los estudiantes del cluster. El de 2 etapas tiene un n comparable a los demás diseños pero agrega varianza adicional por el sub-muestreo.

7 Intervalos de Confianza al 95%

Code

Z_ic <- 1.96

calc_ic <- function(ee_row) {
  data.frame(
    Muestra = ee_row$Muestra,
    IC_media_inf = round(ee_row$Media_y - Z_ic * ee_row$EE_media, 2),
    IC_media_sup = round(ee_row$Media_y + Z_ic * ee_row$EE_media, 2),
    Amplitud_media = round(2 * Z_ic * ee_row$EE_media, 2),
    IC_prop_inf = round(ee_row$Prop_p - Z_ic * ee_row$EE_prop, 4),
    IC_prop_sup = round(ee_row$Prop_p + Z_ic * ee_row$EE_prop, 4),
    Amplitud_prop = round(2 * Z_ic * ee_row$EE_prop, 4)
  )
}

tabla_ic <- bind_rows(lapply(1:nrow(tabla_ee), function(i) calc_ic(tabla_ee[i, ])))

kable(tabla_ic,
  caption = "Intervalos de Confianza al 95%",
  col.names = c("Método", "IC media inf", "IC media sup", "Amplitud media",
    "IC prop inf", "IC prop sup", "Amplitud prop"),
  format.args = list(big.mark = ".", decimal.mark = ",")) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)

Intervalos de Confianza al 95%
Método	IC media inf	IC media sup	Amplitud media	IC prop inf	IC prop sup	Amplitud prop
MAS	603.955,8	666.229,6	62.273,86	0,3537	0,4195	0,0659
Sistemático	610.292,7	673.158,2	62.865,43	0,3735	0,4413	0,0678
No Probabilístico	631.595,3	699.334,0	67.738,78	0,3762	0,4424	0,0662
Estratificado	603.503,1	658.462,6	54.959,46	0,3608	0,4204	0,0596
Cong. 1 etapa	563.819,4	718.301,4	154.482,03	0,3250	0,4912	0,1662
Cong. 2 etapas	611.155,1	681.412,4	70.257,26	0,3782	0,4530	0,0749

Con 95% de confianza, según el MAS, el promedio de matrícula se encuentra entre $603.956 y $666.230.

Para la proporción que paga más de medio SMMLV: entre el 35.37% y el 41.95%.

8 Pruebas de Hipótesis

8.1 Planteamiento

Para la media: $H_0: \mu \le 500.000$ vs $H_1: \mu > 500.000$ (unilateral derecha)
Para la proporción: $H_0: P \le 0.50$ vs $H_1: P > 0.50$ donde $P$ = proporción que paga MÁS de $500.000 (unilateral derecha)
Nivel de significancia: $\alpha = 0.05$, $Z_{tabla} = 1.645$

Code

mu_0 <- 500000
alpha <- 0.05
Z_tabla <- 1.645

prueba_hipotesis <- function(ee_row, mu_0, P_0 = 0.50) {
  Zc_media <- (ee_row$Media_y - mu_0) / ee_row$EE_media
  pval_media <- 1 - pnorm(Zc_media)
  Q_0 <- 1 - P_0
  Zc_prop <- (ee_row$Prop_p - P_0) / sqrt(P_0 * Q_0 / ee_row$n)
  pval_prop <- 1 - pnorm(Zc_prop)
  data.frame(
    Muestra = ee_row$Muestra,
    Zc_media = round(Zc_media, 4), pval_media = round(pval_media, 6),
    Decision_media = ifelse(Zc_media > Z_tabla, "Rechazar H0", "No Rechazar H0"),
    Zc_prop = round(Zc_prop, 4), pval_prop = round(pval_prop, 6),
    Decision_prop = ifelse(Zc_prop > Z_tabla, "Rechazar H0", "No Rechazar H0")
  )
}

tabla_hipotesis <- bind_rows(lapply(1:nrow(tabla_ee), function(i) prueba_hipotesis(tabla_ee[i, ], mu_0)))

kable(tabla_hipotesis,
  caption = "Pruebas de Hipotesis: Media (H1: mu > 500.000) y Proporcion (H1: P > 0.50)",
  col.names = c("Metodo", "Zc media", "p-valor media", "Decision media",
    "Zc prop.", "p-valor prop.", "Decision prop.")) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)

Pruebas de Hipotesis: Media (H1: mu > 500.000) y Proporcion (H1: P > 0.50)
Metodo	Zc media	p-valor media	Decision media	Zc prop.	p-valor prop.	Decision prop.
MAS	8.5038	0.000000	Rechazar H0	-6.3908	1.000000	No Rechazar H0
Sistemático	8.8373	0.000000	Rechazar H0	-5.1090	1.000000	No Rechazar H0
No Probabilístico	9.5753	0.000000	Rechazar H0	-5.1115	1.000000	No Rechazar H0
Estratificado	9.3424	0.000000	Rechazar H0	-6.1653	1.000000	No Rechazar H0
Cong. 1 etapa	3.5794	0.000172	Rechazar H0	-8.2690	1.000000	No Rechazar H0
Cong. 2 etapas	8.1619	0.000000	Rechazar H0	-4.7564	0.999999	No Rechazar H0

8.2 Campana de Gauss - Prueba para la Media

Code

metodos_levels <- c("MAS", tabla_ee$Muestra[-1])   # usar nombres de tabla_ee
df_gauss <- data.frame(
  Metodo = tabla_hipotesis$Muestra,
  Zc = tabla_hipotesis$Zc_media,
  Decision = tabla_hipotesis$Decision_media
)
df_gauss$Metodo <- factor(df_gauss$Metodo, levels = tabla_ee$Muestra)

x_vals <- seq(-4, max(5, max(abs(df_gauss$Zc)) + 1), length.out = 500)
df_curva <- expand.grid(x = x_vals, Metodo = levels(df_gauss$Metodo))
df_curva$y <- dnorm(df_curva$x)
df_curva$Metodo <- factor(df_curva$Metodo, levels = levels(df_gauss$Metodo))
df_curva$rechazo <- df_curva$x > Z_tabla

p_plotly <- 
ggplot() +
  geom_area(data = df_curva[df_curva$rechazo, ],
    aes(x = x, y = y), fill = "#F44336", alpha = 0.3) +
  geom_line(data = df_curva, aes(x = x, y = y),
    color = "#2c3e50", linewidth = 1) +
  geom_vline(xintercept = Z_tabla, linetype = "dashed", color = "red", linewidth = 0.8) +
  geom_vline(data = df_gauss, aes(xintercept = Zc),
    color = "#8F141B", linewidth = 1.2) +
  geom_text(data = df_gauss,
    aes(x = Zc, y = 0.42, label = paste0("Zc = ", round(Zc, 2))),
    color = "#8F141B", hjust = -0.1, size = 3.5, fontface = "bold") +
  annotate("text", x = Z_tabla, y = 0.44,
    label = paste0("Z tabla = ", Z_tabla),
    color = "red", hjust = -0.1, size = 3) +
  facet_wrap(~Metodo, ncol = 1) +
  labs(title = "Campana de Gauss - Prueba Unilateral Derecha para la Media",
    subtitle = "H0: mu <= $500.000 vs H1: mu > $500.000 | alpha = 0.05",
    x = "Valor Z", y = "Densidad") +
  theme_minimal(base_size = 13) +
  theme(plot.title = element_text(face = "bold"),
    strip.text = element_text(face = "bold", size = 11))
ggplotly(p_plotly) %>%
  layout(margin = list(t = 80)) %>%
  config(displaylogo = FALSE)

8.3 Campana de Gauss - Prueba para la Proporción

Code

df_gauss_p <- data.frame(
  Metodo = tabla_hipotesis$Muestra,
  Zc = tabla_hipotesis$Zc_prop,
  Decision = tabla_hipotesis$Decision_prop
)
df_gauss_p$Metodo <- factor(df_gauss_p$Metodo, levels = tabla_ee$Muestra)

x_vals_p <- seq(min(-4, min(df_gauss_p$Zc) - 1), 4, length.out = 500)
df_curva_p <- expand.grid(x = x_vals_p, Metodo = levels(df_gauss_p$Metodo))
df_curva_p$y <- dnorm(df_curva_p$x)
df_curva_p$Metodo <- factor(df_curva_p$Metodo, levels = levels(df_gauss_p$Metodo))
df_curva_p$rechazo <- df_curva_p$x > Z_tabla

p_plotly <- 
ggplot() +
  geom_area(data = df_curva_p[df_curva_p$rechazo, ],
    aes(x = x, y = y), fill = "#F44336", alpha = 0.3) +
  geom_line(data = df_curva_p, aes(x = x, y = y),
    color = "#2c3e50", linewidth = 1) +
  geom_vline(xintercept = Z_tabla, linetype = "dashed", color = "red", linewidth = 0.8) +
  geom_vline(data = df_gauss_p, aes(xintercept = Zc),
    color = "#FF9800", linewidth = 1.2) +
  geom_text(data = df_gauss_p,
    aes(x = Zc, y = 0.42, label = paste0("Zc = ", round(Zc, 2))),
    color = "#FF9800", hjust = -0.1, size = 3.5, fontface = "bold") +
  facet_wrap(~Metodo, ncol = 1) +
  labs(title = "Campana de Gauss - Prueba Unilateral Derecha para la Proporcion",
    subtitle = "H0: P <= 0.50 vs H1: P > 0.50 (P = prop. que paga MAS de $500k) | alpha = 0.05",
    x = "Valor Z", y = "Densidad") +
  theme_minimal(base_size = 13) +
  theme(plot.title = element_text(face = "bold"),
    strip.text = element_text(face = "bold", size = 11))
ggplotly(p_plotly) %>%
  layout(margin = list(t = 80)) %>%
  config(displaylogo = FALSE)

8.4 Detalle de la prueba para la media (MAS)

La funcion pivotal es: $Z_c = \frac{\bar{y} - \mu_0}{ee(\bar{y})}$

$\bar{y}$ = $635.093
$ee(\bar{y})$ = $15.886.19
$Z_c$ = 8.5038
Zona de rechazo: $Z_c > 1.645$
Decision: Rechazar H0
p-valor: 0

8.5 Detalle de la prueba para la proporcion (MAS)

La funcion pivotal es: $Z_c = \frac{p - P_0}{\sqrt{P_0 \cdot Q_0 / n}}$

$p$ = 0.3866, $P_0$ = 0.50, $n$ = 794
$Z_c$ = -6.3908
Decision: No Rechazar H0
p-valor: 1

9 Validacion, Analisis Comparativo y Comparacion con la Poblacion

Nota

Este paso es posible porque se tiene acceso a toda la poblacion ($N = 13.686$). En la practica esto no siempre ocurre, pero cuando se dispone del marco completo es una herramienta de validacion muy valiosa.

9.1 Tabla Maestra de Comparacion

Code

calc_stats <- function(x, nombre) {
  data.frame(
    Muestra = nombre, n = length(x),
    Media = round(mean(x)), Mediana = round(median(x)),
    Desv_Estandar = round(sd(x)), Minimo = min(x),
    Q1 = round(quantile(x, 0.25)), Q3 = round(quantile(x, 0.75)),
    Maximo = max(x),
    CV = round(sd(x) / mean(x) * 100, 2),
    Prop_mayor = round(sum(x > 500000) / length(x), 4),
    Prop_menor = round(sum(x < 500000) / length(x), 4)
  )
}

tabla_maestra <- bind_rows(
  calc_stats(datos$der_matricula, "Poblacion"),
  calc_stats(muestra_mas$der_matricula, "MAS"),
  calc_stats(muestra_sist$der_matricula, "Sistematico"),
  calc_stats(muestra_conv$der_matricula, "No Probabilistico"),
  calc_stats(muestra_estrat$der_matricula, "Estratificado"),
  calc_stats(muestra_cong_1e$der_matricula, "Cong. 1 etapa"),
  calc_stats(muestra_cong_2e$der_matricula, "Cong. 2 etapas")
)

kable(t(tabla_maestra),
  caption = "Tabla Maestra - Comparacion Poblacion vs Muestras",
  format.args = list(big.mark = ".", decimal.mark = ",")) %>%
  kable_styling(
    bootstrap_options = c("striped", "hover", "bordered", "condensed"),
    full_width = FALSE, font_size = 11) %>%
  row_spec(0, background = "#8F141B", color = "white", bold = TRUE)

Tabla Maestra - Comparacion Poblacion vs Muestras
	25%...1	25%...2	25%...3	25%...4	25%...5	25%...6	25%...7
Muestra	Poblacion	MAS	Sistematico	No Probabilistico	Estratificado	Cong. 1 etapa	Cong. 2 etapas
n	13686	794	761	794	794	2024	794
Media	632540	635093	641725	665465	630757	641060	646284
Mediana	420386	418691	420386	426401	418691	427648	436736
Desv_Estandar	455708	461220	455241	501695	463877	465392	453386
Minimo	117922	252182	253775	256230	209838	199391	199391
Q1	381626	374579	383221	384922	374488	372595	383750
Q3	700117	716034	726478	726478	689327	709779	743181
Maximo	3776068	2550124	2544864	2571297	2841666	3776068	2491568
CV	72.04	72.62	70.94	75.39	73.54	72.60	70.15
Prop_mayor	0.3958	0.3866	0.4074	0.4093	0.3904	0.4081	0.4156
Prop_menor	0.6042	0.6134	0.5926	0.5907	0.6096	0.5919	0.5844

9.2 Sesgo de cada Estimador

Code

mu_real <- media_pob
P_real <- P_mayor_pob

sesgo_media <- data.frame(
  Metodo = tabla_ee$Muestra,
  Media_muestra = tabla_ee$Media_y,
  Sesgo_abs_media = round(abs(tabla_ee$Media_y - mu_real), 2),
  Sesgo_rel_media = round(abs(tabla_ee$Media_y - mu_real) / mu_real * 100, 2),
  Prop_muestra = tabla_ee$Prop_p,
  Sesgo_abs_prop = round(abs(tabla_ee$Prop_p - P_real), 4),
  Sesgo_rel_prop = round(abs(tabla_ee$Prop_p - P_real) / P_real * 100, 2)
)

kable(sesgo_media,
  caption = "Sesgo Absoluto y Relativo de cada Estimador",
  col.names = c("Metodo", "Media muestra", "Sesgo abs. media ($)",
    "Sesgo rel. media (%)", "p muestra", "Sesgo abs. prop.",
    "Sesgo rel. prop. (%)"),
  format.args = list(big.mark = ".", decimal.mark = ",")) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)

Sesgo Absoluto y Relativo de cada Estimador
Metodo	Media muestra	Sesgo abs. media ($)	Sesgo rel. media (%)	p muestra	Sesgo abs. prop.	Sesgo rel. prop. (%)
MAS	635.092,7	2.552,47	0,40	0,3866	0,0092	2,33
Sistemático	641.725,5	9.185,23	1,45	0,4074	0,0116	2,93
No Probabilístico	665.464,7	32.924,42	5,21	0,4093	0,0135	3,41
Estratificado	630.982,9	1.557,37	0,25	0,3906	0,0052	1,32
Cong. 1 etapa	641.060,4	8.520,21	1,35	0,4081	0,0123	3,11
Cong. 2 etapas	646.283,7	13.743,51	2,17	0,4156	0,0198	5,00

9.3 Verificacion de Intervalos de Confianza

Code

check_ic <- function(ic_row, param, tipo) {
  if (tipo == "media") {
    ifelse(ic_row$IC_media_inf <= param & param <= ic_row$IC_media_sup, "SI", "NO")
  } else {
    ifelse(ic_row$IC_prop_inf <= param & param <= ic_row$IC_prop_sup, "SI", "NO")
  }
}

# Construir tabla dinamicamente para N metodos
tabla_capt <- data.frame(
  Parametro = c(
    paste0("Media (mu = $", format(round(mu_real), big.mark = "."), ")"),
    paste0("Proporcion (P = ", round(P_real, 4), ")")
  )
)
for (idx in 1:nrow(tabla_ic)) {
  tabla_capt[[tabla_ic$Muestra[idx]]] <- c(
    check_ic(tabla_ic[idx,], mu_real, "media"),
    check_ic(tabla_ic[idx,], P_real, "prop")
  )
}

kable(tabla_capt,
  caption = "El IC al 95% captura el parametro real?") %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)

El IC al 95% captura el parametro real?
Parametro	MAS	Sistemático	No Probabilístico	Estratificado	Cong. 1 etapa	Cong. 2 etapas
Media (mu = $632.540)	SI	SI	SI	SI	SI	SI
Proporcion (P = 0.3958)	SI	SI	SI	SI	SI	SI

9.4 Validacion de Pruebas de Hipotesis

Code

tabla_decision <- data.frame(
  Prueba = c("H0: mu <= 500.000", "H0: P <= 0.50"),
  Verdad_Pob = c(
    ifelse(mu_real > mu_0, "H0 FALSA (mu > 500k)", "H0 VERDADERA"),
    ifelse(P_real > 0.50, "H0 FALSA (P > 0.50)", "H0 VERDADERA (P < 0.50)")
  )
)
for (idx in 1:nrow(tabla_hipotesis)) {
  tabla_decision[[tabla_hipotesis$Muestra[idx]]] <- c(
    tabla_hipotesis$Decision_media[idx],
    tabla_hipotesis$Decision_prop[idx]
  )
}

kable(tabla_decision,
  caption = "Validacion de Decisiones vs Realidad Poblacional") %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)

Validacion de Decisiones vs Realidad Poblacional
Prueba	Verdad_Pob	MAS	Sistemático	No Probabilístico	Estratificado	Cong. 1 etapa	Cong. 2 etapas
H0: mu <= 500.000	H0 FALSA (mu > 500k)	Rechazar H0	Rechazar H0	Rechazar H0	Rechazar H0	Rechazar H0	Rechazar H0
H0: P <= 0.50	H0 VERDADERA (P < 0.50)	No Rechazar H0	No Rechazar H0	No Rechazar H0	No Rechazar H0	No Rechazar H0	No Rechazar H0

9.5 Graficos de Validacion

Code

metodos_names <- tabla_ee$Muestra
colores_metodos <- c("#8F141B", "#4CAF50", "#F44336", "#9C27B0", "#FF9800", "#795548")
df_val_media <- data.frame(
  Metodo = factor(metodos_names, levels = metodos_names),
  Media = tabla_ee$Media_y,
  EE = tabla_ee$EE_media
)

p_plotly <- 
ggplot(df_val_media, aes(x = Metodo, y = Media, color = Metodo)) +
  geom_pointrange(aes(ymin = Media - 1.96 * EE, ymax = Media + 1.96 * EE),
    size = 1.2, linewidth = 1.2) +
  geom_hline(yintercept = mu_real, linetype = "dashed", color = "black", linewidth = 1) +
  geom_hline(yintercept = 500000, linetype = "dotted", color = "red", linewidth = 0.8) +
  annotate("text", x = 0.5, y = mu_real,
    label = paste0("mu real = $", format(round(mu_real), big.mark = ".")),
    hjust = 0, vjust = -1, size = 4, fontface = "bold") +
  annotate("text", x = 0.5, y = 500000, label = "Medio SMMLV",
    hjust = 0, vjust = -1, size = 3.5, color = "red") +
  scale_color_manual(values = colores_metodos) +
  scale_y_continuous(labels = label_number(big.mark = ".", prefix = "$")) +
  labs(title = "Estimaciones de la Media vs Parametro Real",
    y = "Media estimada +/- IC 95%", x = "") +
  theme_minimal(base_size = 13) +
  theme(plot.title = element_text(face = "bold"), legend.position = "none",
    axis.text.x = element_text(angle = 30, hjust = 1))
ggplotly(p_plotly) %>%
  layout(margin = list(t = 80)) %>%
  config(displaylogo = FALSE)

Code

df_val_prop <- data.frame(
  Metodo = factor(metodos_names, levels = metodos_names),
  Prop = tabla_ee$Prop_p,
  EE = tabla_ee$EE_prop
)

p_plotly <- 
ggplot(df_val_prop, aes(x = Metodo, y = Prop, color = Metodo)) +
  geom_pointrange(aes(ymin = Prop - 1.96 * EE, ymax = Prop + 1.96 * EE),
    size = 1.2, linewidth = 1.2) +
  geom_hline(yintercept = P_real, linetype = "dashed", color = "black", linewidth = 1) +
  geom_hline(yintercept = 0.50, linetype = "dotted", color = "red", linewidth = 0.8) +
  annotate("text", x = 0.5, y = P_real,
    label = paste0("P real = ", round(P_real, 4)),
    hjust = 0, vjust = -1, size = 4, fontface = "bold") +
  annotate("text", x = 0.5, y = 0.50, label = "50%",
    hjust = 0, vjust = -1, size = 3.5, color = "red") +
  scale_color_manual(values = colores_metodos) +
  scale_y_continuous(labels = scales::percent_format()) +
  labs(title = "Estimaciones de la Proporcion (>500k) vs Parametro Real",
    y = "Proporcion estimada +/- IC 95%", x = "") +
  theme_minimal(base_size = 13) +
  theme(plot.title = element_text(face = "bold"), legend.position = "none",
    axis.text.x = element_text(angle = 30, hjust = 1))
ggplotly(p_plotly) %>%
  layout(margin = list(t = 80)) %>%
  config(displaylogo = FALSE)

Code

df_dens <- bind_rows(
  datos %>% select(der_matricula) %>% mutate(Tipo = "Poblacion"),
  muestra_mas %>% select(der_matricula) %>% mutate(Tipo = "MAS"),
  muestra_sist %>% select(der_matricula) %>% mutate(Tipo = "Sistematico"),
  muestra_conv %>% select(der_matricula) %>% mutate(Tipo = "No Probabilistico"),
  muestra_estrat %>% select(der_matricula) %>% mutate(Tipo = "Estratificado"),
  muestra_cong_1e %>% select(der_matricula) %>% mutate(Tipo = "Cong. 1 etapa"),
  muestra_cong_2e %>% select(der_matricula) %>% mutate(Tipo = "Cong. 2 etapas")
)
df_dens$Tipo <- factor(df_dens$Tipo,
  levels = c("Poblacion", "MAS", "Sistematico", "No Probabilistico",
    "Estratificado", "Cong. 1 etapa", "Cong. 2 etapas"))

p_plotly <- 
ggplot(df_dens, aes(x = der_matricula, color = Tipo)) +
  geom_density(linewidth = 0.8) +
  scale_color_manual(values = c("black", colores_metodos)) +
  geom_vline(xintercept = 500000, color = "red", linetype = "dotted", linewidth = 0.7) +
  geom_vline(xintercept = mu_real, color = "#e67e22", linetype = "dashed", linewidth = 0.7) +
  scale_x_continuous(labels = label_number(big.mark = ".", scale = 1e-3, suffix = "k", prefix = "$")) +
  labs(title = "Distribucion de Matriculas: Poblacion vs Muestras (6 metodos)",
    x = "Derecho de Matricula", y = "Densidad") +
  theme_minimal(base_size = 13) +
  theme(plot.title = element_text(face = "bold"))
ggplotly(p_plotly) %>%
  layout(margin = list(t = 80)) %>%
  config(displaylogo = FALSE)

Code

p_plotly <- 
ggplot(df_dens, aes(x = der_matricula, color = Tipo)) +
  stat_ecdf(linewidth = 0.8) +
  scale_color_manual(values = c("black", colores_metodos)) +
  geom_vline(xintercept = 500000, color = "red", linetype = "dotted") +
  geom_hline(yintercept = 0.50, color = "grey50", linetype = "dashed") +
  scale_x_continuous(labels = label_number(big.mark = ".", scale = 1e-3, suffix = "k", prefix = "$")) +
  labs(title = "ECDF Comparativo: Poblacion vs Muestras",
    x = "Derecho de Matricula", y = "F(x) - Proporcion acumulada") +
  theme_minimal(base_size = 13) +
  theme(plot.title = element_text(face = "bold"))
ggplotly(p_plotly) %>%
  layout(margin = list(t = 80)) %>%
  config(displaylogo = FALSE)

9.6 Representatividad por Estrato

Code

estratos_pob <- datos %>%
  group_by(estrato_clean) %>%
  summarise(Pob_pct = round(n() / N * 100, 2))

calc_pct_estrato <- function(muestra, nombre) {
  muestra %>%
    group_by(estrato_clean) %>%
    summarise(!!nombre := round(n() / nrow(muestra) * 100, 2))
}

tabla_repres <- estratos_pob %>%
  left_join(calc_pct_estrato(muestra_mas, "MAS_pct"), by = "estrato_clean") %>%
  left_join(calc_pct_estrato(muestra_sist, "Sist_pct"), by = "estrato_clean") %>%
  left_join(calc_pct_estrato(muestra_conv, "Conv_pct"), by = "estrato_clean") %>%
  left_join(calc_pct_estrato(muestra_estrat, "Estrat_pct"), by = "estrato_clean") %>%
  left_join(calc_pct_estrato(muestra_cong_1e, "C1e_pct"), by = "estrato_clean") %>%
  left_join(calc_pct_estrato(muestra_cong_2e, "C2e_pct"), by = "estrato_clean")
tabla_repres[is.na(tabla_repres)] <- 0

kable(tabla_repres,
  caption = "Representatividad por Estrato (%)",
  col.names = c("Estrato", "Poblacion", "MAS", "Sist.", "No Prob.",
    "Estratif.", "Cong.1e", "Cong.2e")) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE) %>%
  row_spec(0, background = "#8F141B", color = "white", bold = TRUE)

Representatividad por Estrato (%)
Estrato	Poblacion	MAS	Sist.	No Prob.	Estratif.	Cong.1e	Cong.2e
1	40.62	42.44	39.55	37.66	40.68	39.67	38.92
2	53.10	50.63	53.09	55.67	53.02	52.82	53.53
3	5.25	6.17	6.44	4.66	5.29	6.27	6.17
4	1.03	0.76	0.92	2.02	1.01	1.24	1.39

Code

df_estrato_comp <- tabla_repres %>%
  pivot_longer(-estrato_clean, names_to = "Fuente", values_to = "Porcentaje") %>%
  mutate(
    Fuente = recode(Fuente,
      Pob_pct = "Poblacion", MAS_pct = "MAS",
      Sist_pct = "Sistematico", Conv_pct = "No Probabilistico",
      Estrat_pct = "Estratificado", C1e_pct = "Cong. 1 etapa",
      C2e_pct = "Cong. 2 etapas"),
    Fuente = factor(Fuente, levels = c("Poblacion", "MAS", "Sistematico",
      "No Probabilistico", "Estratificado", "Cong. 1 etapa", "Cong. 2 etapas"))
  )

p_plotly <- 
ggplot(df_estrato_comp, aes(x = factor(estrato_clean), y = Porcentaje, fill = Fuente)) +
  geom_bar(stat = "identity", position = position_dodge(width = 0.8), width = 0.7) +
  scale_fill_manual(values = c(
    "Poblacion" = "#2c3e50", "MAS" = "#8F141B",
    "Sistematico" = "#4CAF50", "No Probabilistico" = "#F44336",
    "Estratificado" = "#9C27B0", "Cong. 1 etapa" = "#FF9800",
    "Cong. 2 etapas" = "#795548")) +
  labs(title = "Distribucion por Estrato: Poblacion vs 6 Metodos de Muestreo",
    x = "Estrato Social", y = "Porcentaje (%)") +
  theme_minimal(base_size = 13) +
  theme(plot.title = element_text(face = "bold"))
ggplotly(p_plotly) %>%
  layout(margin = list(t = 80)) %>%
  config(displaylogo = FALSE)

9.7 Efecto de Diseno (DEFF)

Code

# DEFF: comparar varianza de cada metodo con la varianza del MAS
var_mas <- ee_mas$EE_media^2
deff <- data.frame(
  Metodo = tabla_ee$Muestra,
  EE_media = tabla_ee$EE_media,
  DEFF = round(tabla_ee$EE_media^2 / var_mas, 4),
  Interpretacion = ifelse(
    tabla_ee$EE_media^2 / var_mas < 1, "Mas eficiente que MAS",
    ifelse(tabla_ee$EE_media^2 / var_mas == 1, "Igual que MAS", "Menos eficiente que MAS"))
)

kable(deff,
  caption = "Efecto de Diseno (DEFF) - Comparacion con MAS",
  col.names = c("Metodo", "EE(media)", "DEFF", "Interpretacion")) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)

Efecto de Diseno (DEFF) - Comparacion con MAS
Metodo	EE(media)	DEFF	Interpretacion
MAS	15886.19	1.0000	Igual que MAS
Sistemático	16037.10	1.0191	Menos eficiente que MAS
No Probabilístico	17280.30	1.1832	Menos eficiente que MAS
Estratificado	14020.27	0.7789	Mas eficiente que MAS
Cong. 1 etapa	39408.68	6.1538	Menos eficiente que MAS
Cong. 2 etapas	17922.77	1.2728	Menos eficiente que MAS

Interpretación del DEFF

Un DEFF < 1 indica que el metodo es mas eficiente que el MAS (menor varianza). El estratificado tipicamente tiene DEFF < 1 porque controla la variabilidad entre estratos. El de conglomerados tipicamente tiene DEFF > 1 por la correlacion intra-cluster.

10 Discusion de Resultados

10.1 Hallazgos principales

Sobre la media de matricula: El promedio poblacional es $632.540, lo cual SI supera medio SMMLV ($500.000). Sin embargo, la mediana es solo $420.386, lo que indica una distribucion asimetrica positiva donde unos pocos estudiantes con matriculas altas elevan el promedio.
Sobre la proporcion que paga mas de $500.000: Solo el 39.58% de los estudiantes pagan mas de medio SMMLV. Es decir, la afirmacion de que “mas del 50% paga mas de medio salario minimo” NO es correcta segun los datos poblacionales reales. En realidad, la mayoria (60.42%) paga menos de $500.000.
Paradoja media vs proporcion: Aunque el PROMEDIO supera los $500.000, esto no significa que la MAYORIA pague mas de $500.000. Esto se explica por la asimetria de la distribucion: unos pocos estudiantes (posiblemente de estratos altos o programas como Medicina) pagan matriculas muy altas que “jalan” el promedio hacia arriba, mientras que la mayoria paga valores relativamente bajos.

10.2 Comparacion de metodos de muestreo

MAS y Sistematico: Ambos metodos probabilisticos producen estimaciones similares y cercanas a los parametros reales. Garantizan que cada unidad tiene probabilidad conocida de seleccion.
Muestreo Estratificado: Al usar el estrato social como variable de estratificacion, se controla la variabilidad dentro de cada estrato. Esto tipicamente produce un error estandar menor que el MAS (DEFF < 1), demostrando la ganancia por estratificacion.
Muestreo por Conglomerados: Al seleccionar programas completos, los estudiantes dentro de un mismo programa tienden a tener matriculas similares (correlacion intra-cluster). Esto produce un error estandar mayor que el MAS (DEFF > 1). Sin embargo, es mas practico logisticamente.
Muestreo No Probabilistico: Toma los primeros registros del marco. Si los datos estan ordenados por programa (como es el caso), este metodo introduce sesgo sistematico al sobre-representar algunos programas y excluir otros completamente.

10.3 Reflexion metodologica

Superioridad del Estratificado: Para estimar parametros globales con maxima precision, el muestreo estratificado con asignacion proporcional es el mejor metodo, ya que aprovecha la informacion de la estructura de la poblacion.
Utilidad del Conglomerados: Aunque menos preciso, el muestreo por conglomerados es mas economico en la practica real, porque solo se necesita acceder a los programas seleccionados, no a toda la universidad.
Relevancia del CV: El alto coeficiente de variacion (72.04%) indica gran heterogeneidad en los valores de matricula, lo que justifica el uso de metodos que controlen esta variabilidad (como el estratificado).

11 Conclusiones y Recomendaciones

Promedio estimado de matricula (MAS): $635.093. IC 95%: [$603.956 ; $666.230]
Proporcion que paga mas de medio SMMLV (MAS): 38.66%. IC 95%: [35.37% ; 41.95%]
La matricula promedio SI supera los $500.000. La prueba (Zc = 8.5038 > 1.645) muestra evidencia significativa.
NO es cierto que mas del 50% pague mas de medio SMMLV. La prueba NO rechaza H0 (Zc = -6.3908 < 1.645). Solo ~40% paga mas de $500.000.
Metodo mas eficiente: El muestreo estratificado por estrato social demostro ser el mas eficiente (menor EE) para estimar tanto la media como la proporcion.
Metodo mas practico: El muestreo por conglomerados (por programa) es el mas practico logisticamente, aunque sacrifica precision.
Recomendaciones para la administracion:
- La percepcion de “matricula costosa” se sustenta parcialmente: el promedio supera medio SMMLV, pero la mayoria de estudiantes paga menos de $500.000
- La distribucion es altamente asimetrica: unos pocos pagan mucho y muchos pagan poco
- Se recomienda revisar el Acuerdo 050 de 2015 considerando esta asimetria
- Para futuros estudios, utilizar muestreo estratificado por estrato social para mayor precision

1 Planteamiento del Problema

1.1 Objetivos

1.1.1 Objetivo General

1.1.2 Objetivos Específicos

2 Limpieza y Preparación del Marco Muestral

3 Análisis Exploratorio de la Población

4 Cálculo del Tamaño de Muestra \(n\)

5 Selección de las Muestras (Cinco Métodos)

5.1 Muestreo Aleatorio Simple (MAS)

5.2 Muestreo Sistemático

5.3 Muestreo No Probabilístico por Conveniencia

5.4 Muestreo Aleatorio Estratificado

5.5 Muestreo por Conglomerados

5.5.1 Versión A — Una Etapa (censo dentro de cada cluster)

5.5.2 Versión B — Dos Etapas (sub-muestreo proporcional dentro de cada cluster)

6 Estimación Puntual y Error Estándar

7 Intervalos de Confianza al 95%

8 Pruebas de Hipótesis

8.1 Planteamiento

8.2 Campana de Gauss - Prueba para la Media

8.3 Campana de Gauss - Prueba para la Proporción

8.4 Detalle de la prueba para la media (MAS)

8.5 Detalle de la prueba para la proporcion (MAS)

9 Validacion, Analisis Comparativo y Comparacion con la Poblacion

9.1 Tabla Maestra de Comparacion

9.2 Sesgo de cada Estimador

9.3 Verificacion de Intervalos de Confianza

9.4 Validacion de Pruebas de Hipotesis

9.5 Graficos de Validacion

9.6 Representatividad por Estrato

9.7 Efecto de Diseno (DEFF)

10 Discusion de Resultados

10.1 Hallazgos principales

10.2 Comparacion de metodos de muestreo

10.3 Reflexion metodologica

11 Conclusiones y Recomendaciones