make_split_spec_graph <- function(time_source = c("index", "precedence")) {
  time_source <- match.arg(time_source)

  meta <- data.frame(
    sample_id = c("S1", "S2", "S3", "S4", "S5"),
    subject_id = c("P1", "P1", "P2", "P3", "P4"),
    batch_id = c("B1", "B2", "B1", "B3", NA),
    study_id = c("ST1", "ST1", "ST2", "ST2", "ST3"),
    timepoint_id = c("T0", "T1", "T0", "T2", NA),
    stringsAsFactors = FALSE
  )

  sample_nodes <- create_nodes(meta, type = "Sample", id_col = "sample_id")
  subject_nodes <- create_nodes(meta, type = "Subject", id_col = "subject_id")
  batch_nodes <- create_nodes(meta, type = "Batch", id_col = "batch_id")
  study_nodes <- create_nodes(meta, type = "Study", id_col = "study_id")

  time_data <- unique(meta[!is.na(meta$timepoint_id), "timepoint_id", drop = FALSE])
  time_nodes <- if (identical(time_source, "index")) {
    create_nodes(
      transform(time_data, time_index = c(0L, 1L, 2L)),
      type = "Timepoint",
      id_col = "timepoint_id",
      attr_cols = c("time_index")
    )
  } else {
    create_nodes(time_data, type = "Timepoint", id_col = "timepoint_id")
  }

  edge_sets <- list(
    create_edges(meta, "sample_id", "subject_id", "Sample", "Subject", "sample_belongs_to_subject"),
    create_edges(meta, "sample_id", "batch_id", "Sample", "Batch", "sample_processed_in_batch", allow_missing = TRUE),
    create_edges(meta, "sample_id", "study_id", "Sample", "Study", "sample_from_study"),
    create_edges(meta, "sample_id", "timepoint_id", "Sample", "Timepoint", "sample_collected_at_timepoint", allow_missing = TRUE)
  )

  if (identical(time_source, "precedence")) {
    edge_sets <- c(edge_sets, list(
      create_edges(
        data.frame(
          from_timepoint = c("T0", "T1"),
          to_timepoint = c("T1", "T2"),
          stringsAsFactors = FALSE
        ),
        "from_timepoint", "to_timepoint", "Timepoint", "Timepoint", "timepoint_precedes"
      )
    ))
  }

  build_dependency_graph(
    nodes = list(sample_nodes, subject_nodes, batch_nodes, study_nodes, time_nodes),
    edges = edge_sets,
    graph_name = paste0("split_spec_graph_", time_source),
    dataset_name = "SplitSpecDemo"
  )
}

test_that("as_split_spec translates constraints into canonical sample data", {
  graph <- make_split_spec_graph("index")
  constraint <- derive_split_constraints(graph, mode = "batch")
  spec <- as_split_spec(constraint, graph = graph)
  validation <- validate_split_spec(spec)

  expect_s3_class(spec, "split_spec")
  expect_true(all(c(
    "sample_id", "sample_node_id", "group_id", "primary_group", "batch_group",
    "study_group", "timepoint_id", "time_index", "order_rank"
  ) %in% names(spec$sample_data)))
  expect_equal(spec$group_var, "group_id")
  expect_true("batch_group" %in% spec$block_vars)
  expect_equal(spec$recommended_resampling, "blocked_cv")
  expect_equal(spec$sample_data$batch_group[spec$sample_data$sample_id == "S1"], "B1")
  expect_equal(spec$sample_data$study_group[spec$sample_data$sample_id == "S1"], "ST1")
  expect_equal(spec$sample_data$order_rank[spec$sample_data$sample_id == "S4"], 3L)
  expect_equal(spec$metadata$source_mode, "batch")
  expect_equal(spec$metadata$source_strategy, "batch")
  expect_true(validation$valid)
})

test_that("as_split_spec preserves time-aware ordering semantics", {
  graph <- make_split_spec_graph("precedence")
  constraint <- derive_split_constraints(graph, mode = "time")
  spec <- as_split_spec(constraint, graph = graph)
  validation <- validate_split_spec(spec)

  expect_s3_class(spec, "split_spec")
  expect_identical(spec$time_var, "order_rank")
  expect_false(isTRUE(spec$ordering_required))
  expect_equal(spec$sample_data$order_rank[spec$sample_data$sample_id == "S2"], 2L)
  expect_equal(spec$recommended_resampling, "ordered_split")
  expect_true(validation$valid)
})

test_that("partial time coverage does not force invalid ordering requirements in generated split specs", {
  graph <- make_split_spec_graph("index")
  constraint <- derive_split_constraints(graph, mode = "time")
  spec <- as_split_spec(constraint, graph = graph)
  validation <- validate_split_spec(spec)

  expect_false(isTRUE(spec$ordering_required))
  expect_identical(spec$time_var, "order_rank")
  expect_true(any(is.na(spec$sample_data$order_rank)))
  expect_true(validation$valid)
  expect_false(any(validation$issues$code == "missing_required_ordering"))
})

test_that("validate_split_spec detects missing ordering and duplicate samples", {
  graph <- make_split_spec_graph("index")
  constraint <- derive_split_constraints(graph, mode = "time")
  spec <- as_split_spec(constraint, graph = graph)
  broken <- spec
  broken$ordering_required <- TRUE
  broken$sample_data$order_rank[] <- NA_integer_
  broken$sample_data <- rbind(broken$sample_data, broken$sample_data[1, , drop = FALSE])

  validation <- validate_split_spec(broken)

  expect_s3_class(validation, "split_spec_validation")
  expect_false(validation$valid)
  expect_true(any(validation$issues$code == "duplicate_sample_id"))
  expect_true(any(validation$issues$code == "missing_required_ordering"))
  expect_true(length(capture.output(print(validation))) > 0L)
})

test_that("validate_split_spec is deterministic across repeated runs", {
  graph <- make_split_spec_graph("index")
  constraint <- derive_split_constraints(graph, mode = "time")
  spec <- as_split_spec(constraint, graph = graph)
  broken <- spec
  broken$sample_data$order_rank[] <- NA_integer_
  broken$sample_data <- rbind(broken$sample_data, broken$sample_data[1, , drop = FALSE])

  validation_a <- validate_split_spec(broken)
  validation_b <- validate_split_spec(broken)

  expect_identical(validation_a$issues$code, validation_b$issues$code)
  expect_identical(validation_a$issues$message, validation_b$issues$message)
  expect_identical(validation_a$issues$n_affected, validation_b$issues$n_affected)
  expect_identical(validation_a$issues$issue_id, validation_b$issues$issue_id)
})

test_that("summarize_leakage_risks marks validation risks not severed by the chosen constraint", {
  # Regression test for C2: summarize_leakage_risks reused validate_graph()
  # but never asked whether the CHOSEN constraint mode actually severs each
  # reported leakage path. A user picking `mode = "subject"` on a graph with
  # heavy batch reuse could ship a spec whose splits leak batch effects, and
  # the summary would not flag the mismatch.
  meta <- data.frame(
    sample_id  = paste0("S", 1:6),
    subject_id = paste0("P", 1:6),                          # each subject distinct
    batch_id   = c("B1", "B1", "B1", "B2", "B2", "B3"),     # B1 holds 3 of 6
    stringsAsFactors = FALSE
  )
  graph <- graph_from_metadata(meta, graph_name = "heavy_batch_demo")

  subject_c <- derive_split_constraints(graph, mode = "subject")
  summary_subject <- summarize_leakage_risks(graph, constraint = subject_c)

  expect_true("severed" %in% names(summary_subject$diagnostics),
              info = "Diagnostics must carry a `severed` column when a constraint is provided.")
  heavy_row_subject <- summary_subject$diagnostics[
    summary_subject$diagnostics$category == "heavy_batch_reuse", , drop = FALSE
  ]
  expect_equal(nrow(heavy_row_subject), 1L,
               info = "heavy_batch_reuse must appear when one batch holds >= ceiling(n*0.5) samples.")
  expect_false(isTRUE(heavy_row_subject$severed[[1L]]),
               info = "mode = 'subject' does not block batch leakage; row must be marked not severed.")

  # Same graph, but mode = 'batch' should sever the same risk.
  batch_c <- derive_split_constraints(graph, mode = "batch")
  summary_batch <- summarize_leakage_risks(graph, constraint = batch_c)
  heavy_row_batch <- summary_batch$diagnostics[
    summary_batch$diagnostics$category == "heavy_batch_reuse", , drop = FALSE
  ]
  expect_true(isTRUE(heavy_row_batch$severed[[1L]]),
              info = "mode = 'batch' groups samples by batch; heavy_batch_reuse must be marked severed.")

  # Without a constraint, `severed` should be NA (no claim about severance).
  summary_no_c <- summarize_leakage_risks(graph)
  expect_true("severed" %in% names(summary_no_c$diagnostics))
  heavy_row_nc <- summary_no_c$diagnostics[
    summary_no_c$diagnostics$category == "heavy_batch_reuse", , drop = FALSE
  ]
  expect_true(is.na(heavy_row_nc$severed[[1L]]),
              info = "Without a constraint, severance is not knowable; column must be NA.")
})

test_that("summarize_leakage_risks combines graph, constraint, and split-spec diagnostics", {
  graph <- make_split_spec_graph("index")
  constraint <- derive_split_constraints(graph, mode = "composite", strategy = "strict", via = c("Subject", "Batch"))
  spec <- as_split_spec(constraint, graph = graph)
  summary_obj <- summarize_leakage_risks(graph, constraint = constraint, split_spec = spec)

  expect_s3_class(summary_obj, "leakage_risk_summary")
  expect_true(is.character(summary_obj$overview))
  expect_true(all(c("severity", "category", "message", "source", "n_affected") %in% names(summary_obj$diagnostics)))
  expect_true(any(summary_obj$diagnostics$source == "validation"))
  expect_true(any(summary_obj$diagnostics$source == "constraint"))
  expect_true(any(summary_obj$diagnostics$source == "split_spec"))
  expect_true(any(summary_obj$diagnostics$category == "blocking_available"))
  expect_true(any(summary_obj$diagnostics$category == "ordering_available"))
  expect_true("block_vars" %in% names(summary_obj$split_spec_summary))
  expect_true("ordering_required" %in% names(summary_obj$split_spec_summary))
  expect_true(length(capture.output(print(summary_obj))) > 0L)
})

# ---- leakage-summary edge branches ------------------------------------------

test_that("summarize_leakage_risks reports no risks for a structurally clean graph", {
  clean <- data.frame(
    sample_id  = c("S1", "S2"),
    subject_id = c("P1", "P2"),
    study_id   = c("ST1", "ST2"),
    stringsAsFactors = FALSE
  )
  g <- graph_from_metadata(clean)
  expect_true(validate_graph(g)$valid)

  # No constraint and no split_spec: every summary source is empty.
  rs <- summarize_leakage_risks(g)
  expect_s3_class(rs, "leakage_risk_summary")
  expect_equal(nrow(as.data.frame(rs)), 0L)
  expect_match(rs$overview, "No structural leakage risks")
})

test_that("summarize_leakage_risks surfaces constraint warnings as diagnostics", {
  meta <- data.frame(
    sample_id  = c("S1", "S2", "S3"),
    subject_id = c("P1", "P2", "P3"),
    site_id    = c("NYC", "NYC", NA),   # S3 has no site -> constraint warning
    stringsAsFactors = FALSE
  )
  g <- graph_from_metadata(meta)
  constraint <- derive_split_constraints(g, mode = "site")
  expect_true(length(constraint$metadata$warnings) > 0L)

  df <- as.data.frame(summarize_leakage_risks(g, constraint = constraint))
  warn_rows <- df[df$category == "constraint_warning", , drop = FALSE]
  expect_true(nrow(warn_rows) >= 1L)
  expect_true(all(warn_rows$source == "constraint"))
  expect_true(all(is.na(warn_rows$severed)))
})

test_that("summarize_leakage_risks reports a failing preflight and phantom block vars", {
  meta <- data.frame(
    sample_id  = c("S1", "S2", "S3", "S4"),
    subject_id = c("P1", "P1", "P2", "P2"),
    batch_id   = c("B1", "B2", "B1", "B2"),
    stringsAsFactors = FALSE
  )
  g <- graph_from_metadata(meta)
  spec <- as_split_spec(derive_split_constraints(g, mode = "subject"), graph = g)

  # Blank a declared block variable so preflight validation flags it, and add a
  # phantom block variable that is absent from sample_data.
  spec$sample_data$batch_group <- NA_character_
  spec$block_vars <- c(spec$block_vars, "phantom_group")

  df <- as.data.frame(summarize_leakage_risks(g, split_spec = spec))
  # The preflight issue is carried into the split_spec diagnostics.
  expect_true(any(df$source == "split_spec" & df$severity != "advisory"))
  # The phantom block variable is reported as available for 0 samples.
  expect_true(any(grepl("phantom_group.*for 0 of", df$message)))
})
