1 Planteamiento del Problema

Los estudiantes de la Universidad afirman que el valor de la matrícula en la Universidad Surcolombiana en pregrado (Acuerdo 050 de 2015) es muy costosa, pues las variables consideradas no son confiables en el momento de captura de la información (valor pensión mensual pagado en el último grado de educación media, estrato socioeconómico del lugar de domicilio de quien dependen económicamente y valor de los ingresos mensuales de quien depende económicamente el estudiante).

La administración quiere que, como Especialistas en Estadística, se realice un estudio aplicando un diseño muestral probabilístico para identificar si efectivamente la percepción de los estudiantes es real, calculando el promedio de matrícula que pagan los estudiantes y el porcentaje de estudiantes que pagan menos de medio salario mínimo.

1.1 Objetivos

1.1.1 Objetivo General

Determinar, mediante un diseño muestral probabilístico, si la percepción de los estudiantes sobre el alto costo de la matrícula en la Universidad Surcolombiana es estadísticamente sustentable.

1.1.2 Objetivos Específicos

Estimar el promedio de matrícula (Der_Matricula) con su respectivo intervalo de confianza al 95% y prueba de hipótesis.
Estimar la proporción de estudiantes que pagan menos de medio SMMLV ($500.000) con su intervalo de confianza al 95% y prueba de hipótesis.
Comparar los resultados del muestreo aleatorio simple, sistemático y no probabilístico para evaluar el efecto del método de selección.
Validar las estimaciones muestrales contra los parámetros reales de la población total del programa (N=244). —

2 Limpieza y Preparación del Marco Muestral

datos <- read.csv("C:/Users/USER/Documents/R studio/Base de datos estudiantes.csv",
  header = TRUE, sep = ",", fileEncoding = "latin1"
)
datos <- clean_names(datos)
N <- nrow(datos)
datos$id <- 1:N
mat <- datos$der_matricula
media_pob <- mean(mat)

# Proporción poblacional (cálculo para uso posterior)
n_exitos_pob <- sum(mat < 500000)
P_pob <- n_exitos_pob / N
Q_pob <- 1 - P_pob

kable(head(datos, 10),
  caption = "Primeras 10 filas del marco muestral",
  format.args = list(big.mark = ".", decimal.mark = ",")
) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)

Primeras 10 filas del marco muestral
programas	estrato_social	declara_renta	der_matricula	id
NEIVA - MATEMATICA APLICADA	2	9.937.392	418.691	1
NEIVA - MATEMATICA APLICADA	2	7.200.000	407.631	2
NEIVA - MATEMATICA APLICADA	1	7.200.000	313.233	3
NEIVA - MATEMATICA APLICADA	2	46.219.672	1.060.241	4
NEIVA - MATEMATICA APLICADA	1	4.800.000	286.473	5
NEIVA - MATEMATICA APLICADA	1	10.800.000	413.747	6
NEIVA - MATEMATICA APLICADA	2	28.831.347	908.098	7
NEIVA - MATEMATICA APLICADA	2	50.035.666	1.366.038	8
NEIVA - MATEMATICA APLICADA	1	10.196.000	386.679	9
NEIVA - MATEMATICA APLICADA	3	56.000.000	1.398.090	10

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

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

Z <- 1.96
S2_piloto <- var(mat)
S_piloto <- sd(mat)
P_piloto <- P_pob
Q_piloto <- 1 - P_piloto
e_media <- 0.05 * media_pob
e_prop <- 0.05

n_media <- ceiling((N * Z^2 * S2_piloto) / ((N - 1) * e_media^2 + Z^2 * S2_piloto))

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

no <- Z^2 / (4 * e_prop^2)
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)"
  ),
  Valor = c(n_media, n_prop, n_media_aj, n_prop_aj)
)
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)	160
n para la proporción (sin ajuste)	141
n media ajustado (5% NR)	169
n proporción ajustado (5% NR)	149

Justificación: Se selecciona n_final = 169 como el mayor entre los tamaños ajustados, para garantizar la precisión requerida tanto en la estimación de la media como de la proporción.

4 Selección de las Muestras (Tres Tipos)

4.1 Muestreo Aleatorio Simple (MAS)

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

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

Primeras 10 filas - Muestra MAS
	programas	estrato_social	declara_renta	der_matricula	id
1	NEIVA - MATEMATICA APLICADA	2	9937392	418691	1
3	NEIVA - MATEMATICA APLICADA	1	7200000	313233	3
4	NEIVA - MATEMATICA APLICADA	2	46219672	1060241	4
5	NEIVA - MATEMATICA APLICADA	1	4800000	286473	5
6	NEIVA - MATEMATICA APLICADA	1	10800000	413747	6
7	NEIVA - MATEMATICA APLICADA	2	28831347	908098	7
11	NEIVA - MATEMATICA APLICADA	1	16980000	413747	11
12	NEIVA - MATEMATICA APLICADA	2	8273448	374488	12
13	NEIVA - MATEMATICA APLICADA	1	3500000	377873	13
14	NEIVA - MATEMATICA APLICADA	1	8000000	303520	14

muestra_mas %>%
  group_by(estrato_social) %>%
  summarise(n = n(), Porcentaje = round(n() / nrow(muestra_mas) * 100, 2)) %>%
  kable(caption = "Distribución por estrato - Muestra MAS") %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)

Distribución por estrato - Muestra MAS
estrato_social	n	Porcentaje
1	84	49.70
2	82	48.52
3	2	1.18
4	1	0.59

4.2 Muestreo Sistemático

k <- N / n_final # paso sin redondear
cat("Paso sistemático k =", round(k, 4), "\n")

## Paso sistemático k = 1.4438

set.seed(2022)
r <- runif(1, min = 1, max = k)
ids_sist <- unique(round(r + k * (0:(n_final - 1))))
ids_sist <- ids_sist[ids_sist >= 1 & ids_sist <= N]
ids_sist <- ids_sist[1:min(n_final, length(ids_sist))]
muestra_sist <- datos[datos$id %in% ids_sist, ]

kable(head(muestra_sist, 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
	programas	estrato_social	declara_renta	der_matricula	id
1	NEIVA - MATEMATICA APLICADA	2	9937392	418691	1
3	NEIVA - MATEMATICA APLICADA	1	7200000	313233	3
4	NEIVA - MATEMATICA APLICADA	2	46219672	1060241	4
6	NEIVA - MATEMATICA APLICADA	1	10800000	413747	6
7	NEIVA - MATEMATICA APLICADA	2	28831347	908098	7
9	NEIVA - MATEMATICA APLICADA	1	10196000	386679	9
10	NEIVA - MATEMATICA APLICADA	3	56000000	1398090	10
11	NEIVA - MATEMATICA APLICADA	1	16980000	413747	11
13	NEIVA - MATEMATICA APLICADA	1	3500000	377873	13
14	NEIVA - MATEMATICA APLICADA	1	8000000	303520	14

muestra_sist %>%
  group_by(estrato_social) %>%
  summarise(n = n(), Porcentaje = round(n() / nrow(muestra_sist) * 100, 2)) %>%
  kable(caption = "Distribución por estrato - Muestra Sistemática") %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)

Distribución por estrato - Muestra Sistemática
estrato_social	n	Porcentaje
1	90	53.25
2	75	44.38
3	3	1.78
4	1	0.59

4.3 Muestreo No Probabilístico por Conveniencia

muestra_conv <- datos[1:n_final, ]

kable(head(muestra_conv, 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
programas	estrato_social	declara_renta	der_matricula	id
NEIVA - MATEMATICA APLICADA	2	9937392	418691	1
NEIVA - MATEMATICA APLICADA	2	7200000	407631	2
NEIVA - MATEMATICA APLICADA	1	7200000	313233	3
NEIVA - MATEMATICA APLICADA	2	46219672	1060241	4
NEIVA - MATEMATICA APLICADA	1	4800000	286473	5
NEIVA - MATEMATICA APLICADA	1	10800000	413747	6
NEIVA - MATEMATICA APLICADA	2	28831347	908098	7
NEIVA - MATEMATICA APLICADA	2	50035666	1366038	8
NEIVA - MATEMATICA APLICADA	1	10196000	386679	9
NEIVA - MATEMATICA APLICADA	3	56000000	1398090	10

muestra_conv %>%
  group_by(estrato_social) %>%
  summarise(n = n(), Porcentaje = round(n() / nrow(muestra_conv) * 100, 2)) %>%
  kable(caption = "Distribución por estrato - Muestra por Conveniencia") %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)

Distribución por estrato - Muestra por Conveniencia
estrato_social	n	Porcentaje
1	83	49.11
2	81	47.93
3	4	2.37
4	1	0.59

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

5 Estimación Puntual y Error Estándar

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")
tabla_ee <- bind_rows(ee_mas, ee_sist, ee_conv)

kable(tabla_ee, caption = "Estimación Puntual y Error Estándar (Población Finita N=244)") %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)

Estimación Puntual y Error Estándar (Población Finita N=244)
Muestra	n	Media_y	EE_media	Prop_p	EE_prop
MAS	169	497546.5	10858.38	0.7041	0.0195
Sistemático	169	508262.9	11487.54	0.6746	0.0200
No Probabilístico	169	518781.5	11622.22	0.6391	0.0205

Comentario: El método con menor error estándar indica mayor precisión en la estimación. Los métodos probabilísticos (MAS y Sistemático) proveen estimaciones confiables respaldadas por la teoría de muestreo.

6 Intervalos de Confianza al 95%

Z_ic <- 1.96

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

ic_mas <- calc_ic(ee_mas)
ic_sist <- calc_ic(ee_sist)
ic_conv <- calc_ic(ee_conv)
tabla_ic <- bind_rows(ic_mas, ic_sist, ic_conv)

kable(tabla_ic,
  caption = "Intervalos de Confianza al 95%",
  format.args = list(big.mark = ".", decimal.mark = ",")
) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)

Intervalos de Confianza al 95%
Muestra	IC_media_inf	IC_media_sup	Amplitud_media	IC_prop_inf	IC_prop_sup	Amplitud_prop
MAS	476.264,1	518.828,9	42.564,85	0,6659	0,7423	0,0764
Sistemático	485.747,3	530.778,5	45.031,16	0,6354	0,7138	0,0784
No Probabilístico	496.002,0	541.561,1	45.559,10	0,5989	0,6793	0,0804

Con 95% de confianza, el promedio de matrícula de los estudiantes de Matemática Aplicada se encuentra entre $476.264 y $518.829.

Para la proporción, entre el 66.59% y el 74.23% de estudiantes pagan menos de medio SMMLV ($500.000) en matrícula.

7 Pruebas de Hipótesis

7.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$ (unilateral derecha)
Nivel de significancia: $\alpha = 0.05$, $Z_{tabla} = 1.645$

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

# Función para pruebas de hipótesis de media y proporción
prueba_hipotesis <- function(ee_row, mu_0, P_0 = 0.50) {
  # Prueba media
  Zc_media <- (ee_row$Media_y - mu_0) / ee_row$EE_media
  pval_media <- 1 - pnorm(Zc_media)
  # Prueba proporción
  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 H₀", "No Rechazar H₀"),
    Zc_prop = round(Zc_prop, 4),
    pval_prop = round(pval_prop, 6),
    Decision_prop = ifelse(Zc_prop > Z_tabla, "Rechazar H₀", "No Rechazar H₀")
  )
}

ph_mas <- prueba_hipotesis(ee_mas, mu_0)
ph_sist <- prueba_hipotesis(ee_sist, mu_0)
ph_conv <- prueba_hipotesis(ee_conv, mu_0)

tabla_hipotesis <- bind_rows(ph_mas, ph_sist, ph_conv)
kable(tabla_hipotesis,
  caption = "Pruebas de Hipótesis: Media (H₁: μ > 500.000) y Proporción (H₁: P > 0.50)",
  col.names = c(
    "Método", "Zc media", "p-valor media", "Decisión media",
    "Zc prop.", "p-valor prop.", "Decisión prop."
  )
) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)

Pruebas de Hipótesis: Media (H₁: μ > 500.000) y Proporción (H₁: P > 0.50)
Método	Zc media	p-valor media	Decisión media	Zc prop.	p-valor prop.	Decisión prop.
MAS	-0.2260	0.589381	No Rechazar H₀	5.3066	0.000000	Rechazar H₀
Sistemático	0.7193	0.235980	No Rechazar H₀	4.5396	0.000003	Rechazar H₀
No Probabilístico	1.6160	0.053047	No Rechazar H₀	3.6166	0.000149	Rechazar H₀

7.2 Campana de Gauss - Prueba para la Media

df_gauss <- data.frame(
  Metodo = c("MAS", "Sistemático", "No Probabilístico"),
  Zc = c(ph_mas$Zc_media, ph_sist$Zc_media, ph_conv$Zc_media),
  Decision = c(ph_mas$Decision_media, ph_sist$Decision_media, ph_conv$Decision_media)
)
df_gauss$Metodo <- factor(df_gauss$Metodo, levels = c("MAS", "Sistemático", "No Probabilístico"))

x_vals <- seq(-4, 4, 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

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 = "#2196F3", linewidth = 1.2
  ) +
  geom_text(
    data = df_gauss,
    aes(x = Zc, y = 0.42, label = paste0("Zc = ", round(Zc, 2))),
    color = "#2196F3", hjust = -0.1, size = 4, fontface = "bold"
  ) +
  annotate("text",
    x = Z_tabla, y = 0.44,
    label = paste0("Z tabla = ", Z_tabla),
    color = "red", hjust = -0.1, size = 3.5
  ) +
  facet_wrap(~Metodo, ncol = 1) +
  labs(
    title = "Campana de Gauss - Prueba Unilateral Derecha para la Media",
    subtitle = paste0("H₀: μ ≤ $500.000 vs H₁: μ > $500.000 | α = 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 = 12)
  )

7.3 Detalle de la prueba para la media (MAS)

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

$\bar{y}$ = $497.547
$ee(\bar{y})$ = $10.858.38
$Z_c$ = -0.226
Zona de rechazo: $Z_c > 1.645$
Decisión: No Rechazar H₀
p-valor: 0.589381

7.4 Detalle de la prueba para la proporción (MAS)

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

$p$ = 0.7041, $P_0$ = 0.50, $n$ = 169
$Z_c$ = 5.3066
Decisión: Rechazar H₀
p-valor: 0

Comentario: Ambos métodos probabilísticos (MAS y Sistemático) deberían llevar a conclusiones similares, ya que ambos son muestras representativas de la población.

8 Validación, Análisis Comparativo y Comparación con la Población Total

Nota: Este paso es posible porque se tiene acceso a toda la población ($N = 244$). En la práctica esto no siempre ocurre, pero cuando se dispone del marco completo es una herramienta de validación muy valiosa. ## Tabla de comparación

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)), Varianza = round(var(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_p = round(sum(x < 500000) / length(x), 4),
    Prop_q = round(1 - sum(x < 500000) / length(x), 4)
  )
}

tabla_maestra <- bind_rows(
  calc_stats(datos$der_matricula, "Población"),
  calc_stats(muestra_mas$der_matricula, "MAS"),
  calc_stats(muestra_sist$der_matricula, "Sistemático"),
  calc_stats(muestra_conv$der_matricula, "No Probabilístico")
)

kable(t(tabla_maestra),
  caption = "Tabla Maestra - Comparación Población vs Muestras"
) %>%
  kable_styling(
    bootstrap_options = c("striped", "hover", "bordered", "condensed"),
    full_width = FALSE, font_size = 12
  )

Tabla Maestra - Comparación Población vs Muestras
	25%…1	25%…2	25%…3	25%…4
Muestra	Población	MAS	Sistemático	No Probabilístico
n	244	169	169	169
Media	511923	497547	508263	518782
Mediana	403441	402407	407631	407631
Desv_Estandar	278760	254608	269361	272519
Varianza	77707345416	64825396940	72555327286	74266553475
Minimo	283220	283220	283220	283220
Q1	374488	374488	375808	374488
Q3	522055	516688	522055	595357
Maximo	1959850	1761872	1959850	1959850
CV	54.45	51.17	53.00	52.53
Prop_p	0.6844	0.7041	0.6746	0.6391
Prop_q	0.3156	0.2959	0.3254	0.3609

8.1 Sesgo de cada estimador

sesgo_media <- data.frame(
  Metodo = c("MAS", "Sistemático", "No Probabilístico"),
  Media_muestra = c(ee_mas$Media_y, ee_sist$Media_y, ee_conv$Media_y),
  Sesgo_abs_media = round(abs(c(ee_mas$Media_y, ee_sist$Media_y, ee_conv$Media_y) - mu_real), 2),
  Sesgo_rel_media = round(abs(c(ee_mas$Media_y, ee_sist$Media_y, ee_conv$Media_y) - mu_real)
  / mu_real * 100, 2),
  Prop_muestra = c(ee_mas$Prop_p, ee_sist$Prop_p, ee_conv$Prop_p),
  Sesgo_abs_prop = round(abs(c(ee_mas$Prop_p, ee_sist$Prop_p, ee_conv$Prop_p) - P_real), 4),
  Sesgo_rel_prop = round(abs(c(ee_mas$Prop_p, ee_sist$Prop_p, ee_conv$Prop_p) - P_real)
  / P_real * 100, 2)
)

kable(sesgo_media,
  caption = "Sesgo Absoluto y Relativo de cada Estimador",
  col.names = c(
    "Método", "ȳ 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
Método	ȳ muestra	Sesgo abs. media ($)	Sesgo rel. media (%)	p muestra	Sesgo abs. prop.	Sesgo rel. prop. (%)
MAS	497.546,5	14.376,78	2,81	0,7041	0,0197	2,87
Sistemático	508.262,9	3.660,36	0,72	0,6746	0,0098	1,44
No Probabilístico	518.781,5	6.858,24	1,34	0,6391	0,0453	6,62

8.2 Verificación de Intervalos de Confianza

capt_media_mas <- ifelse(ic_mas$IC_media_inf <= mu_real & mu_real <= ic_mas$IC_media_sup, "✓", "✗")
capt_media_sist <- ifelse(ic_sist$IC_media_inf <= mu_real & mu_real <= ic_sist$IC_media_sup, "✓", "✗")
capt_media_conv <- ifelse(ic_conv$IC_media_inf <= mu_real & mu_real <= ic_conv$IC_media_sup, "✓", "✗")

capt_prop_mas <- ifelse(ic_mas$IC_prop_inf <= P_real & P_real <= ic_mas$IC_prop_sup, "✓", "✗")
capt_prop_sist <- ifelse(ic_sist$IC_prop_inf <= P_real & P_real <= ic_sist$IC_prop_sup, "✓", "✗")
capt_prop_conv <- ifelse(ic_conv$IC_prop_inf <= P_real & P_real <= ic_conv$IC_prop_sup, "✓", "✗")

tabla_capt <- data.frame(
  Parametro = c(
    paste0("Media (μ = $", format(round(mu_real), big.mark = "."), ")"),
    paste0("Proporción (P = ", round(P_real, 4), ")")
  ),
  MAS = c(capt_media_mas, capt_prop_mas),
  Sistematico = c(capt_media_sist, capt_prop_sist),
  No_Probabilistico = c(capt_media_conv, capt_prop_conv)
)

kable(tabla_capt,
  caption = "¿El IC al 95% captura el parámetro real?",
  col.names = c("Parámetro", "MAS", "Sistemático", "No Probabilístico")
) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)

¿El IC al 95% captura el parámetro real?
Parámetro	MAS	Sistemático	No Probabilístico
Media (μ = $511.923)	✓	✓	✓
Proporción (P = 0.6844)	✓	✓	✗

8.3 Validación de Pruebas de Hipótesis

tabla_decision <- data.frame(
  Prueba = c("H₀: μ ≤ 500.000", "H₀: P ≤ 0.50"),
  Verdad_Pob = c(
    ifelse(mu_real > mu_0, "H₀ FALSA", "H₀ VERDADERA"),
    ifelse(P_real > 0.50, "H₀ FALSA", "H₀ VERDADERA")
  ),
  MAS = c(
    ifelse(ph_mas$Zc_media > Z_tabla, "Rechazar H₀ ✓", "No rechazar (Error II)"),
    ifelse(ph_mas$Zc_prop > Z_tabla, "Rechazar H₀ ✓", "No rechazar (Error II)")
  ),
  Sistematico = c(
    ifelse(ph_sist$Zc_media > Z_tabla, "Rechazar H₀ ✓", "No rechazar (Error II)"),
    ifelse(ph_sist$Zc_prop > Z_tabla, "Rechazar H₀ ✓", "No rechazar (Error II)")
  ),
  No_Prob = c(
    ifelse(ph_conv$Zc_media > Z_tabla, "Rechazar H₀ ✓", "No rechazar (Error II)"),
    ifelse(ph_conv$Zc_prop > Z_tabla, "Rechazar H₀ ✓", "No rechazar (Error II)")
  )
)

kable(tabla_decision,
  caption = "Validación de Decisiones en Pruebas de Hipótesis",
  col.names = c("Prueba", "Verdad Poblacional", "MAS", "Sistemático", "No Probabilístico")
) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)

Validación de Decisiones en Pruebas de Hipótesis
Prueba	Verdad Poblacional	MAS	Sistemático	No Probabilístico
H₀: μ ≤ 500.000	H₀ FALSA	No rechazar (Error II)	No rechazar (Error II)	No rechazar (Error II)
H₀: P ≤ 0.50	H₀ FALSA	Rechazar H₀ ✓	Rechazar H₀ ✓	Rechazar H₀ ✓

8.4 Representatividad por estrato

estratos_pob <- datos %>%
  group_by(estrato_social) %>%
  summarise(Pob_pct = round(n() / N * 100, 2))
estratos_mas <- muestra_mas %>%
  group_by(estrato_social) %>%
  summarise(MAS_pct = round(n() / nrow(muestra_mas) * 100, 2))
estratos_sist <- muestra_sist %>%
  group_by(estrato_social) %>%
  summarise(Sist_pct = round(n() / nrow(muestra_sist) * 100, 2))
estratos_conv <- muestra_conv %>%
  group_by(estrato_social) %>%
  summarise(Conv_pct = round(n() / nrow(muestra_conv) * 100, 2))

tabla_repres <- estratos_pob %>%
  left_join(estratos_mas, by = "estrato_social") %>%
  left_join(estratos_sist, by = "estrato_social") %>%
  left_join(estratos_conv, by = "estrato_social")
tabla_repres[is.na(tabla_repres)] <- 0

tabla_repres <- tabla_repres %>%
  mutate(
    IR_MAS = round(abs(MAS_pct - Pob_pct) / Pob_pct * 100, 2),
    IR_Sist = round(abs(Sist_pct - Pob_pct) / Pob_pct * 100, 2),
    IR_Conv = round(abs(Conv_pct - Pob_pct) / Pob_pct * 100, 2)
  )

kable(tabla_repres,
  caption = "Representatividad por Estrato + Índice de Representatividad (IR)",
  col.names = c(
    "Estrato", "Pob. Real (%)", "MAS (%)", "Sistemático (%)",
    "No Prob. (%)", "IR MAS", "IR Sist.", "IR Conv."
  )
) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)

Representatividad por Estrato + Índice de Representatividad (IR)
Estrato	Pob. Real (%)	MAS (%)	Sistemático (%)	No Prob. (%)	IR MAS	IR Sist.	IR Conv.
1	52.05	49.70	53.25	49.11	4.51	2.31	5.65
2	45.90	48.52	44.38	47.93	5.71	3.31	4.42
3	1.64	1.18	1.78	2.37	28.05	8.54	44.51
4	0.41	0.59	0.59	0.59	43.90	43.90	43.90

df_estrato_comp <- tabla_repres %>%
  select(estrato_social, Pob_pct, MAS_pct, Sist_pct, Conv_pct) %>%
  pivot_longer(-estrato_social, names_to = "Fuente", values_to = "Porcentaje") %>%
  mutate(
    Fuente = recode(Fuente,
      Pob_pct = "Población", MAS_pct = "MAS",
      Sist_pct = "Sistemático", Conv_pct = "No Probabilístico"
    ),
    Fuente = factor(Fuente, levels = c("Población", "MAS", "Sistemático", "No Probabilístico"))
  )

ggplot(df_estrato_comp, aes(x = factor(estrato_social), y = Porcentaje, fill = Fuente)) +
  geom_bar(stat = "identity", position = position_dodge(width = 0.8), width = 0.7) +
  scale_fill_manual(values = c(
    "Población" = "#2c3e50", "MAS" = "#2196F3",
    "Sistemático" = "#4CAF50", "No Probabilístico" = "#F44336"
  )) +
  labs(
    title = "Distribución por Estrato: Población vs Muestras",
    x = "Estrato Social", y = "Porcentaje (%)"
  ) +
  theme_minimal(base_size = 13) +
  theme(plot.title = element_text(face = "bold"))

8.5 Gráficos de validación

df_val_media <- data.frame(
  Metodo = factor(c("MAS", "Sistemático", "No Probabilístico"),
    levels = c("MAS", "Sistemático", "No Probabilístico")
  ),
  Media = c(ee_mas$Media_y, ee_sist$Media_y, ee_conv$Media_y),
  EE = c(ee_mas$EE_media, ee_sist$EE_media, ee_conv$EE_media)
)

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) +
  annotate("text",
    x = 0.5, y = mu_real,
    label = paste0("μ real = $", format(round(mu_real), big.mark = ".")),
    hjust = 0, vjust = -1, size = 4, fontface = "bold"
  ) +
  scale_color_manual(values = c("#2196F3", "#4CAF50", "#F44336")) +
  scale_y_continuous(labels = label_number(big.mark = ".", prefix = "$")) +
  labs(
    title = "Estimaciones de la Media vs Parámetro Real",
    y = "Media estimada ± IC 95%", x = ""
  ) +
  theme_minimal(base_size = 13) +
  theme(plot.title = element_text(face = "bold"), legend.position = "none")

df_val_prop <- data.frame(
  Metodo = factor(c("MAS", "Sistemático", "No Probabilístico"),
    levels = c("MAS", "Sistemático", "No Probabilístico")
  ),
  Prop = c(ee_mas$Prop_p, ee_sist$Prop_p, ee_conv$Prop_p),
  EE = c(ee_mas$EE_prop, ee_sist$EE_prop, ee_conv$EE_prop)
)

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) +
  annotate("text",
    x = 0.5, y = P_real,
    label = paste0("P real = ", round(P_real, 4)),
    hjust = 0, vjust = -1, size = 4, fontface = "bold"
  ) +
  scale_color_manual(values = c("#2196F3", "#4CAF50", "#F44336")) +
  scale_y_continuous(labels = scales::percent_format()) +
  labs(
    title = "Estimaciones de la Proporción vs Parámetro Real",
    y = "Proporción estimada ± IC 95%", x = ""
  ) +
  theme_minimal(base_size = 13) +
  theme(plot.title = element_text(face = "bold"), legend.position = "none")

df_dens <- bind_rows(
  datos %>% select(der_matricula) %>% mutate(Tipo = "Población"),
  muestra_mas %>% select(der_matricula) %>% mutate(Tipo = "MAS"),
  muestra_sist %>% select(der_matricula) %>% mutate(Tipo = "Sistemático"),
  muestra_conv %>% select(der_matricula) %>% mutate(Tipo = "No Probabilístico")
)
df_dens$Tipo <- factor(df_dens$Tipo, levels = c("Población", "MAS", "Sistemático", "No Probabilístico"))

ggplot(df_dens, aes(x = der_matricula, color = Tipo, linetype = Tipo, linewidth = Tipo)) +
  geom_density() +
  scale_color_manual(values = c("black", "#2196F3", "#4CAF50", "#F44336")) +
  scale_linetype_manual(values = c("solid", "solid", "solid", "dashed")) +
  scale_linewidth_manual(values = c(1.5, 0.8, 0.8, 0.8)) +
  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 = "Distribución de Matrículas: Población vs Muestras",
    x = "Derecho de Matrícula", y = "Densidad"
  ) +
  theme_minimal(base_size = 13) +
  theme(plot.title = element_text(face = "bold"))

ggplot(df_dens, aes(x = der_matricula, color = Tipo)) +
  stat_ecdf(linewidth = 0.8) +
  scale_color_manual(values = c("black", "#2196F3", "#4CAF50", "#F44336")) +
  geom_vline(xintercept = 500000, color = "red", linetype = "dotted") +
  scale_x_continuous(labels = label_number(big.mark = ".", scale = 1e-3, suffix = "k", prefix = "$")) +
  labs(
    title = "ECDF Comparativo: Población vs Muestras",
    x = "Derecho de Matrícula", y = "F(x) - Proporción acumulada"
  ) +
  theme_minimal(base_size = 13) +
  theme(plot.title = element_text(face = "bold"))

8.6 Discusión de efectos

Sesgo del muestreo no probabilístico: La muestra por conveniencia toma los primeros registros del marco, lo cual puede introducir sesgo si los datos están ordenados de alguna manera particular.
Comparación MAS vs Sistemático: Ambos métodos probabilísticos producen estimaciones similares porque garantizan que cada unidad tiene probabilidad conocida de selección.
Recomendación: Para este contexto se recomienda el MAS o el Sistemático, ya que permiten calcular errores estándar válidos y construir IC confiables.
Limitaciones del muestreo no probabilístico:
- No se puede cuantificar la incertidumbre de forma rigurosa
- Los IC calculados no tienen validez teórica
- Las pruebas de hipótesis carecen de respaldo probabilístico

8.7 Reflexión metodológica final

Superioridad del MAS y Sistemático: Los métodos probabilísticos garantizan que cada unidad tiene probabilidad conocida y no nula de selección. Los sesgos del MAS y Sistemático son menores y sus IC capturan los parámetros reales.
Ventaja del Sistemático: Cuando la base está ordenada secuencialmente, el Sistemático distribuye la muestra uniformemente, captando mejor la variabilidad.
Relevancia del CV: Un coeficiente de variación alto indica heterogeneidad en los valores de matrícula, justificando el uso de muestreo probabilístico.
Implicación para la administración: Con los resultados muestrales se puede afirmar con 95% de confianza que la mayoría paga menos de medio SMMLV. El Acuerdo 050 de 2015 genera matrículas que se concentran en valores relativamente bajos para la mayoría, con una minoría que paga montos significativamente mayores.

9 Conclusiones

Estimación del promedio de matrícula Los tres métodos de muestreo estimaron promedios de matrícula cercanos entre sí: el MAS obtuvo $497.547, el Sistemático $508.263 y el No Probabilístico $518.782, todos con intervalos de confianza al 95% que lograron capturar el valor real poblacional de $511.923. Sin embargo, al realizar la prueba de hipótesis para determinar si el promedio supera los $500.000, ninguno de los tres métodos rechazó la hipótesis nula, incurriendo en un Error Tipo II. Esto no significa que la matrícula promedio sea baja, sino que la diferencia entre el valor de referencia y el parámetro real es tan pequeña que el tamaño de muestra utilizado no tuvo suficiente potencia estadística para detectarla.
Proporción de estudiantes que pagan menos de medio SMMLV Proporción de estudiantes que pagan menos de medio SMMLV En este objetivo los resultados son contundentes. Los tres métodos coincidieron en que más del 60% de los estudiantes paga una matrícula inferior a $500.000, siendo el MAS el que estimó la proporción más cercana al valor real con un 70.41%, frente al 67.46% del Sistemático y el 63.91% del No Probabilístico. La prueba de hipótesis rechazó con solidez la hipótesis de que esta proporción es menor o igual al 50% en los tres casos, con valores Zc muy superiores al valor crítico. Esto respalda estadísticamente la percepción estudiantil: aproximadamente siete de cada diez estudiantes del programa pagan una matrícula por debajo de medio salario mínimo, lo que sugiere que las variables contempladas en el Acuerdo 050 de 2015 no están capturando de manera confiable la realidad socioeconómica de los estudiantes.
Comparación entre métodos de muestreo Comparación entre métodos de muestreo Al comparar los tres métodos, el Sistemático demostró ser el más representativo de la población, con los menores sesgos relativos tanto en media como en proporción y los mejores índices de representatividad por estrato en los grupos mayoritarios. El MAS, por su parte, ofreció el menor error estándar y produjo intervalos de confianza que capturaron ambos parámetros reales, siendo una alternativa igualmente confiable. El método No Probabilístico por conveniencia, en cambio, presentó el mayor sesgo en la estimación de la proporción y fue el único cuyo intervalo de confianza no logró capturar el valor real poblacional de dicha proporción, lo que evidencia que sus conclusiones carecen de respaldo estadístico formal y no deben utilizarse para tomar decisiones administrativas.
Validación contra los parámetros reales de la población Validación contra los parámetros reales de la población La comparación directa con los parámetros reales de los 244 estudiantes confirmó que el Sistemático fue el método más preciso en ambos estimadores, seguido del MAS, mientras que el No Probabilístico mostró el mayor alejamiento de los valores poblacionales reales. Esta validación también permitió identificar que la prueba de hipótesis para la media requiere ajustes en futuros estudios, bien sea aumentando el tamaño de muestra o revisando el valor de referencia, para evitar el Error Tipo II observado. En conjunto, los resultados demuestran que el diseño muestral probabilístico aplicado en este taller es estadísticamente sólido y que la evidencia obtenida es suficiente para afirmar, con un nivel de confianza del 95%, que la gran mayoría de los estudiantes de Matemática Aplicada paga matrículas que no corresponden a los valores que cabría esperar si las variables del Acuerdo 050 reflejaran fielmente su capacidad de pago real.

10 Recomendaciones

Revisar el Acuerdo 050 de 2015 Dado que la distribución de matrículas es asimétrica y la mayoría de estudiantes paga montos bajos, se recomienda revisar las variables consideradas (pensión, estrato, ingresos), pues la evidencia sugiere que no capturan de manera confiable la realidad socioeconómica.
Considerar la heterogeneidad por estrato El estrato 3 representa apenas el 1.64% de la población estudiantil, pero presenta los mayores errores de representación en todos los métodos. Se recomienda aplicar muestreo estratificado proporcional en futuros estudios para mejorar la precisión en estratos minoritarios.
Adoptar muestreo probabilístico institucional La administración debería estandarizar el uso de muestreo sistemático o aleatorio simple en sus estudios internos, descartando el muestreo por conveniencia dado su alto sesgo demostrado.
Aumentar el tamaño de muestra para pruebas de media Para detectar diferencias significativas entre el promedio real y el valor de referencia ($500.000), se recomienda aumentar el tamaño de muestra, lo que incrementará la potencia estadística de la prueba y evitará errores Tipo II.
Implementar monitoreo periódico Realizar estudios con periodicidad semestral o anual con diseño muestral probabilístico, que permitan a la administración hacer seguimiento a la evolución de la capacidad de pago de los estudiantes y ajustar la política de matrículas oportunamente.

Taller Estadístico - Estimación de Matrícula

Programa NEIVA - MATEMÁTICA APLICADA, Universidad Surcolombiana

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

20/03/2026