feat: Shiny app for prep1cho

DESCRIPTION

@@ -18,6 +18,7 @@ RoxygenNote: 7.3.3
 Depends:
     R (>= 4.1.0)
 Imports:
+    cli,
     data.table,
     dplyr (>= 1.1.0),
     fst,
@@ -30,9 +31,13 @@ Imports:
     tidyr,
     tools
 Suggests:
+    bslib,
+    DT,
+    ggplot2,
     LaF,
     dataReporter,
     quarto,
+    shiny,
     testthat (>= 3.0.0),
     knitr,
     rmarkdown

NAMESPACE

@@ -3,11 +3,13 @@
 export(audit_enrollments)
 export(combine_enrollments_calculations)
 export(combine_enrollments_final)
+export(detect_metadata)
 export(combine_enrollments_rio)
 export(get_rio)
 export(prepare_enrollments_mapping)
 export(prepare_enrollments_supplemental)
 export(prepare_rio)
+export(run_app)
 export(run_pipeline)
 importFrom(stats,setNames)
 importFrom(utils,read.csv)

R/pipeline.R

@@ -10,9 +10,10 @@
 #' @param enrollments Data frame met 1CHO inschrijvingsgegevens (EV-bestand)
 #' @param rio_data Optioneel: Data frame met RIO referentiedata. Als NULL, wordt
 #'   RIO data automatisch gedownload.
-#' @param year Academisch jaar voor maximale datum. Standaard: 2024
-#' @param institution_brin BRIN code van de instelling. Standaard: "21XX"
-#' @param create_synthetic Logisch. Maak synthetische test rows? Standaard: TRUE
+#' @param year Academisch jaar. Als NULL, wordt het maximale inschrijvingsjaar
+#'   uit de data gedetecteerd.
+#' @param institution_brin BRIN code van de instelling. Als NULL, wordt de
+#'   meest voorkomende instellingscode uit de data gedetecteerd.
 #' @param download_rio Logisch. Download fresh RIO data? Standaard: FALSE
 #'
 #' @return Data frame met verrijkte inschrijvingsgegevens
@@ -24,15 +25,14 @@
 #'   # Laad 1CHO inschrijvingsgegevens
 #'   enrollments <- read.csv2("EV299XX24_DEMO_decoded.csv")
 #'
-#'   # Voer pipeline uit met standaard instellingen
+#'   # Voer pipeline uit - year en BRIN worden automatisch gedetecteerd
 #'   data <- run_pipeline(enrollments)
 #'
-#'   # Voor specifieke instelling en jaar
+#'   # Of specificeer handmatig
 #'   data <- run_pipeline(
 #'     enrollments,
 #'     year = 2024,
-#'     institution_brin = "21PL",
-#'     create_synthetic = FALSE
+#'     institution_brin = "21PL"
 #'   )
 #'
 #'   # Bekijk resultaat
@@ -43,11 +43,27 @@
 #' }
 run_pipeline <- function(enrollments,
                         rio_data = NULL,
-                        year = 2024,
-                        institution_brin = "21XX",
-                        create_synthetic = TRUE,
+                        year = NULL,
+                        institution_brin = NULL,
                         download_rio = FALSE) {
 
+  ## Auto-detect year and BRIN from data if not provided
+  if (is.null(year) || is.null(institution_brin)) {
+    meta <- detect_metadata(enrollments)
+
+    if (is.null(year)) {
+      year <- meta$year %||% as.integer(format(Sys.Date(), "%Y"))
+      message("Detected year: ", year)
+    }
+    if (is.null(institution_brin)) {
+      institution_brin <- meta$institution_brin %||% "21XX"
+      message("Detected BRIN: ", institution_brin)
+    }
+  }
+
+  ## Synthetic rows only needed for demo BRIN
+  create_synthetic <- institution_brin == "21XX"
+
   message("\n========================================")
   message("PREP1CHO Pipeline")
   message("========================================")

R/prepare.R

@@ -164,17 +164,24 @@ prepare_enrollments_mapping <- function(enrollments) {
   }
 
   # Convert date columns first (needed for later calculations)
+  # Source data may have dates as YYYYMMDD integers, dd/mm/yyyy, or dd-mm-yyyy
+  parse_date_flexible <- function(x) {
+    if (is.numeric(x)) {
+      return(as.Date(as.character(x), format = "%Y%m%d"))
+    }
+    as.Date(x, tryFormats = c("%d/%m/%Y", "%d-%m-%Y", "%Y%m%d", "%Y-%m-%d"))
+  }
+
   enrollments <- enrollments |>
     dplyr::mutate(
-      INS_Datum_inschrijving = as.Date(
-        INS_Datum_inschrijving,
-        format = "%d/%m/%Y",
-        tryFormats = c("%d/%m/%Y", "%d-%m-%Y")
+      INS_Datum_inschrijving = parse_date_flexible(
+        INS_Datum_inschrijving
+      ),
+      INS_Datum_uitschrijving = parse_date_flexible(
+        INS_Datum_uitschrijving
       ),
-      INS_Datum_uitschrijving = as.Date(
-        INS_Datum_uitschrijving,
-        format = "%d/%m/%Y",
-        tryFormats = c("%d/%m/%Y", "%d-%m-%Y")
+      INS_Datum_tekening_diploma = parse_date_flexible(
+        INS_Datum_tekening_diploma
       )
     )
 

R/run_app.R

@@ -0,0 +1,19 @@
+#' Start de prep1cho Shiny app
+#'
+#' Interactieve data verkenner voor prep1cho pipeline output.
+#' Upload een CSV of FST bestand, of gebruik automatisch de synthetische data.
+#'
+#' @param ... Extra argumenten doorgegeven aan [shiny::runApp()].
+#'
+#' @return Onzichtbaar. Wordt aangeroepen voor het starten van de app.
+#' @export
+run_app <- function(...) {
+  if (!requireNamespace("shiny", quietly = TRUE)) {
+    cli::cli_abort("Package {.pkg shiny} is nodig. Installeer met: {.code install.packages('shiny')}")
+  }
+  app_dir <- system.file("app", package = "prep1cho")
+  if (app_dir == "") {
+    cli::cli_abort("Kan de Shiny app niet vinden. Is {.pkg prep1cho} correct geinstalleerd?")
+  }
+  shiny::runApp(app_dir, ...)
+}

R/utils.R

@@ -38,6 +38,46 @@ academic_year <- function(date) {
 }
 
 
+#' Detecteer metadata uit inschrijvingsdata
+#'
+#' Detecteert de BRIN code van de instelling en het academisch jaar uit
+#' een inschrijvings data frame. Werkt met zowel ruwe 1CHO kolomnamen
+#' (lowercase) als vertaalde kolomnamen (INS_ prefix).
+#'
+#' @param enrollments Data frame met inschrijvingsgegevens
+#'
+#' @return Lijst met:
+#'   \item{year}{Maximaal inschrijvingsjaar, of NULL als niet gevonden}
+#'   \item{institution_brin}{Meest voorkomende BRIN code, of NULL als niet gevonden}
+#'
+#' @export
+detect_metadata <- function(enrollments) {
+  year_col <- intersect(
+    c("inschrijvingsjaar", "INS_Inschrijvingsjaar"),
+    names(enrollments)
+  )
+  brin_col <- intersect(
+    c("instellingscode", "INS_Instelling"),
+    names(enrollments)
+  )
+
+  year <- if (length(year_col) > 0) {
+    max(enrollments[[year_col[1]]], na.rm = TRUE)
+  } else {
+    NULL
+  }
+
+  brin <- if (length(brin_col) > 0) {
+    freq <- sort(table(enrollments[[brin_col[1]]]), decreasing = TRUE)
+    names(freq)[1]
+  } else {
+    NULL
+  }
+
+  return(list(year = year, institution_brin = brin))
+}
+
+
 #' Ruim objecten op uit environment
 #' @keywords internal
 clear_script_objects <- function(keep = NULL) {