1 1. Presentación

El presente informe analiza los cortes progresivos de calificaciones del CONALEP Plantel Lerma 199 durante 2026. El procesamiento considera la estructura real de las sábanas: porcentaje máximo en la fila 4, porcentaje mínimo esperado en la fila 5, encabezados en la fila 6 y registros de estudiantes a partir de la fila 7.

El criterio principal de riesgo académico es el siguiente:

Módulo en riesgo: la calificación acumulada del estudiante es menor que el porcentaje mínimo esperado del módulo en el corte correspondiente.
Estudiante en riesgo: presenta al menos un módulo por debajo del mínimo.
Estudiante sin datos completos: tiene uno o más módulos sin calificación.

2 2. Objetivo

Analizar la evolución semanal de la reprobación, identificar grupos, módulos, estudiantes y docentes con mayores niveles de riesgo, y generar información útil para la toma de decisiones académicas.

3 3. Instalación de paquetes

Ejecute este bloque únicamente la primera vez. Después puede dejarlo sin ejecutar.

paquetes <- c(
  "readxl",
  "dplyr",
  "tidyr",
  "purrr",
  "stringr",
  "janitor",
  "ggplot2",
  "openxlsx",
  "scales",
  "knitr",
  "forcats"
)

faltantes <- paquetes[
  !paquetes %in% rownames(installed.packages())
]

if (length(faltantes) > 0) {
  install.packages(faltantes)
}

4 4. Carga de paquetes

library(readxl)
library(dplyr)
library(tidyr)
library(purrr)
library(stringr)
library(janitor)
library(ggplot2)
library(openxlsx)
library(scales)
library(knitr)
library(forcats)

5 5. Configuración de carpetas

Cree una carpeta llamada datos en la misma ubicación donde se encuentra este archivo .Rmd. Copie dentro de ella todas las sábanas de calificaciones en formato .xlsx.

#=========================================================
# CONFIGURACIÓN DE RUTAS
#=========================================================

# Ruta donde están almacenadas las sábanas de calificaciones
carpeta_datos <- "C:/Users/Quimica/Downloads/Reprobacion Lerma"

# Carpetas donde se guardarán los resultados
carpeta_resultados <- file.path(carpeta_datos, "resultados")
carpeta_graficas   <- file.path(carpeta_resultados, "graficas")

# Crear carpetas de salida
if (!dir.exists(carpeta_resultados)) {
  dir.create(carpeta_resultados)
}

if (!dir.exists(carpeta_graficas)) {
  dir.create(carpeta_graficas, recursive = TRUE)
}

#=========================================================
# BUSCAR TODOS LOS ARCHIVOS EXCEL
#=========================================================

archivos_excel <- list.files(
  path = carpeta_datos,
  pattern = "\\.xlsx$",
  full.names = TRUE,
  recursive = TRUE
)

# Excluir archivos temporales y archivos generados por este reporte
archivos_excel <- archivos_excel[
  !grepl("^~\\$", basename(archivos_excel)) &
  !grepl(
    "analisis_cortes_calificaciones\\.xlsx$",
    basename(archivos_excel),
    ignore.case = TRUE
  ) &
  !grepl(
    paste0("[/\\\\]resultados[/\\\\]"),
    archivos_excel,
    ignore.case = TRUE
  )
]

#=========================================================
# VALIDACIÓN
#=========================================================

if(length(archivos_excel)==0){

  stop(
    paste0(
      "\n\nNO SE ENCONTRARON ARCHIVOS EXCEL\n\n",
      "Ruta buscada:\n",
      carpeta_datos,
      "\n\nVerifique que existan archivos .xlsx."
    )
  )

}

cat("=========================================\n")

## =========================================

cat("ARCHIVOS LOCALIZADOS\n")

## ARCHIVOS LOCALIZADOS

cat("=========================================\n\n")

## =========================================

print(basename(archivos_excel))

##  [1] "SEMANA 11 DEL 18-22 MAYO.xlsx"         
##  [2] "SEMANA 12 DEL 25- 29 MAYO.xlsx"        
##  [3] "SEMANA 14 DEL 08 AL 12 DE JUNIO.xlsx"  
##  [4] "SEMANA 15  DEL 15 AL 19UNIO.xlsx"      
##  [5] "SEMANA 16 DEL 20-24 JUNIO.xlsx"        
##  [6] "SEMANA 17 DE 29 JUNIO AL 03 JULIO.xlsx"
##  [7] "SEMANA 18 JULIO 07.xlsx"               
##  [8] "SEMANA 3.  DEL 9-13 DE MARZO.xlsx"     
##  [9] "SEMANA 4 DEL 16 AL 20 DE MARZO.xlsx"   
## [10] "SEMANA 5 DEL 23 AL 27 DE MARZO.xlsx"   
## [11] "SEMANA 6  del 23 al 27 de marzo.xlsx"  
## [12] "SEMANA 8 DEL 27-30 DE ABRIL.xlsx"      
## [13] "SEMANA 9 DEL 4 AL 08 DE MAYO.xlsx"

cat("\n=========================================\n")

## 
## =========================================

cat("TOTAL DE ARCHIVOS:",length(archivos_excel),"\n")

## TOTAL DE ARCHIVOS: 13

cat("=========================================\n")

## =========================================

6 6. Catálogo de archivos

catalogo_archivos <- tibble(
  ruta = archivos_excel,
  archivo = basename(archivos_excel),
  semana = as.integer(
    str_extract(
      str_to_upper(basename(archivos_excel)),
      "(?<=SEMANA\\s)\\d+"
    )
  )
) |>
  filter(!is.na(semana)) |>
  arrange(semana)

if (nrow(catalogo_archivos) == 0) {
  stop(
    "Los archivos fueron encontrados, pero ninguno contiene ",
    "la palabra SEMANA seguida de un número en su nombre."
  )
}

knitr::kable(
  catalogo_archivos |> select(semana, archivo),
  col.names = c("Semana", "Archivo"),
  caption = "Sábanas identificadas"
)

Sábanas identificadas
Semana	Archivo
3	SEMANA 3. DEL 9-13 DE MARZO.xlsx
4	SEMANA 4 DEL 16 AL 20 DE MARZO.xlsx
5	SEMANA 5 DEL 23 AL 27 DE MARZO.xlsx
6	SEMANA 6 del 23 al 27 de marzo.xlsx
8	SEMANA 8 DEL 27-30 DE ABRIL.xlsx
9	SEMANA 9 DEL 4 AL 08 DE MAYO.xlsx
11	SEMANA 11 DEL 18-22 MAYO.xlsx
12	SEMANA 12 DEL 25- 29 MAYO.xlsx
14	SEMANA 14 DEL 08 AL 12 DE JUNIO.xlsx
15	SEMANA 15 DEL 15 AL 19UNIO.xlsx
16	SEMANA 16 DEL 20-24 JUNIO.xlsx
17	SEMANA 17 DE 29 JUNIO AL 03 JULIO.xlsx
18	SEMANA 18 JULIO 07.xlsx

7 7. Funciones de importación y limpieza

7.1 7.1 Identificar hojas de grupos

Las hojas válidas de grupo tienen nombres de tres dígitos, por ejemplo: 201, 407, 601 o 652.

obtener_hojas_grupo <- function(archivo) {
  excel_sheets(archivo) |>
    keep(~ str_detect(.x, "^\\d{3}$"))
}

7.2 7.2 Importar una hoja de grupo

importar_grupo <- function(archivo, hoja, semana) {

  bruto <- read_excel(
    path = archivo,
    sheet = hoja,
    col_names = FALSE
  )

  if (nrow(bruto) < 7 || ncol(bruto) < 5) {
    return(tibble())
  }

  encabezados <- as.character(unlist(bruto[6, ]))
  maximos <- suppressWarnings(as.numeric(unlist(bruto[4, ])))
  minimos <- suppressWarnings(as.numeric(unlist(bruto[5, ])))

  nombres_base <- c("vacio", "matricula", "alumno", "situacion")
  modulos <- encabezados[5:length(encabezados)]

  modulos[is.na(modulos) | modulos == ""] <- paste0(
    "modulo_sin_nombre_",
    which(is.na(modulos) | modulos == "")
  )

  nombres_columnas <- make.unique(
    c(nombres_base, modulos),
    sep = "_"
  )

  datos <- bruto[7:nrow(bruto), seq_along(nombres_columnas)]
  names(datos) <- nombres_columnas

  datos <- datos |>
    select(-vacio) |>
    mutate(
      matricula = as.character(matricula),
      alumno = as.character(alumno),
      situacion = as.character(situacion),
      grupo = as.character(hoja),
      semana = semana,
      archivo = basename(archivo)
    ) |>
    filter(
      !is.na(matricula),
      matricula != "",
      str_detect(matricula, "\\d")
    )

  columnas_modulos <- setdiff(
    names(datos),
    c("matricula", "alumno", "situacion", "grupo", "semana", "archivo")
  )

  tabla_limites <- tibble(
    modulo = nombres_columnas[5:length(nombres_columnas)],
    maximo = maximos[5:length(maximos)],
    minimo = minimos[5:length(minimos)]
  ) |>
    filter(!is.na(modulo), modulo != "")

  datos_largos <- datos |>
    pivot_longer(
      cols = all_of(columnas_modulos),
      names_to = "modulo",
      values_to = "calificacion"
    ) |>
    mutate(
      calificacion = suppressWarnings(as.numeric(calificacion))
    ) |>
    left_join(tabla_limites, by = "modulo") |>
    mutate(
      diferencia_minimo = calificacion - minimo,
      estatus_modulo = case_when(
        is.na(calificacion) ~ "Sin calificación",
        is.na(minimo) ~ "Sin mínimo definido",
        calificacion >= minimo ~ "Cumple mínimo",
        calificacion < minimo ~ "Por debajo del mínimo",
        TRUE ~ "Sin clasificación"
      )
    )

  datos_largos
}

7.3 7.3 Importar todos los grupos y semanas

base_modulos <- pmap_dfr(
  catalogo_archivos,
  function(ruta, archivo, semana) {

    hojas <- obtener_hojas_grupo(ruta)

    map_dfr(
      hojas,
      ~ importar_grupo(
        archivo = ruta,
        hoja = .x,
        semana = semana
      )
    )
  }
)

if (nrow(base_modulos) == 0) {
  stop("No fue posible importar registros de estudiantes.")
}

cat(
  "Registros módulo-estudiante importados:",
  format(nrow(base_modulos), big.mark = ",")
)

## Registros módulo-estudiante importados: 205,637

8 8. Validación de la base

# Verificar que el objeto base_modulos exista
if (!exists("base_modulos")) {
  stop(
    "El objeto 'base_modulos' no existe. ",
    "Ejecute primero el bloque 'importar_todos_grupos'."
  )
}

# Verificar que base_modulos tenga registros
if (!is.data.frame(base_modulos) || nrow(base_modulos) == 0) {
  stop(
    "La base 'base_modulos' está vacía. ",
    "Revise la importación de las hojas de grupo."
  )
}

# Verificar que existan las columnas necesarias
columnas_requeridas <- c(
  "semana",
  "grupo",
  "matricula",
  "modulo"
)

columnas_faltantes <- setdiff(
  columnas_requeridas,
  names(base_modulos)
)

if (length(columnas_faltantes) > 0) {
  stop(
    paste(
      "Faltan las siguientes columnas en base_modulos:",
      paste(columnas_faltantes, collapse = ", ")
    )
  )
}

# Crear tabla de validación
validacion <- data.frame(
  Indicador = c(
    "Semanas analizadas",
    "Grupos identificados",
    "Estudiantes únicos",
    "Módulos identificados",
    "Registros módulo-estudiante"
  ),
  Resultado = c(
    dplyr::n_distinct(base_modulos$semana, na.rm = TRUE),
    dplyr::n_distinct(base_modulos$grupo, na.rm = TRUE),
    dplyr::n_distinct(base_modulos$matricula, na.rm = TRUE),
    dplyr::n_distinct(base_modulos$modulo, na.rm = TRUE),
    nrow(base_modulos)
  )
)

# Mostrar tabla
knitr::kable(
  validacion,
  col.names = c("Indicador", "Resultado"),
  caption = "Validación general de la información importada",
  align = c("l", "r")
)

Validación general de la información importada
Indicador	Resultado
Semanas analizadas	13
Grupos identificados	35
Estudiantes únicos	1328
Módulos identificados	83
Registros módulo-estudiante	205637

9 9. Clasificación por estudiante y semana

Un estudiante se clasifica en riesgo cuando tiene al menos un módulo por debajo del porcentaje mínimo establecido para ese corte.

resumen_estudiante_semana <- base_modulos |>
  group_by(
    semana,
    grupo,
    matricula,
    alumno,
    situacion
  ) |>
  summarise(
    modulos_registrados = n_distinct(modulo),
    modulos_con_calificacion = sum(!is.na(calificacion)),
    modulos_sin_calificacion = sum(is.na(calificacion)),
    modulos_bajo_minimo = sum(
      estatus_modulo == "Por debajo del mínimo",
      na.rm = TRUE
    ),
    promedio_avance = mean(calificacion, na.rm = TRUE),
    riesgo = if_else(
      modulos_bajo_minimo > 0,
      "En riesgo",
      "Sin riesgo"
    ),
    .groups = "drop"
  ) |>
  mutate(
    promedio_avance = if_else(
      is.nan(promedio_avance),
      NA_real_,
      promedio_avance
    )
  )

10 10. Indicadores institucionales por semana

resumen_semanal <- resumen_estudiante_semana |>
  group_by(semana) |>
  summarise(
    matricula = n_distinct(matricula),
    estudiantes_en_riesgo = n_distinct(
      matricula[riesgo == "En riesgo"]
    ),
    estudiantes_sin_riesgo = matricula - estudiantes_en_riesgo,
    porcentaje_riesgo = estudiantes_en_riesgo / matricula * 100,
    promedio_modulos_bajo_minimo = mean(modulos_bajo_minimo),
    .groups = "drop"
  ) |>
  arrange(semana) |>
  mutate(
    cambio_pp = porcentaje_riesgo - lag(porcentaje_riesgo)
  )

tabla_resumen_semanal <- resumen_semanal |>
  mutate(
    porcentaje_riesgo = paste0(round(porcentaje_riesgo, 1), "%"),
    promedio_modulos_bajo_minimo = round(
      promedio_modulos_bajo_minimo,
      2
    ),
    cambio_pp = if_else(
      is.na(cambio_pp),
      NA_character_,
      paste0(round(cambio_pp, 1), " pp")
    )
  )

knitr::kable(
  tabla_resumen_semanal,
  col.names = c(
    "Semana",
    "Matrícula",
    "En riesgo",
    "Sin riesgo",
    "% en riesgo",
    "Promedio de módulos bajo mínimo",
    "Cambio semanal"
  ),
  caption = "Evolución institucional del riesgo académico"
)

Evolución institucional del riesgo académico
Semana	Matrícula	En riesgo	Sin riesgo	% en riesgo	Promedio de módulos bajo mínimo	Cambio semanal
3	1316	2	1314	0.2%	3.45	NA
4	1319	2	1317	0.2%	4.61	0 pp
5	1317	2	1315	0.2%	5.74	0 pp
6	1327	2	1325	0.2%	5.80	0 pp
8	1327	2	1325	0.2%	5.80	0 pp
9	1327	2	1325	0.2%	6.14	0 pp
11	1327	2	1325	0.2%	6.50	0 pp
12	1327	2	1325	0.2%	6.37	0 pp
14	1328	2	1326	0.2%	6.74	0 pp
15	1328	2	1326	0.2%	6.77	0 pp
16	1295	2	1293	0.2%	6.74	0 pp
17	1328	2	1326	0.2%	6.70	0 pp
18	1328	2	1326	0.2%	6.70	0 pp

11 11. Gráfica de evolución institucional

grafica_evolucion <- ggplot(
  resumen_semanal,
  aes(x = semana, y = porcentaje_riesgo)
) +
  geom_line(linewidth = 1) +
  geom_point(size = 3) +
  geom_text(
    aes(label = paste0(round(porcentaje_riesgo, 1), "%")),
    vjust = -0.8,
    size = 3.5
  ) +
  scale_x_continuous(
    breaks = resumen_semanal$semana
  ) +
  scale_y_continuous(
    labels = label_percent(scale = 1),
    expand = expansion(mult = c(0.05, 0.15))
  ) +
  labs(
    title = "Evolución del riesgo académico",
    subtitle = "Estudiantes con al menos un módulo por debajo del mínimo",
    x = "Semana",
    y = "Porcentaje de estudiantes en riesgo"
  ) +
  theme_minimal(base_size = 12)

grafica_evolucion

ggsave(
  file.path(carpeta_graficas, "evolucion_riesgo_academico.png"),
  grafica_evolucion,
  width = 11,
  height = 6,
  dpi = 300
)

12 12. Análisis por grupo

resumen_grupos <- resumen_estudiante_semana |>
  group_by(semana, grupo) |>
  summarise(
    matricula = n_distinct(matricula),
    estudiantes_en_riesgo = n_distinct(
      matricula[riesgo == "En riesgo"]
    ),
    porcentaje_riesgo = estudiantes_en_riesgo / matricula * 100,
    promedio_modulos_bajo_minimo = mean(modulos_bajo_minimo),
    .groups = "drop"
  ) |>
  mutate(
    semaforo = case_when(
      porcentaje_riesgo < 10 ~ "Verde",
      porcentaje_riesgo < 20 ~ "Amarillo",
      porcentaje_riesgo < 30 ~ "Naranja",
      TRUE ~ "Rojo"
    )
  )

12.1 12.1 Grupos críticos del último corte

ultima_semana <- max(resumen_grupos$semana, na.rm = TRUE)

grupos_criticos <- resumen_grupos |>
  filter(semana == ultima_semana) |>
  arrange(desc(porcentaje_riesgo)) |>
  slice_head(n = 10)

knitr::kable(
  grupos_criticos |>
    mutate(
      porcentaje_riesgo = paste0(
        round(porcentaje_riesgo, 1),
        "%"
      ),
      promedio_modulos_bajo_minimo = round(
        promedio_modulos_bajo_minimo,
        2
      )
    ),
  col.names = c(
    "Semana",
    "Grupo",
    "Matrícula",
    "En riesgo",
    "% en riesgo",
    "Promedio de módulos bajo mínimo",
    "Semáforo"
  ),
  caption = "Diez grupos con mayor riesgo en el último corte"
)

Diez grupos con mayor riesgo en el último corte
Semana	Grupo	Matrícula	En riesgo	% en riesgo	Promedio de módulos bajo mínimo	Semáforo
18	450	13	2	15.4%	2.85	Amarillo
18	652	17	2	11.8%	4.18	Amarillo
18	651	18	2	11.1%	1.39	Amarillo
18	650	19	2	10.5%	4.68	Amarillo
18	451	20	2	10%	4.80	Amarillo
18	607	36	2	5.6%	6.22	Verde
18	608	40	2	5%	6.22	Verde
18	407	41	2	4.9%	5.76	Verde
18	408	41	2	4.9%	6.02	Verde
18	212	42	2	4.8%	7.26	Verde

12.2 12.2 Gráfica de grupos críticos

grafica_grupos <- grupos_criticos |>
  mutate(grupo = fct_reorder(grupo, porcentaje_riesgo)) |>
  ggplot(
    aes(x = porcentaje_riesgo, y = grupo)
  ) +
  geom_col() +
  geom_text(
    aes(label = paste0(round(porcentaje_riesgo, 1), "%")),
    hjust = -0.1
  ) +
  scale_x_continuous(
    labels = label_percent(scale = 1),
    expand = expansion(mult = c(0, 0.15))
  ) +
  labs(
    title = paste("Grupos con mayor riesgo - Semana", ultima_semana),
    x = "Porcentaje de estudiantes en riesgo",
    y = "Grupo"
  ) +
  theme_minimal(base_size = 12)

grafica_grupos

13 13. Comparación del primer y último corte por grupo

primera_semana <- min(resumen_grupos$semana, na.rm = TRUE)

comparacion_grupos <- resumen_grupos |>
  filter(semana %in% c(primera_semana, ultima_semana)) |>
  select(semana, grupo, porcentaje_riesgo) |>
  pivot_wider(
    names_from = semana,
    values_from = porcentaje_riesgo,
    names_prefix = "semana_"
  )

col_inicial <- paste0("semana_", primera_semana)
col_final <- paste0("semana_", ultima_semana)

comparacion_grupos <- comparacion_grupos |>
  mutate(
    variacion_pp = .data[[col_final]] - .data[[col_inicial]],
    resultado = case_when(
      variacion_pp < 0 ~ "Mejoró",
      variacion_pp > 0 ~ "Empeoró",
      variacion_pp == 0 ~ "Sin cambio",
      TRUE ~ "Sin comparación"
    )
  ) |>
  arrange(variacion_pp)

knitr::kable(
  comparacion_grupos |>
    mutate(
      across(
        starts_with("semana_"),
        ~ paste0(round(.x, 1), "%")
      ),
      variacion_pp = paste0(round(variacion_pp, 1), " pp")
    ),
  caption = paste(
    "Comparación de grupos entre las semanas",
    primera_semana,
    "y",
    ultima_semana
  )
)

Comparación de grupos entre las semanas 3 y 18
grupo	semana_3	semana_18	variacion_pp	resultado
211	4.5%	4.3%	-0.3 pp	Mejoró
408	5.1%	4.9%	-0.3 pp	Mejoró
208	3.8%	3.7%	-0.1 pp	Mejoró
411	4.3%	4.2%	-0.1 pp	Mejoró
202	3.5%	3.4%	-0.1 pp	Mejoró
204	3.5%	3.4%	-0.1 pp	Mejoró
410	3.5%	3.4%	-0.1 pp	Mejoró
405	3.2%	3.1%	0 pp	Mejoró
207	3.1%	3.1%	0 pp	Mejoró
201	3.2%	3.2%	0 pp	Sin cambio
203	3.4%	3.4%	0 pp	Sin cambio
205	3.6%	3.6%	0 pp	Sin cambio
206	3.7%	3.7%	0 pp	Sin cambio
209	4.2%	4.2%	0 pp	Sin cambio
212	4.8%	4.8%	0 pp	Sin cambio
401	4.3%	4.3%	0 pp	Sin cambio
402	3.9%	3.9%	0 pp	Sin cambio
404	4.4%	4.4%	0 pp	Sin cambio
406	4.7%	4.7%	0 pp	Sin cambio
407	4.9%	4.9%	0 pp	Sin cambio
450	15.4%	15.4%	0 pp	Sin cambio
451	10%	10%	0 pp	Sin cambio
601	3.5%	3.5%	0 pp	Sin cambio
603	4.2%	4.2%	0 pp	Sin cambio
605	3%	3%	0 pp	Sin cambio
607	5.6%	5.6%	0 pp	Sin cambio
608	5%	5%	0 pp	Sin cambio
609	4.8%	4.8%	0 pp	Sin cambio
611	4.7%	4.7%	0 pp	Sin cambio
650	10.5%	10.5%	0 pp	Sin cambio
651	11.1%	11.1%	0 pp	Sin cambio
652	11.8%	11.8%	0 pp	Sin cambio
604	3.8%	3.8%	0.1 pp	Empeoró
403	4.2%	4.3%	0.1 pp	Empeoró
210	4.3%	4.3%	0.1 pp	Empeoró

14 14. Análisis por módulo

resumen_modulos <- base_modulos |>
  filter(!is.na(calificacion), !is.na(minimo)) |>
  group_by(semana, modulo) |>
  summarise(
    estudiantes_evaluados = n_distinct(matricula),
    estudiantes_bajo_minimo = n_distinct(
      matricula[estatus_modulo == "Por debajo del mínimo"]
    ),
    porcentaje_bajo_minimo =
      estudiantes_bajo_minimo / estudiantes_evaluados * 100,
    promedio_calificacion = mean(calificacion, na.rm = TRUE),
    minimo_esperado = median(minimo, na.rm = TRUE),
    .groups = "drop"
  )

14.1 14.1 Módulos críticos del último corte

modulos_criticos <- resumen_modulos |>
  filter(semana == ultima_semana) |>
  arrange(desc(porcentaje_bajo_minimo)) |>
  slice_head(n = 15)

knitr::kable(
  modulos_criticos |>
    mutate(
      porcentaje_bajo_minimo = paste0(
        round(porcentaje_bajo_minimo, 1),
        "%"
      ),
      promedio_calificacion = round(promedio_calificacion, 2),
      minimo_esperado = round(minimo_esperado, 2)
    ),
  col.names = c(
    "Semana",
    "Módulo",
    "Evaluados",
    "Bajo mínimo",
    "% bajo mínimo",
    "Promedio acumulado",
    "Mínimo esperado"
  ),
  caption = "Módulos con mayor porcentaje de estudiantes bajo el mínimo"
)

Módulos con mayor porcentaje de estudiantes bajo el mínimo
Semana	Módulo	Evaluados	Bajo mínimo	% bajo mínimo	Promedio acumulado	Mínimo esperado
18	60_8	831	781	94%	78.23	100
18	60_9	514	476	92.6%	73.90	100
18	60_3	1276	1173	91.9%	76.73	100
18	60_1	1284	1179	91.8%	85.62	100
18	60_6	1277	1172	91.8%	77.38	100
18	60_5	1278	1138	89%	79.38	100
18	60_2	1277	1134	88.8%	78.40	100
18	60_10	514	453	88.1%	76.51	100
18	60	1278	1107	86.6%	81.03	100
18	60_4	1286	1055	82%	78.94	100
18	60_7	1277	1036	81.1%	80.88	100

15 15. Estudiantes prioritarios del último corte

Se consideran prioritarios los estudiantes con mayor número de módulos por debajo del mínimo.

estudiantes_prioritarios <- resumen_estudiante_semana |>
  filter(
    semana == ultima_semana,
    modulos_bajo_minimo > 0
  ) |>
  arrange(
    desc(modulos_bajo_minimo),
    grupo,
    alumno
  ) |>
  slice_head(n = 50)

knitr::kable(
  estudiantes_prioritarios |>
    select(
      grupo,
      matricula,
      alumno,
      situacion,
      modulos_con_calificacion,
      modulos_sin_calificacion,
      modulos_bajo_minimo,
      promedio_avance
    ) |>
    mutate(
      promedio_avance = round(promedio_avance, 2)
    ),
  col.names = c(
    "Grupo",
    "Matrícula",
    "Alumno",
    "Situación",
    "Módulos con calificación",
    "Módulos sin calificación",
    "Módulos bajo mínimo",
    "Promedio acumulado"
  ),
  caption = paste(
    "Estudiantes prioritarios de la semana",
    ultima_semana
  )
)

Estudiantes prioritarios de la semana 18
Grupo	Matrícula	Alumno	Situación	Módulos con calificación	Módulos sin calificación	Módulos bajo mínimo	Promedio acumulado
201	251990033-2	ALEJO TORRES *YATZIRI ITZEL	REGULAR	11	0	11	67.90
201	251990337-7	ANGELES DE JESUS *JUAN PABLO	REGULAR	11	0	11	83.65
201	251990094-4	BAZAN CARRILLO *OSVALDO	REGULAR	11	0	11	89.30
201	251990111-6	BRAGADO HERNANDEZ *JESUS EDUARDO	REGULAR	11	0	11	64.76
201	251990036-5	CASTELLANOS OLVERA *KEVIN	NO REGULAR	11	0	11	56.27
201	251990021-7	CENTENO RUBIO *LUIS ANGEL	REGULAR	11	0	11	75.33
201	251990170-2	DEL CAMPO FLORES *CRISTIAN	NO REGULAR	11	0	11	64.44
201	251990009-2	DORANTES ALDAMA *SANDRA YOSELIN	REGULAR	11	0	11	87.85
201	251990202-3	ESCUTIA CORRAL *JOSE LUIS	REGULAR	11	0	11	82.45
201	251990401-1	GARCIA HERNANDEZ *BRITTANY	REGULAR	11	0	11	72.22
201	251990189-2	GARCIA VALDEZ *MARCO EMILIANO	REGULAR	11	0	11	89.67
201	251990048-0	GAYTAN ZARCO *ALEXANDRA	REGULAR	11	0	11	73.76
201	251990299-9	GONZALEZ FLORES *MIRANDA	REGULAR	11	0	11	80.46
201	251990069-6	GONZALEZ MARIN *ALEXA ESMERALDA	REGULAR	11	0	11	67.85
201	251990076-1	GONZALEZ OSEGUERA *ALAN YAEL	REGULAR	11	0	11	75.11
201	251990180-1	GONZALEZ SORIANO *JUAN CARLOS	NO REGULAR	11	0	11	50.95
201	251990315-3	GUTIERREZ BALTAZAR *FATIMA RUBI	REGULAR	11	0	11	84.99
201	251990161-1	JUAREZ CALIXTO *ANGEL SANTIAGO	REGULAR	11	0	11	82.73
201	251990107-4	MARTINEZ ROBLES *AXEL	NO REGULAR	11	0	11	34.18
201	251990158-7	MERCADO ORTIZ *BRAULIO SALVADOR	REGULAR	11	0	11	81.43
201	251990229-6	MORIN GONZALEZ *JENNIFER VALERIA	REGULAR	11	0	11	74.20
201	251990491-2	NUÑEZ TOVAR *ROLANDO	REGULAR	11	0	11	76.94
201	251990290-8	RIVERA CONTRERAS *AMERICA PALOMA	REGULAR	11	0	11	76.20
201	251990207-2	ROJAS SANCHEZ *JOSHUA MICHAEL	NO REGULAR	11	0	11	60.64
201	251990492-0	VILCHIS ANTONIO *DONOVAN	NO REGULAR	11	0	11	57.74
201	251990261-9	ZEPEDA CASTILLO *MAYTE	REGULAR	11	0	11	78.00
202	251990071-2	BERNAL SALAZAR *DULCE GUADALUPE	REGULAR	11	1	11	67.54
202	251990293-2	GOMEZ ROMERO *JOSEPH ADRIAN	NO REGULAR	11	1	11	44.89
202	251990120-7	GONZALEZ HERNANDEZ *ALEXIS ARMANDO	REGULAR	11	1	11	72.70
202	251990065-4	GONZALEZ SANCHEZ *SAHIRA YADARI	NO REGULAR	11	1	11	63.45
202	251990172-8	GUTIERREZ ROJAS *ISMAEL	NO REGULAR	11	1	11	36.71
202	251990155-3	MARTINEZ POMPA *GUSTAVO EDUARDO	NO REGULAR	11	1	11	17.01
202	251990130-6	MARTINEZ REYES *LESLIE	REGULAR	11	1	11	69.61
202	251990128-0	MENDOZA MIRANDA *REGINA ZOE	REGULAR	11	1	11	71.09
202	251990082-9	MIGUEL CRUZ *MARLID GUADALUPE	NO REGULAR	11	1	11	62.26
202	251990141-3	MOTA ASTIVIA *NATALIA	REGULAR	11	1	11	73.54
202	251990050-6	OCAÑA ESTRADA *CHRISTIAN	REGULAR	11	1	11	79.74
202	251990135-5	PARRA MORENO *JONATHAN ISAEL	REGULAR	11	1	11	75.11
202	251990114-0	PEREZ HERNANDEZ *ABDIEL	REGULAR	11	1	11	69.63
202	251990061-3	PEREZ MARTINEZ *SCHANTAL ESTRELLA	NO REGULAR	11	1	11	39.35
202	171990181-9	RANGEL ORTEGA *CRISTOPHER ALDAIR	REGULAR	11	1	11	69.60
202	251990185-0	REYES HERNANDEZ *CHRISTIAN	REGULAR	11	1	11	67.58
202	251990191-8	REYES OSOÑOZ *YHAVE GABRIEL	REGULAR	11	1	11	73.15
202	251990228-8	RODRIGUEZ SALGUERO *EMMANUEL	REGULAR	11	1	11	77.39
202	251990098-5	SAAVEDRA HERNANDEZ *EMMANUEL	REGULAR	11	1	11	76.86
202	251990154-6	SANCHEZ GUTIERREZ *EMILIANO	REGULAR	11	1	11	69.67
202	251990166-0	SANCHEZ PAREDES *JULIO ANDRES	NO REGULAR	11	1	11	57.69
203	251990259-3	ARVIZU SUAREZ *EDUARDO	REGULAR	11	1	11	67.00
203	251990529-9	BARAJAS PERALTA *JOSE LEONARDO	NO REGULAR	11	1	11	56.62
203	251990277-5	BECERRIL ALEJANDRO *ABRIL	REGULAR	11	1	11	88.13

16 16. Situación académica registrada

resumen_situacion <- resumen_estudiante_semana |>
  mutate(
    situacion = if_else(
      is.na(situacion) | situacion == "",
      "Sin situación",
      str_to_title(str_to_lower(situacion))
    )
  ) |>
  group_by(semana, situacion) |>
  summarise(
    estudiantes = n_distinct(matricula),
    .groups = "drop"
  )

knitr::kable(
  resumen_situacion |>
    filter(semana == ultima_semana) |>
    arrange(desc(estudiantes)),
  col.names = c("Semana", "Situación", "Estudiantes"),
  caption = "Situación académica registrada en el último corte"
)

Situación académica registrada en el último corte
Semana	Situación	Estudiantes
18	Regular	1169
18	No Regular	110
18	0	44
18	1	30
18	4	19
18	3	18
18	5	11
18	2	8
18	12	3
18	6	3
18	7	3
18	9	2
18	10	1
18	15	1
18	16	1
18	24	1
18	28	1
18	8	1

17 17. Reprobación por docente

La hoja REPROBACION POR DOCENTE contiene cantidades de estudiantes reprobados por combinación docente-grupo. Estos datos no representan alumnos únicos institucionales, porque un estudiante puede ser contabilizado en más de un módulo o con más de un docente.

importar_docentes <- function(archivo, semana) {

  hojas <- readxl::excel_sheets(archivo)

  # Normalizar nombres de hojas para ignorar acentos
  hojas_normalizadas <- iconv(
    toupper(hojas),
    from = "",
    to = "ASCII//TRANSLIT"
  )

  posicion <- which(
    grepl("REPROBACION.*DOCENTE", hojas_normalizadas)
  )

  if (length(posicion) == 0) {
    return(tibble::tibble())
  }

  hoja_docente <- hojas[posicion[1]]

  bruto <- readxl::read_excel(
    path = archivo,
    sheet = hoja_docente,
    col_names = FALSE,
    .name_repair = "minimal"
  )

  if (nrow(bruto) < 4 || ncol(bruto) < 3) {
    return(tibble::tibble())
  }

  # Convertir a data.frame para asignar nombres sin errores de tibble
  bruto <- as.data.frame(
    bruto,
    stringsAsFactors = FALSE,
    check.names = FALSE
  )

  total_columnas <- ncol(bruto)

  grupos <- as.character(
    unlist(
      bruto[3, 3:total_columnas, drop = TRUE],
      use.names = FALSE
    )
  )

  grupos <- trimws(grupos)

  grupos_vacios <- is.na(grupos) | grupos == "" | grupos == "NA"

  if (any(grupos_vacios)) {
    grupos[grupos_vacios] <- paste0(
      "grupo_sin_nombre_",
      seq_len(sum(grupos_vacios))
    )
  }

  grupos <- make.unique(grupos, sep = "_")

  matricula_grupo <- suppressWarnings(
    as.numeric(
      unlist(
        bruto[2, 3:total_columnas, drop = TRUE],
        use.names = FALSE
      )
    )
  )

  datos <- bruto[
    4:nrow(bruto),
    seq_len(total_columnas),
    drop = FALSE
  ]

  nombres_columnas <- c(
    "cvo",
    "docente",
    grupos
  )

  # Ajuste defensivo del número de nombres
  if (length(nombres_columnas) > ncol(datos)) {
    nombres_columnas <- nombres_columnas[
      seq_len(ncol(datos))
    ]
  }

  if (length(nombres_columnas) < ncol(datos)) {
    faltantes <- ncol(datos) - length(nombres_columnas)

    nombres_columnas <- c(
      nombres_columnas,
      paste0("columna_adicional_", seq_len(faltantes))
    )
  }

  names(datos) <- nombres_columnas

  datos <- tibble::as_tibble(
    datos,
    .name_repair = "unique"
  )

  if (!all(c("cvo", "docente") %in% names(datos))) {
    return(tibble::tibble())
  }

  datos <- datos |>
    dplyr::mutate(
      cvo = suppressWarnings(as.numeric(cvo)),
      docente = trimws(as.character(docente))
    ) |>
    dplyr::filter(
      !is.na(docente),
      docente != "",
      toupper(docente) != "NOMBRE DEL DOCENTE/ GRUPO"
    )

  columnas_grupos <- setdiff(
    names(datos),
    c("cvo", "docente")
  )

  if (length(columnas_grupos) == 0) {
    return(tibble::tibble())
  }

  resultado <- datos |>
    tidyr::pivot_longer(
      cols = dplyr::all_of(columnas_grupos),
      names_to = "grupo",
      values_to = "reprobados"
    ) |>
    dplyr::mutate(
      reprobados = suppressWarnings(
        as.numeric(reprobados)
      ),
      semana = semana,
      archivo = basename(archivo)
    ) |>
    dplyr::filter(
      !is.na(reprobados),
      reprobados >= 0
    )

  tabla_matricula <- tibble::tibble(
    grupo = grupos,
    matricula_grupo = matricula_grupo
  )

  resultado <- resultado |>
    dplyr::left_join(
      tabla_matricula,
      by = "grupo"
    ) |>
    dplyr::mutate(
      porcentaje_grupo = dplyr::if_else(
        !is.na(matricula_grupo) &
          matricula_grupo > 0,
        reprobados / matricula_grupo * 100,
        NA_real_
      )
    )

  resultado
}

base_docentes <- purrr::map2_dfr(
  catalogo_archivos$ruta,
  catalogo_archivos$semana,
  function(ruta_actual, semana_actual) {

    tryCatch(
      importar_docentes(
        archivo = ruta_actual,
        semana = semana_actual
      ),
      error = function(e) {

        message(
          "No fue posible importar la hoja de docentes de ",
          basename(ruta_actual),
          ": ",
          conditionMessage(e)
        )

        tibble::tibble()
      }
    )
  }
)

if (nrow(base_docentes) > 0) {

  resumen_docentes <- base_docentes |>
    dplyr::group_by(semana, docente) |>
    dplyr::summarise(
      grupos_con_registro = dplyr::n_distinct(grupo),
      suma_reprobados = sum(reprobados, na.rm = TRUE),
      promedio_por_grupo = mean(reprobados, na.rm = TRUE),
      .groups = "drop"
    )

  ultima_semana_docentes <- max(
    resumen_docentes$semana,
    na.rm = TRUE
  )

  docentes_ultimo_corte <- resumen_docentes |>
    dplyr::filter(
      semana == ultima_semana_docentes
    ) |>
    dplyr::arrange(
      dplyr::desc(suma_reprobados)
    ) |>
    dplyr::slice_head(n = 15)

  knitr::kable(
    docentes_ultimo_corte |>
      dplyr::mutate(
        promedio_por_grupo = round(
          promedio_por_grupo,
          2
        )
      ),
    col.names = c(
      "Semana",
      "Docente",
      "Grupos con registro",
      "Suma de registros reprobados",
      "Promedio por grupo"
    ),
    caption = paste(
      "Registros de reprobación por docente - Semana",
      ultima_semana_docentes
    )
  )

} else {

  cat(
    "No se localizaron registros válidos en las hojas ",
    "'REPROBACIÓN POR DOCENTE'. El resto del análisis ",
    "puede continuar normalmente."
  )
}

## No se localizaron registros válidos en las hojas  'REPROBACIÓN POR DOCENTE'. El resto del análisis  puede continuar normalmente.

18 18. Indicadores ejecutivos del último corte

indicador_ultima_semana <- resumen_semanal |>
  filter(semana == ultima_semana)

indicadores <- tibble(
  Indicador = c(
    "Semana analizada",
    "Matrícula identificada",
    "Estudiantes en riesgo",
    "Estudiantes sin riesgo",
    "Porcentaje de riesgo",
    "Grupos en semáforo rojo",
    "Módulos analizados"
  ),
  Resultado = c(
    ultima_semana,
    indicador_ultima_semana$matricula,
    indicador_ultima_semana$estudiantes_en_riesgo,
    indicador_ultima_semana$estudiantes_sin_riesgo,
    paste0(
      round(indicador_ultima_semana$porcentaje_riesgo, 1),
      "%"
    ),
    sum(
      resumen_grupos$semana == ultima_semana &
        resumen_grupos$semaforo == "Rojo"
    ),
    n_distinct(
      base_modulos$modulo[
        base_modulos$semana == ultima_semana
      ]
    )
  )
)

knitr::kable(
  indicadores,
  caption = "Indicadores ejecutivos del último corte"
)

Indicadores ejecutivos del último corte
Indicador	Resultado
Semana analizada	18
Matrícula identificada	1328
Estudiantes en riesgo	2
Estudiantes sin riesgo	1326
Porcentaje de riesgo	0.2%
Grupos en semáforo rojo	0
Módulos analizados	16

19 19. Exportación de resultados

hojas_salida <- list(
  "Base módulos" = base_modulos,
  "Estudiante semana" = resumen_estudiante_semana,
  "Resumen semanal" = resumen_semanal,
  "Resumen grupos" = resumen_grupos,
  "Comparación grupos" = comparacion_grupos,
  "Resumen módulos" = resumen_modulos,
  "Estudiantes prioritarios" = estudiantes_prioritarios,
  "Situación académica" = resumen_situacion
)

if (exists("base_docentes") && nrow(base_docentes) > 0) {
  hojas_salida[["Base docentes"]] <- base_docentes
  hojas_salida[["Resumen docentes"]] <- resumen_docentes
}

archivo_resultados <- file.path(
  carpeta_resultados,
  "analisis_cortes_calificaciones.xlsx"
)

openxlsx::write.xlsx(
  hojas_salida,
  file = archivo_resultados,
  overwrite = TRUE
)

cat("Archivo generado:", archivo_resultados)

## Archivo generado: C:/Users/Quimica/Downloads/Reprobacion Lerma/resultados/analisis_cortes_calificaciones.xlsx

20 20. Conclusiones automáticas

primero <- resumen_semanal |>
  filter(semana == primera_semana)

ultimo <- resumen_semanal |>
  filter(semana == ultima_semana)

variacion_institucional <- ultimo$porcentaje_riesgo -
  primero$porcentaje_riesgo

cat("## Resultado institucional\n\n")

20.1 Resultado institucional

cat(
  "Entre la semana **", primera_semana,
  "** y la semana **", ultima_semana,
  "**, el porcentaje de estudiantes en riesgo pasó de **",
  round(primero$porcentaje_riesgo, 1),
  "%** a **",
  round(ultimo$porcentaje_riesgo, 1),
  "%**.\n\n",
  sep = ""
)

Entre la semana 3 y la semana 18, el porcentaje de estudiantes en riesgo pasó de 0.2% a 0.2%.

if (variacion_institucional < 0) {

  cat(
    "Se observa una **disminución de ",
    abs(round(variacion_institucional, 1)),
    " puntos porcentuales**, lo cual representa una mejora institucional.\n\n",
    sep = ""
  )

} else if (variacion_institucional > 0) {

  cat(
    "Se observa un **incremento de ",
    round(variacion_institucional, 1),
    " puntos porcentuales**, por lo que se recomienda fortalecer el seguimiento académico.\n\n",
    sep = ""
  )

} else {

  cat(
    "El porcentaje institucional de riesgo se mantuvo sin cambios.\n\n"
  )
}

Se observa una disminución de 0 puntos porcentuales, lo cual representa una mejora institucional.

cat("## Recomendaciones\n\n")

20.2 Recomendaciones

cat(
  "1. Dar seguimiento prioritario a los grupos clasificados en semáforo rojo.\n",
  "2. Revisar individualmente a los estudiantes con mayor número de módulos bajo el mínimo.\n",
  "3. Diferenciar los casos con calificación baja de aquellos sin calificación registrada.\n",
  "4. Establecer estrategias de recuperación por módulo y grupo.\n",
  "5. Comparar semanalmente la variación del porcentaje de riesgo.\n",
  "6. No sumar la reprobación por docente como si fueran estudiantes únicos.\n",
  "7. Documentar las acciones de seguimiento y sus resultados en cada corte.\n",
  sep = ""
)

Dar seguimiento prioritario a los grupos clasificados en semáforo rojo.
Revisar individualmente a los estudiantes con mayor número de módulos bajo el mínimo.
Diferenciar los casos con calificación baja de aquellos sin calificación registrada.
Establecer estrategias de recuperación por módulo y grupo.
Comparar semanalmente la variación del porcentaje de riesgo.
No sumar la reprobación por docente como si fueran estudiantes únicos.
Documentar las acciones de seguimiento y sus resultados en cada corte.

Análisis de Reprobación CONALEP Lerma 2026

Jorge Noé Gámez Mora

2026-08-04