Análisis Estadístico de los resultados del examen de admisión a licenciatura de la UNAM 2026

El examen de admisión a licenciatura de la UNAM fue realizado en línea por primera vez en su historia; cuando se publicaron los resultados, las personas en internet comenzaron a notar que la distribución de los aciertos fue anormal para varias carreras, muchos de los aspirantes habían hecho trampa para poder ingresar.

En este trabajo se hará una comparación de los resultados de los años anteriores con los del concurso de selección de este año 2026. Los datos fueron recopilados de un dataset de libre acceso en GitHub (Karen Arlet Castrillo Cruz. (2026). Resultados UNAM — Datos de admisión a licenciatura (2021–2026).

En este caso, solo se usará el archivo csv con los siguientes datos:

Tabla1. Tomada directamente de: Karen Arlet Castrillo Cruz. (2026). Resultados UNAM — Datos de admisión a licenciatura (2021–2026). https://github.com/agn3si/ResultadosUNAM—data
Columna Tipo Descripción
folio entero Folio del aspirante (identificador anónimo, no es información personal)
aciertos entero / NA Número de respuestas correctas en el examen. Nulo si el aspirante no presentó
acreditado S / N /C / NA S = seleccionado, N = no seleccionado, C = cancelado. Nulo cuando no aplica
año entero Año del proceso de admisión (2021–2026)
area entero (1-4) Área de conocimiento según clasificación de la DGAE
carrera texto Carrera solicitada
plantel texto Plantel/facultad solicitada

Este análisis busca identificar diferencias y patrones estadísticos en el número de aciertos desde el año 2021-2026.

Pregunta de investigación:

¿Cómo ha cambiado el desempeño de los aspirantes del concurso de selección de la UNAM entre los años 2021 y 2026? ¿Existe una demanda entre las carreras y el número de aciertos?

Específicamente:

  • ¿Hay alguna diferencia significativa entre el número de aciertos entre 2021 y 2026?
  • ¿Cuáles fueron las carreras con mayor demanda durante el periodo 2021-2026?
  • ¿Cambió el número de aciertos de las carreras más demandadas?
  • ¿Hay una relación entre la demanda de una carrera y el promedio de aciertos de sus aspirantes?
  • ¿ Hay un incremento en la proporción de aspirantes con resultados anormales y altos en 2026 respecto a los años anteriores?

Overview de los datos

  • La base de datos cuenta con más de 1 millón de registros desde el año 2021 hasta el 2026

  • Hay 116 carreras ofertadas y se imparten en 54 planteles

  • La carrera con mayor cantidad de registros es la de Médico Cirujano

Análisis de datos

library(tidyverse)
library(plotly)
library(knitr)
library(scales)
library(car)
library(broom)
library(dplyr)

datos <- read.csv("aciertos_unam_2021_2026.csv", header = TRUE, stringsAsFactors = FALSE)

names(datos)
## [1] "folio"      "aciertos"   "acreditado" "año"        "area"      
## [6] "carrera"    "plantel"
dim(datos)
## [1] 1027716       7
str(datos)
## 'data.frame':    1027716 obs. of  7 variables:
##  $ folio     : int  1 30 56 133 148 151 167 208 283 326 ...
##  $ aciertos  : num  71 93 49 90 62 51 111 85 NA 106 ...
##  $ acreditado: chr  "" "" "" "" ...
##  $ año       : int  2021 2021 2021 2021 2021 2021 2021 2021 2021 2021 ...
##  $ area      : int  1 1 1 1 1 1 1 1 1 1 ...
##  $ carrera   : chr  "ACTUARIA" "ACTUARIA" "ACTUARIA" "ACTUARIA" ...
##  $ plantel   : chr  "FACULTAD DE CIENCIAS" "FACULTAD DE CIENCIAS" "FACULTAD DE CIENCIAS" "FACULTAD DE CIENCIAS" ...
head(datos)

La variable de interés principal es aciertos. Las demás variables se van a usar para hacer las comparaciones entre grupos (cada año es un grupo).

Se hacen modificaciones en la estructura de los datos

datos <- datos %>% 
  mutate(
    año = as.factor(año),
    area = as.factor(area),
    carrera = as.factor(carrera),
    plantel = as.factor(plantel)
    ) 

str(datos)
## 'data.frame':    1027716 obs. of  7 variables:
##  $ folio     : int  1 30 56 133 148 151 167 208 283 326 ...
##  $ aciertos  : num  71 93 49 90 62 51 111 85 NA 106 ...
##  $ acreditado: chr  "" "" "" "" ...
##  $ año       : Factor w/ 6 levels "2021","2022",..: 1 1 1 1 1 1 1 1 1 1 ...
##  $ area      : Factor w/ 4 levels "1","2","3","4": 1 1 1 1 1 1 1 1 1 1 ...
##  $ carrera   : Factor w/ 116 levels "ACTUARIA","ADMINISTRACION",..: 1 1 1 1 1 1 1 1 1 1 ...
##  $ plantel   : Factor w/ 54 levels "CENTRO DE INVESTIGACIÓN EN ENERGÍA",..: 17 17 17 17 17 17 17 17 17 17 ...

Buscamos si hay folios duplicados y si hay datos faltantes:

# Folios duplicados:

sum(duplicated(datos))
## [1] 0
sum(duplicated(datos$folio))
## [1] 821526
datos <- datos %>%
  distinct()

nrow(datos)
## [1] 1027716
# datos faltantes

faltantes <- data.frame(
  variable = names(datos),
  faltantes = sapply(datos, function(x) sum(is.na(x))) 
  ) %>%
  mutate(
    porcentaje = 100 * faltantes / nrow(datos)
    )

print(faltantes)
##              variable faltantes porcentaje
## folio           folio         0    0.00000
## aciertos     aciertos    153694   14.95491
## acreditado acreditado         0    0.00000
## año               año         0    0.00000
## area             area         0    0.00000
## carrera       carrera         0    0.00000
## plantel       plantel         0    0.00000

Para los análisis que involucren el número de aciertos, solo se usarán los datos completos con información disponible !

Datos faltantes por año

faltantes_año <- datos %>%
  group_by(año) %>%
  summarise(
    total = n(),
    faltantes_aciertos = sum(is.na(aciertos)),
    porcentaje_faltantes = 100 * faltantes_aciertos / total )

kable(
  faltantes_año,
  digits = 2,
  caption = "Datos faltantes de aciertos por año"
  )
Datos faltantes de aciertos por año
año total faltantes_aciertos porcentaje_faltantes
2021 167432 26986 16.12
2022 177780 24188 13.61
2023 178404 25544 14.32
2024 162463 23178 14.27
2025 174543 25110 14.39
2026 167094 28688 17.17 
# graficamos

plot_ly(
  faltantes_año,
  x = ~año,
  y = ~porcentaje_faltantes,
  type = "bar",
  marker = list(color = "#9AC0CD"),
  text = ~paste0(round(porcentaje_faltantes, 2), "%"),
  textposition = "outside",
  hovertemplate = paste( "<b>Año:</b> %{x}<br>", "<b>Faltantes:</b> %{y:.2f}%<extra></extra>"
    )
) %>%
  layout(
    title = "Porcentaje de valores faltantes en aciertos",
    xaxis = list(title = "Año"),
    yaxis = list(title = "Porcentaje de datos faltantes"),
    hovermode = "x"
    )

Analizar la cantidad de datos faltantes nos indica el porcentaje de personas ausentes al examen.

Se puede observar que la proporción se mantiene más o menos estable, siendo 13.61% el porcentaje más bajo (en 2022) y 17.17% el más alto (en 2026).

Ya que las personas ausentes no generan un puntaje, se tienen que eliminar para no sesgar las medias hacia abajo.

Estadística descriptiva

datos_aciertos <- datos %>%
  filter(!is.na(aciertos)) 


descriptivos <- datos_aciertos %>%
  summarise(
    n = n(),
    media = mean(aciertos),
    mediana = median(aciertos),
    desviacion_estandar = sd(aciertos),
    minimo = min(aciertos),
    Q1 = quantile(aciertos, 0.25),
    Q3 = quantile(aciertos, 0.75),
    maximo = max(aciertos)
    ) 

print(descriptivos)
##        n    media mediana desviacion_estandar minimo Q1 Q3 maximo
## 1 874022 58.30326      54            20.97062      0 42 71    120

Estadísticas por año

descriptivos_año <- datos_aciertos %>%
  group_by(año) %>%
  summarise(
    n = n(),
    media = mean(aciertos),
    mediana = median(aciertos),
    desviacion_estandar = sd(aciertos),
    minimo = min(aciertos),
    Q1 = quantile(aciertos, 0.25),
    Q3 = quantile(aciertos, 0.75),
    maximo = max(aciertos)
    )

print(descriptivos_año, width = Inf)
## # A tibble: 6 × 9
##   año        n media mediana desviacion_estandar minimo    Q1    Q3 maximo
##   <fct>  <int> <dbl>   <dbl>               <dbl>  <dbl> <dbl> <dbl>  <dbl>
## 1 2021  140446  56.1      52                18.7      0    42    67    120
## 2 2022  153592  54.9      51                18.6      1    41    66    119
## 3 2023  152860  56.1      52                18.9      0    42    68    120
## 4 2024  139285  56.1      52                19.7      1    41    68    120
## 5 2025  149433  56.4      52                19.7      0    41    68    120
## 6 2026  138406  71.1      71                25.2      0    49    93    120

Evolución del número de aciertos por cada año (2021 - 2026)

Primero vamos a analizar la media de aciertos por año

plot_ly(
  descriptivos_año,
  x = ~año,
  y = ~media,
  type = "scatter",
  mode = "lines+markers",
  line = list(color = "#87CEFA", width = 3 ),
  marker = list(color = "#A2B5CD",size = 8),
  text = ~paste0(
    "Año: ", año,
    "<br>Media: ", round(media, 2),
    "<br>Mediana: ", round(mediana, 2)
    ),
  hoverinfo = "text"
  ) %>%
  layout(
    title = "Evolución del promedio de aciertos, 2021–2026",
    xaxis = list(title = "Año"),
    yaxis = list(title = "Promedio de aciertos"),
    hovermode = "x unified"
    )

Con esta gráfica podemos ver de manera visual si hay una tendencia temporal en el promedio de aciertos. Se observa que las medias estaban muy parejas entre 2021 y 2025, pero para el año 2026 hubo un repunte enorme en el número de aciertos.

Distribución de los resultados

plot_ly(
  datos_aciertos,
  x = ~aciertos,
  type = "histogram",
  nbinsx = 60,
  marker = list(
    color = "#FFC1C1"
  )
  ) %>%
  layout(
    title = "Distribución general del número de aciertos",
    xaxis = list(title = "Número de aciertos"),
    yaxis = list(title = "Frecuencia")
    )

Análisis de frecuencia relativa

datos_animacion_prop <- datos_aciertos %>%
  mutate(
    grupo_aciertos = cut(
      aciertos,
      breaks = seq(0, 125, by = 5),
      right = FALSE,
      include.lowest = TRUE
    )
  ) %>%
  group_by(año, grupo_aciertos) %>%
  summarise(
    frecuencia = n(),
    .groups = "drop"
  ) %>%
  group_by(año) %>%
  mutate(
    porcentaje = frecuencia / sum(frecuencia) * 100
  ) %>%
  ungroup() %>%
  mutate(
    aciertos_eje_x = as.numeric(
      sub("\\[([0-9]+),.*", "\\1", grupo_aciertos)
    )
  ) %>%
  drop_na(aciertos_eje_x)
plot_ly(
  data = datos_animacion_prop,
  x = ~aciertos_eje_x,
  y = ~porcentaje,
  frame = ~año,
  type = "bar",
  marker = list(
    color = "#A4D3EE",
    line = list(
      color = "white",
      width = 0.5
    )
  ),
  width = 0.8,
  hovertemplate = paste(
    "Intervalo: %{x}–%{x+5} aciertos<br>",
    "Porcentaje: %{y:.2f}%",
    "<extra></extra>"
  )
) %>%
  layout(
    title = list(
      text = "Evolución de la distribución relativa de aciertos"
    ),
    xaxis = list(
      title = "Número de aciertos",
      range = c(0, 120),
      dtick = 10
    ),
    yaxis = list(
      title = "Porcentaje de aspirantes",
      ticksuffix = "%",
      range = c(
        0,
        max(datos_animacion_prop$porcentaje) * 1.10
      )
    )
  ) %>%
  animation_opts(
    frame = 1500,
    transition = 800,
    easing = "linear",
    redraw = FALSE
  ) %>%
  animation_slider(
    currentvalue = list(
      prefix = "Año evaluado: "
    )
  )

Esta gráfica ilustra el cambio drástico en el comportamiento de la población. Durante los años 2021-2025 la campana presenta un sesgo hacia la derecha. En 2026 la campana se aplana y se desplaza hacia la derecha de manera drástica.

Este desplazamiento coincide con el cambio en las condiciones de evaluación.

Valores atípicos

atipicos <- datos_aciertos %>%
  group_by(año) %>%
  summarise(
    Q1 = quantile(aciertos, 0.25),
    Q3 = quantile(aciertos, 0.75),
    IQR = IQR(aciertos),
    limite_inferior = Q1 - 1.5 * IQR,
    limite_superior = Q3 + 1.5 * IQR,
    atipicos_inferiores = sum(aciertos < limite_inferior),
    atipicos_superiores = sum(aciertos > limite_superior),
    porcentaje_atipicos = 100 * (atipicos_inferiores + atipicos_superiores) / n()
    )

print(atipicos, width = Inf)
## # A tibble: 6 × 9
##   año      Q1    Q3   IQR limite_inferior limite_superior atipicos_inferiores
##   <fct> <dbl> <dbl> <dbl>           <dbl>           <dbl>               <int>
## 1 2021     42    67    25             4.5            104.                   2
## 2 2022     41    66    25             3.5            104.                   1
## 3 2023     42    68    26             3              107                    1
## 4 2024     41    68    27             0.5            108.                   0
## 5 2025     41    68    27             0.5            108.                   1
## 6 2026     49    93    44           -17              159                    0
##   atipicos_superiores porcentaje_atipicos
##                 <int>               <dbl>
## 1                2280               1.62 
## 2                2479               1.61 
## 3                1368               0.896
## 4                1337               0.960
## 5                1756               1.18 
## 6                   0               0

Boxplot por año

plot_ly(
  datos_aciertos,
  x = ~año,
  y = ~aciertos,
  color = ~año,
  type = "box",
  boxpoints = FALSE
  ) %>%
  layout(
    title = "Distribución de aciertos por año",
    xaxis = list(title = "Año"),
    yaxis = list(title = "Número de aciertos"),
    showlegend = FALSE
    )

Los diagramas de caja muestran la distribución de los aciertos por cada año. De 2021-2025 las cajas se mantienen en el mismo punto con medianas que van de 51-52 aciertos

Se observa que la mediana se desplaza hacia arriba en el año 2026, la mediana sube a 71. En este caso, en 2026 dejaron de existir valores atípicos porque obtener un puntaje perfecto ya no era algo raro.

Ahora, vamos a ver si hay un cambio en la frecuencia de resultados altos, vamos a analizar 3 indicadores:

  • 90 o más aciertos
  • 100 o más aciertos
  • 110 o más aciertos
datos_aciertos <- datos_aciertos %>%
  mutate(
    mayor_90 = aciertos >= 90,
    mayor_100 = aciertos >= 100,
    mayor_110 = aciertos >= 110
    )

proporciones_altas <- datos_aciertos %>%
  group_by(año) %>%
  summarise(
    n = n(),
    prop_90 = mean(mayor_90) * 100,
    prop_100 = mean(mayor_100) * 100,
    prop_110 = mean(mayor_110) * 100
    ) 

print(proporciones_altas)
## # A tibble: 6 × 5
##   año        n prop_90 prop_100 prop_110
##   <fct>  <int>   <dbl>    <dbl>    <dbl>
## 1 2021  140446    6.81     2.92    0.680
## 2 2022  153592    6.15     2.58    0.544
## 3 2023  152860    6.92     2.82    0.566
## 4 2024  139285    7.84     3.46    0.759
## 5 2025  149433    8.14     3.72    0.964
## 6 2026  138406   29.1     17.0     5.79

Hacemos una gráfica temporal:

proporciones_long <- proporciones_altas %>%
  pivot_longer(
    cols = starts_with("prop_"),
    names_to = "umbral",
    values_to = "porcentaje"
    ) %>%
  mutate(
    umbral = dplyr::recode(
      umbral,
      prop_90 = "90 o más",
      prop_100 = "100 o más",
      prop_110 = "110 o más"
      )
    )

plot_ly(
  proporciones_long,
  x = ~año,
  y = ~porcentaje,
  color = ~umbral,
  type = "scatter",
  mode = "lines+markers"
  ) %>%
  layout(
    title = "Evolución de la proporción de resultados altos",
    xaxis = list(title = "Año"),
    yaxis = list(
      title = "Porcentaje de aspirantes",
      ticksuffix = "%"
      )
    )

Intervalo de confianza para la media

¿Cuál es la media de aciertos de los aspirantes en 2026?

  • Se va a calcular un intervalo de confianza del 95%
datos_2026 <- datos_aciertos %>%
  filter(año == "2026")

ic_media_2026 <- t.test(datos_2026$aciertos) 
ic_media_2026
## 
##  One Sample t-test
## 
## data:  datos_2026$aciertos
## t = 1048.1, df = 138405, p-value < 2.2e-16
## alternative hypothesis: true mean is not equal to 0
## 95 percent confidence interval:
##  70.98527 71.25127
## sample estimates:
## mean of x 
##  71.11827

Aquí se estableció un nivel de confianza del 95%. Con ese nivel de confianza se puede afirmar que el verdadero promedio poblacional de aciertos se encuentra entre 70.98 y 71.25.

Diferencia de medias de 2026 vs años previos

Para poder analizar estos datos, se van a crear 2 grupos: - periodo 2021-2025 - periodo 2026

datos_comparacion <- datos_aciertos %>%
  mutate(
    periodo = ifelse(
      año == "2026",
      "2026", "2021-2025"
      )
    )

table(datos_comparacion$periodo)
## 
## 2021-2025      2026 
##    735616    138406

Prueba de diferencia de medias

comparacion_medias <- t.test(
  aciertos ~ periodo,
  data = datos_comparacion
  )

comparacion_medias
## 
##  Welch Two Sample t-test
## 
## data:  aciertos by periodo
## t = -213.17, df = 169549, p-value < 2.2e-16
## alternative hypothesis: true difference in means between group 2021-2025 and group 2026 is not equal to 0
## 95 percent confidence interval:
##  -15.36615 -15.08616
## sample estimates:
## mean in group 2021-2025      mean in group 2026 
##                55.89211                71.11827

Se realizó una prueba t de Welch para comparar el promedio del bloque de años de 2021-2025 vs 2026.El p-value es prácticamente 0, por lo que se rechaza la hipótesis nula.

  • hay un aumento de casi 15 aciertos en promedio en el año 2026
  • el aumento en aciertos es estadísticamente significativo en 2026

Cambio en las proporciones de aciertos

Se analiza si la proporción de aspirantes con 100 o más aciertos cambió entre 2026 y los años 2021-2025

tabla_100 <- datos_comparacion %>%
  count(periodo, mayor_100)

tabla_100
prop_2026 <- sum(
  datos_comparacion$periodo == "2026" &
    datos_comparacion$mayor_100
  )

n_2026 <- sum(
  datos_comparacion$periodo == "2026"
  )

prop_historico <- sum(
  datos_comparacion$periodo == "2021-2025" & datos_comparacion$mayor_100
  )

n_historico <- sum(
  datos_comparacion$periodo == "2021-2025"
  )

prop.test(
  x = c(prop_2026, prop_historico),
  n = c(n_2026, n_historico)
  )
## 
##  2-sample test for equality of proportions with continuity correction
## 
## data:  c(prop_2026, prop_historico) out of c(n_2026, n_historico)
## X-squared = 44893, df = 1, p-value < 2.2e-16
## alternative hypothesis: two.sided
## 95 percent confidence interval:
##  0.1369818 0.1410259
## sample estimates:
##     prop 1     prop 2 
## 0.16992760 0.03092374

La prueba de diferencia de proporciones confirma el salto en puntajes. De 2021-2025 solamente el 3.09% de la población lograba pasar los 100 aciertos.

En 2026 la cifra aumentó a 16.99%.

  • el p-value (p<0.001) confirma que el incremento no fue al azar, fue deliberado.

Prueba de independencia

Hay asociación entre el año y la obtención de más de 100 aciertos?

Vamos a construir una tabla de contingencia:

tabla_independencia <- table(
  datos_aciertos$año,
  datos_aciertos$mayor_100
  )

tabla_independencia
##       
##         FALSE   TRUE
##   2021 136343   4103
##   2022 149627   3965
##   2023 148547   4313
##   2024 134471   4814
##   2025 143880   5553
##   2026 114887  23519

Se realiza una prueba chi-cuadrada de independencia:

prueba_independencia <- chisq.test(
  tabla_independencia
  )

prueba_independencia
## 
##  Pearson's Chi-squared test
## 
## data:  tabla_independencia
## X-squared = 45159, df = 5, p-value < 2.2e-16

La prueba de Chi-Cuadrada de Pearson mostró un p-value < 0.05. En este caso podemos concluir que hay una dependencia estadística fuerte entre el año en que se presentó el examen y la probabilidad de obtener un puntaje sobresaliente (mayor a 100 aciertos en este caso). La anomalía estadística se concentra en el año 2026.

Análisis de varianza

Existe una diferencia significativa entre las medias de aciertos de los 6 años analizados

Realizamos una prueba ANOVA:

modelo_anova <- aov(
  aciertos ~ año,
  data = datos_aciertos
  )
summary(modelo_anova)
##                 Df    Sum Sq Mean Sq F value Pr(>F)    
## año              5  27207332 5441466   13316 <2e-16 ***
## Residuals   874016 357158152     409                   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

El modelo ANOVA para un factor rechza la hipótesis nula de que todos los años tienen el mismo promedio de aciertos. Este resultado confirma que al menos en uno de los años hay una población que tuvo un desempeño distinto; es por eso, que debe hacerse una prueba de Tukey para saber en qué grupo hay diferencias.

plot(modelo_anova)

En la gráfica Residuals vs Fitted los puntos no generan un embudo, lo que indica que la varianza de los datos es constante.

Analisis de normalidad de residuos

qqnorm(
  residuals(modelo_anova),
  main = "Gráfica Q-Q de los residuos"
  )

qqline(
  residuals(modelo_anova)
  )

En esta gráfica se observan colas pesadas, lo que quiere decir que hay muchos estudiantes con puntajes muy bajos (cercanos a 0) y puntajes muy altos (cercanis a 120), al tener más de 80,000 datos se asume que los datos se comportan de forma normal.

Comparaciones múltiples de Tukey

Como se rechazó la hipótesis nula, hay que determinar en qué años existen las diferencias.

tukey <- TukeyHSD(
  modelo_anova
  )

tukey
##   Tukey multiple comparisons of means
##     95% family-wise confidence level
## 
## Fit: aov(formula = aciertos ~ año, data = datos_aciertos)
## 
## $año
##                   diff         lwr        upr     p adj
## 2022-2021 -1.189431319 -1.40211458 -0.9767481 0.0000000
## 2023-2021  0.008421775 -0.20450458  0.2213481 0.9999975
## 2024-2021 -0.035091491 -0.25292967  0.1827467 0.9974586
## 2025-2021  0.281860526  0.06776825  0.4959528 0.0024224
## 2026-2021 15.030170078 14.81198487 15.2483553 0.0000000
## 2023-2022  1.197853094  0.98972986  1.4059763 0.0000000
## 2024-2022  1.154339829  0.94119405  1.3674856 0.0000000
## 2025-2022  1.471291846  1.26197594  1.6806078 0.0000000
## 2026-2022 16.219601397 16.00610097 16.4331018 0.0000000
## 2024-2023 -0.043513266 -0.25690161  0.1698751 0.9922921
## 2025-2023  0.273438752  0.06387584  0.4830017 0.0027554
## 2026-2023 15.021748303 14.80800571 15.2354909 0.0000000
## 2025-2024  0.316952017  0.10240027  0.5315038 0.0003675
## 2026-2024 15.065261568 14.84662549 15.2838976 0.0000000
## 2026-2025 14.748309551 14.53340547 14.9632136 0.0000000

Visualizamos los intervalos de confianza:

# Convertir el resultado matemático de Tukey en una tabla normal (data frame)
tukey_df <- as.data.frame(tukey$año)

# Sacar los nombres de las filas a una columna real
tukey_df$comparacion <- rownames(tukey_df)

# Identificar y etiquetar las anomalías 

tukey_df <- tukey_df %>%
  mutate(
    estado = ifelse(grepl("2026", comparacion), "Anomalía (Trampa)", "Comportamiento Normal")
  )

# graficar

plot_ly(
  data = tukey_df,
  x = ~diff,
  y = ~comparacion,
  color = ~estado,
  colors = c("Anomalía (Trampa)" = "#E74C3C", "Comportamiento Normal" = "#34495E"),
  type = "scatter",
  mode = "markers",
  marker = list(size = 8),
  error_x = list(
    type = "data",
    symmetric = FALSE,
    array = ~upr - diff,        
    arrayminus = ~diff - lwr,   
    width = 4,                  
    thickness = 1.5             
  ),
  hovertemplate = paste(
    "<b>Comparación:</b> %{y}<br>",
    "<b>Diferencia de aciertos:</b> %{x:.2f}<br>",
    "<extra></extra>"
  )
) %>%
  layout(
    title = "Comparaciones múltiples de medias (Tukey HSD)",
    xaxis = list(title = "Diferencia en el promedio de aciertos"),
    yaxis = list(title = "Años comparados", autorange = "reversed"), 
    legend = list(title = list(text = "<b>Diagnóstico</b>")),
    # Línea punteada en el cero
    shapes = list(
      list(
        type = "line",
        x0 = 0, x1 = 0,
        y0 = 0, y1 = 1,
        yref = "paper",
        line = list(color = "darkgray", dash = "dash")
      )
    )
  )

La prueba de Tukey nos dice en qué grupo se encuentra la diferencia que mostró la prueba ANOVA. Se puede ver en los intervalos de confianza de la gráfica, que del año 2021-2025 hay diferencias pequeñas, algunas cruzan el 0. Por otro lado, el año 2026 se aleja por completo, mostrando diferencias positivas muy grandes y significativas contra todos los demás años.

Carreras con mayor demanda

Primero conatremos el número de aspirantes por carrera:

demanda_carrera <- datos %>%
  filter(!is.na(carrera)) %>%
  count(carrera, name = "demanda") %>%
  arrange(desc(demanda))

head(demanda_carrera, 20)

Analizamos la demanda de las 10 carreras más solicitadas por cada año.

top10_carreras <- demanda_carrera %>%
  slice_head(n = 10)

print(top10_carreras)
##                             carrera demanda
## 1                   MEDICO CIRUJANO  158972
## 2                           DERECHO   73882
## 3                        PSICOLOGIA   61663
## 4                    ADMINISTRACION   52285
## 5                      ARQUITECTURA   51504
## 6                 CIRUJANO DENTISTA   48211
## 7                        ENFERMERIA   41349
## 8                        CONTADURIA   38961
## 9  MEDICINA VETERINARIA Y ZOOTECNIA   38760
## 10                        PEDAGOGIA   30216

Vamos a analizar si hubo algún cambio en el número de aciertos de las carreras más demandadas

desempeno_top10 <- datos_aciertos %>%
  filter(carrera %in% top10_carreras$carrera) %>%
  group_by(año, carrera) %>%
  summarise(
    n = n(),
    media_aciertos = mean(aciertos, na.rm = TRUE),
    mediana_aciertos = median(aciertos, na.rm = TRUE),
    sd_aciertos = sd(aciertos, na.rm = TRUE),
    .groups = "drop"
  ) %>%
  mutate(
    carrera = as.character(carrera),
    año = as.character(año)
  )

plot_ly(
  desempeno_top10,
  x = ~año,
  y = ~media_aciertos,
  color = ~carrera,
  type = "scatter",
  mode = "lines+markers",
  hovertemplate = paste(
    "<b>%{fullData.name}</b><br>",
    "Año: %{x}<br>",
    "Promedio de aciertos: %{y:.2f}",
    "<extra></extra>"
  )
) %>%
  layout(
    title = list(
      text = "Evolución del promedio de aciertos<br><sup>10 carreras con mayor demanda</sup>"
    ),
    xaxis = list(
      title = "Año",
      type = "category"
    ),
    yaxis = list(
      title = "Promedio de aciertos"
    ),
    hovermode = "x unified",
    legend = list(
      title = list(text = "Carrera")
    )
  )
## Warning in RColorBrewer::brewer.pal(max(N, 3L), "Set2"): n too large, allowed maximum for palette Set2 is 8
## Returning the palette you asked for with that many colors
## Warning in RColorBrewer::brewer.pal(max(N, 3L), "Set2"): n too large, allowed maximum for palette Set2 is 8
## Returning the palette you asked for with that many colors
desempeno_animado <- desempeno_top10 %>%
  group_by(año) %>%
  arrange(desc(media_aciertos), .by_group = TRUE) %>%
  mutate(
    ranking = row_number()
  ) %>%
  ungroup()

plot_ly(
  desempeno_animado,
  x = ~media_aciertos,
  y = ~reorder(carrera, -ranking),
  frame = ~año,
  type = "bar",
  orientation = "h",
  text = ~paste0(
    "<b>", carrera, "</b>",
    "<br>Promedio: ", round(media_aciertos, 2),
    "<br>Aspirantes: ", comma(n)
  ),
  hoverinfo = "text"
) %>%
  layout(
    title = list(
      text = "Desempeño de las carreras más demandadas<br><sup>Ordenadas por promedio de aciertos</sup>"
    ),
    xaxis = list(
      title = "Promedio de aciertos"
    ),
    yaxis = list(
      title = "",
      autorange = "reversed"
    ),
    margin = list(
      l = 200,
      r = 40,
      t = 90,
      b = 70
    )
  ) %>%
  animation_opts(
    frame = 1200,
    transition = 700,
    redraw = FALSE
  ) %>%
  animation_slider(
    currentvalue = list(
      prefix = "Año: ",
      font = list(size = 16)
    )
  ) %>%
  animation_button(
    x = 1,
    xanchor = "right",
    y = 0,
    yanchor = "top"
  )

relación entre demanda y desempeño

demanda_desempeno <- datos_aciertos %>%
  filter(
    carrera %in% top10_carreras$carrera
  ) %>%
  group_by(
    año,
    carrera
  ) %>%
  summarise(
    demanda = n(),
    media_aciertos = mean(aciertos, na.rm = TRUE),
    .groups = "drop"
  )
head(demanda_desempeno)
plot_ly(
  demanda_desempeno,
  x = ~demanda,
  y = ~media_aciertos,
  size = ~demanda,
  color = ~año,
  text = ~carrera,
  type = "scatter",
  mode = "markers",
  hovertemplate = paste(
    "<b>%{text}</b><br>",
    "Año: %{marker.color}<br>",
    "Demanda: %{x}<br>",
    "Promedio de aciertos: %{y:.2f}",
    "<extra></extra>"
  )
) %>%
  layout(
    title = "Relación entre demanda y desempeño",
    xaxis = list(
      title = "Número de aspirantes"
    ),
    yaxis = list(
      title = "Promedio de aciertos"
    )
  )
## Warning: `line.width` does not currently support multiple values.
## Warning: `line.width` does not currently support multiple values.
## Warning: `line.width` does not currently support multiple values.
## Warning: `line.width` does not currently support multiple values.
## Warning: `line.width` does not currently support multiple values.
## Warning: `line.width` does not currently support multiple values.

Relación entre demanda y desempeño

correlacion <- cor(
  demanda_desempeno$demanda,
  demanda_desempeno$media_aciertos,
  use = "complete.obs"
  )

correlacion
## [1] 0.311761

Gráfica de demanda vs desempeño

plot_ly(
  demanda_desempeno,
  x = ~demanda,
  y = ~media_aciertos,
  frame = ~año,
  type = "scatter",
  mode = "markers",
  marker = list(color = "#FF82AB", size = 9),
  text = ~carrera,
  hovertemplate = paste(
    "<b>Carrera:</b> %{text}<br>",
    "<b>Demanda:</b> %{x}<br>",
    "<b>Media de aciertos:</b> %{y:.2f}",
    "<extra></extra>"
    )
  ) %>%
  layout(
    title = "Relación entre demanda y promedio de aciertos",
    xaxis = list(
      title = "Número de aspirantes" ),
    yaxis = list(
      title = "Promedio de aciertos"
      )
    ) %>%
  animation_slider(
    currentvalue = list(
      prefix = "Año: "
      )
    )

Modelo de regresión lineal

Las variables son: - demanda - año

modelo_regresion <- lm(
  media_aciertos ~ demanda + año,
  data = demanda_desempeno
  )

summary(modelo_regresion)
## 
## Call:
## lm(formula = media_aciertos ~ demanda + año, data = demanda_desempeno)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -6.5054 -1.4036  0.1693  1.4733  5.5963 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  4.971e+01  1.116e+00  44.555  < 2e-16 ***
## demanda      4.814e-04  7.749e-05   6.213 8.29e-08 ***
## año2022     -1.401e+00  1.328e+00  -1.055    0.296    
## año2023     -3.660e-02  1.328e+00  -0.028    0.978    
## año2024      1.547e-01  1.325e+00   0.117    0.907    
## año2025      4.613e-02  1.327e+00   0.035    0.972    
## año2026      1.594e+01  1.325e+00  12.028  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 2.962 on 53 degrees of freedom
## Multiple R-squared:  0.8423, Adjusted R-squared:  0.8245 
## F-statistic: 47.18 on 6 and 53 DF,  p-value: < 2.2e-16

Se construyó un modelo de regresión usando la demanda y el año para predecir el promedio de aciertos de las carreras.Este modelo arrojó una R-cuadrada ajustada de 0.2994, lo que indica que estas variables explican el 29.9% de la variabilidad de los puntajes.

  • esta proporción no es alta, pero el p-value es significativo.
summary(modelo_regresion)$r.squared
## [1] 0.8423119

Este valor indica la proporción de variabilidad del promedio de aciertos

Intervalos de confianza

confint( modelo_regresion, level = 0.95 )
##                     2.5 %       97.5 %
## (Intercept) 47.4706917838 5.194618e+01
## demanda      0.0003259831 6.368198e-04
## año2022     -4.0646237263 1.261810e+00
## año2023     -2.7001616778 2.626960e+00
## año2024     -2.5033534041 2.812795e+00
## año2025     -2.6154639187 2.707719e+00
## año2026     13.2806770755 1.859619e+01

Graficamos para ver visualmente como se distribuyen los datos

plot(modelo_regresion)

qqnorm(
  residuals(modelo_regresion),
  main = "Q-Q plot de los residuos"
  )

qqline(
  residuals(modelo_regresion)
  )

range( demanda_desempeno$demanda )
## [1]  3608 23481
demanda_nueva <- median(
  demanda_desempeno$demanda
  )

nuevo <- data.frame(
  demanda = demanda_nueva,
  año = factor(
    "2026",
    levels = levels(demanda_desempeno$año)
    )
  )

nuevo

Intervalo de confianza:

predict(
  modelo_regresion,
  newdata = nuevo,
  interval = "confidence",
  level = 0.95
  )
##        fit     lwr     upr
## 1 69.06265 67.1762 70.9491

El valor predicho central es de 68.99 aciertos. - el intervalo de confianza va de 67.80 - 70.17, esto nos dice en qué rango cae el promedio matemático global de todas las carreras con esa demanda

Intervalo de predicción:

predict(
  modelo_regresion,
  newdata = nuevo,
  interval = "prediction",
  level = 0.95
  )
##        fit      lwr      upr
## 1 69.06265 62.82877 75.29654

El intervalo de prediccón es más amplio, va de 56.31 - 81.66, este estima el rango de aciertos con el que podría flucturar una sola carrera

  • los intervalos de 2026 se situán por encima del comportamiento de los años previos.

Conclusión

Este análisis estadístico de los resultados del examen de admisión de la licenciatura de la UNAM de los años 2021-2026 confirma la existencia de una anomalía atípica en el año 2026.

El cambio a examen en línea coincide con una alteración masiva de la distribución global de los puntajes, esto respalda las sospechas de trampa sistemática por parte de una gran proporción de los aspirantes.

Se usaron técnicas de estadística descriptiva e inferencial donde se logró demostrar:

  • una ruptura en la tendencia histórica, de 2021-2025 el desempeño se mantuvo con una mediana de 51 a 52 aciertos, en 2026 la mediana subió a 71 aciertos, en las pruebas T y en los ANOVA se confirma que la anomalía en los aciertos no se debe al azar

  • la prueba de Tukey mostró que la diferencia se concentraba en el año 2026

  • la prueba de proporciones y la prueba chi-cuadrarda mostraron que la obtención de más de 100 aciertos dejó de ser un evento atípico, de 2021-2025 el porcentaje era de 3%, mientras que en 2026 el porcentaje se volvió de casi el 17%, las colas de la campana de distribución se movieron por completo hacia la derecha

  • al analizar la relación entre la demanda de las carreras y el desempeño se encontró una correlación débil, el modelo de regresión lineal demostró que la cantidad de aspirantes no explica por sí sola los puntajes altos.

  • el modelo de regresión confirmó que nada más por presentar el examen en 2026, añadió casi 10 puntos al promedio de aciertos de cualquier licenciatura

Con estos resultados se demuestra que los resultados del concurso de selección de 2026 rompieron los parámetros de normalidad de los años previos. Este año desaparecieron los valores atípicos superiores y hubo una inflación general en los promedios, lo que sugiere que las condiciones de evaluación comprometieron la integridad del examen.