# =============================================================================
# Program:  00_run_driver.R
# Purpose:  Controlled execution driver (submission-grade pattern).
# Author:   Jonathan D. Stallings, PhD, MS
# Notes:    Centralizes parameters, runs build + QC, writes manifest + session.
# =============================================================================

study_id <- "STUDY-XYZ"

root <- "path/to/project"
paths <- list(
  sdtm_dm = file.path(root, "data/sdtm/dm.csv"),
  sdtm_ex = file.path(root, "data/sdtm/ex.csv"),
  adam_adsl = file.path(root, "data/adam/adsl.csv"),
  out_dir = file.path(root, "outputs"),
  log_dir = file.path(root, "outputs/logs"),
  man_dir = file.path(root, "outputs/manifests"),
  qc_dir  = file.path(root, "outputs/qc")
)

dir.create(paths$out_dir, recursive = TRUE, showWarnings = FALSE)
dir.create(paths$log_dir, recursive = TRUE, showWarnings = FALSE)
dir.create(paths$man_dir, recursive = TRUE, showWarnings = FALSE)
dir.create(paths$qc_dir,  recursive = TRUE, showWarnings = FALSE)

stop_if_missing <- function(p) {
  if (!file.exists(p)) stop(sprintf("Missing required input: %s", p), call. = FALSE)
}

stop_if_missing(paths$sdtm_dm)
stop_if_missing(paths$sdtm_ex)

run_dttm_utc <- format(Sys.time(), tz = "UTC", usetz = TRUE)
run_id <- gsub("[^0-9]", "", run_dttm_utc)

# Source build + QC scripts
source(file.path(root, "programs/r/01_build_adsl.R"))
source(file.path(root, "programs/r/02_qc_adsl.R"))

# Write run manifest + session info
manifest <- data.frame(
  run_id = run_id,
  run_dttm_utc = run_dttm_utc,
  study_id = study_id,
  sdtm_dm = paths$sdtm_dm,
  sdtm_ex = paths$sdtm_ex,
  adam_adsl = paths$adam_adsl,
  stringsAsFactors = FALSE
)

write.csv(manifest, file.path(paths$man_dir, paste0("run_manifest_r_", run_id, ".csv")), row.names = FALSE)
capture.output(sessionInfo(), file = file.path(paths$man_dir, paste0("sessionInfo_", run_id, ".txt")))

# =============================================================================
# Program:  01_build_adsl.R
# Purpose:  Build ADaM ADSL from SDTM-like DM/EX (submission-grade pattern).
# Inputs:   dm.csv, ex.csv
# Output:   adsl.csv
# Assump:   ISO 8601 dates; 1 primary treatment per subject (simplified).
# =============================================================================

# Explicit namespaces (portable across environments)
dm_path <- paths$sdtm_dm
ex_path <- paths$sdtm_ex
adsl_path <- paths$adam_adsl

iso_to_date <- function(x) {
  if (all(is.na(x))) return(as.Date(rep(NA, length(x))))
  as.Date(substr(x, 1, 10))
}

assert_cols <- function(df, cols, name) {
  missing <- setdiff(cols, names(df))
  if (length(missing) > 0) {
    stop(sprintf("Missing required columns in %s: %s", name, paste(missing, collapse = ", ")), call. = FALSE)
  }
}

stop_if_dups <- function(df, key, out_csv) {
  tab <- df |>
    dplyr::count(dplyr::across(dplyr::all_of(key))) |>
    dplyr::filter(.data$n > 1)

  if (nrow(tab) > 0) {
    readr::write_csv(tab, out_csv)
    stop(sprintf("Duplicate key(s) detected by %s. See: %s", paste(key, collapse = ", "), out_csv), call. = FALSE)
  }
}

dm <- readr::read_csv(dm_path, show_col_types = FALSE) |>
  dplyr::filter(.data$STUDYID == study_id)

ex <- readr::read_csv(ex_path, show_col_types = FALSE) |>
  dplyr::filter(.data$STUDYID == study_id)

assert_cols(dm, c("STUDYID","USUBJID","RFSTDTC","AGE","AGEU","SEX","RACE","ARM"), "DM")
assert_cols(ex, c("STUDYID","USUBJID","EXTRT","EXSTDTC","EXENDTC"), "EX")

dm0 <- dm |>
  dplyr::select(STUDYID, USUBJID, SITEID, SUBJID, RFSTDTC, RFENDTC, BRTHDTC, AGE, AGEU, SEX, RACE, ARM)

stop_if_dups(dm0, "USUBJID", file.path(paths$qc_dir, "dups_dm0.csv"))

ex_summ <- ex |>
  dplyr::arrange(.data$USUBJID, .data$EXSTDTC) |>
  dplyr::group_by(.data$USUBJID) |>
  dplyr::summarise(
    TRT01P = dplyr::first(.data$EXTRT),
    TRTSDT = iso_to_date(dplyr::first(.data$EXSTDTC)),
    TRTEDT = {
      end_nonmissing <- .data$EXENDTC[!is.na(.data$EXENDTC)]
      if (length(end_nonmissing) == 0) as.Date(NA) else iso_to_date(end_nonmissing[length(end_nonmissing)])
    },
    .groups = "drop"
  )

stop_if_dups(ex_summ, "USUBJID", file.path(paths$qc_dir, "dups_ex_summ.csv"))

adsl <- dm0 |>
  dplyr::left_join(ex_summ, by = "USUBJID") |>
  dplyr::mutate(
    RANDDT = iso_to_date(.data$RFSTDTC),
    SAFFL  = dplyr::if_else(!is.na(.data$TRTSDT), "Y", "N"),
    TRT01A = .data$TRT01P
  ) |>
  dplyr::select(
    STUDYID, USUBJID, SITEID, SUBJID, ARM,
    RANDDT, TRT01P, TRT01A, TRTSDT, TRTEDT, SAFFL,
    AGE, AGEU, SEX, RACE
  )

# Hard-stop integrity checks
if (any(is.na(adsl$USUBJID) | adsl$USUBJID == "")) stop("Missing USUBJID in ADSL.", call. = FALSE)
stop_if_dups(adsl, "USUBJID", file.path(paths$qc_dir, "dups_adsl.csv"))
if (any(adsl$SAFFL == "Y" & is.na(adsl$TRT01A))) stop("SAFFL=Y but TRT01A missing.", call. = FALSE)

# Write output (deterministic)
readr::write_csv(adsl, adsl_path)

# Build summary artifact
summary <- adsl |>
  dplyr::summarise(
    n_records = dplyr::n(),
    n_saffl   = sum(.data$SAFFL == "Y"),
    n_missing_usubjid = sum(is.na(.data$USUBJID) | .data$USUBJID == "")
  )

readr::write_csv(summary, file.path(paths$qc_dir, "adsl_build_summary_r.csv"))

# =============================================================================
# Program:  02_qc_adsl.R
# Purpose:  Independent QC build of ADSL and compare to production ADSL.
# Inputs:   dm.csv, ex.csv, adsl.csv
# Outputs:  qc_adsl.csv, qc_compare.csv, qc_summary.csv
# QC:       Re-derive using different approach; compare row/col equality.
# =============================================================================

iso_to_date <- function(x) as.Date(substr(x, 1, 10))

adsl_prod <- readr::read_csv(paths$adam_adsl, show_col_types = FALSE)

dm_qc <- readr::read_csv(paths$sdtm_dm, show_col_types = FALSE) |>
  dplyr::filter(.data$STUDYID == study_id) |>
  dplyr::select(STUDYID, USUBJID, SITEID, SUBJID, RFSTDTC, RFENDTC, BRTHDTC, 
  AGE, AGEU, SEX, RACE, ARM)

ex_qc <- readr::read_csv(paths$sdtm_ex, show_col_types = FALSE) |>
  dplyr::filter(.data$STUDYID == study_id) |>
  dplyr::select(STUDYID, USUBJID, EXTRT, EXSTDTC, EXENDTC)

# Different approach than production: aggregate min/max and pick first 
treatment by earliest EXSTDTC
ex_summ_qc <- ex_qc |>
  dplyr::arrange(.data$USUBJID, .data$EXSTDTC) |>
  dplyr::group_by(.data$USUBJID) |>
  dplyr::summarise(
    TRTSDT = min(iso_to_date(.data$EXSTDTC), na.rm = TRUE),
    TRTEDT = {
      end_dates <- .data$EXENDTC[!is.na(.data$EXENDTC)]
      if (length(end_dates) == 0) as.Date(NA) else max(iso_to_date(end_dates), na.rm = TRUE)
    },
    TRT01P = dplyr::first(.data$EXTRT),
    .groups = "drop"
  ) |>
  dplyr::mutate(
    TRTSDT = ifelse(is.infinite(TRTSDT), as.Date(NA), as.Date(TRTSDT))
  )

adsl_qc <- dm_qc |>
  dplyr::left_join(ex_summ_qc, by = "USUBJID") |>
  dplyr::mutate(
    RANDDT = iso_to_date(.data$RFSTDTC),
    SAFFL  = dplyr::if_else(!is.na(.data$TRTSDT), "Y", "N"),
    TRT01A = .data$TRT01P
  ) |>
  dplyr::select(
    STUDYID, USUBJID, SITEID, SUBJID, ARM,
    RANDDT, TRT01P, TRT01A, TRTSDT, TRTEDT, SAFFL,
    AGE, AGEU, SEX, RACE
  ) |>
  dplyr::arrange(.data$USUBJID)

adsl_prod2 <- adsl_prod |>
  dplyr::arrange(.data$USUBJID)

# Compare: full join and flag diffs at cell level (compact)
cmp <- adsl_prod2 |>
  dplyr::full_join(adsl_qc, by = "USUBJID", suffix = c("_PROD", "_QC"))

# Identify differences for key derived variables (expandable)
key_vars <- c("RANDDT", "TRT01P", "TRT01A", "TRTSDT", "TRTEDT", "SAFFL")

diff_rows <- cmp |>
  dplyr::mutate(
    diff_any = FALSE
  )

for (v in key_vars) {
  prod <- paste0(v, "_PROD")
  qc   <- paste0(v, "_QC")
  if (!(prod %in% names(diff_rows) && qc %in% names(diff_rows))) next
  diff_rows[[paste0("DIFF_", v)]] <- !(isTRUE(all.equal(diff_rows[[prod]], diff_rows[[qc]])) ) # global fallback
}

# Better: row-wise diff flags
row_diff <- cmp |>
  dplyr::mutate(
    DIFF_RANDDT = .data$RANDDT_PROD != .data$RANDDT_QC,
    DIFF_TRT01P = .data$TRT01P_PROD != .data$TRT01P_QC,
    DIFF_TRT01A = .data$TRT01A_PROD != .data$TRT01A_QC,
    DIFF_TRTSDT = .data$TRTSDT_PROD != .data$TRTSDT_QC,
    DIFF_TRTEDT = .data$TRTEDT_PROD != .data$TRTEDT_QC,
    DIFF_SAFFL  = .data$SAFFL_PROD  != .data$SAFFL_QC
  ) |>
  dplyr::mutate(
    DIFF_ANY = dplyr::if_any(dplyr::starts_with("DIFF_"), ~ isTRUE(.x))
  ) |>
  dplyr::filter(.data$DIFF_ANY) |>
  dplyr::select(USUBJID, dplyr::starts_with("DIFF_"), 
  dplyr::ends_with("_PROD"), dplyr::ends_with("_QC"))

readr::write_csv(adsl_qc, file.path(paths$qc_dir, "adsl_qc_r.csv"))
readr::write_csv(row_diff, file.path(paths$qc_dir, "adsl_compare_r.csv"))

qc_summary <- data.frame(
  n_prod = nrow(adsl_prod2),
  n_qc = nrow(adsl_qc),
  n_diff = nrow(row_diff),
  stringsAsFactors = FALSE
)

readr::write_csv(qc_summary, file.path(paths$qc_dir, "adsl_qc_summary_r.csv"))