Example scripts: learned postprocessing

script <- system.file("examples", "sigmoid-holdout.R", package = "vennabers")
file.show(script)
source(script)

# Run with an installed vennabers and its optional tidymodels dependencies.
# B learns the recipe/engine, P learns Sigmoid, and C learns VA. Every outer
# assessment A stays outside all three learning roles.
if (all(vapply(c("vennabers", "tune", "yardstick", "recipes"),
               requireNamespace, logical(1), quietly = TRUE))) local({
  d <- data.frame(x = sin(1:240), row_id = 1:240,
                  truth = factor(rep(c("yes", "no", "no", "yes"), 60)))
  base <- workflows::workflow() |>
    workflows::add_recipe(recipes::recipe(truth ~ x, d) |> recipes::step_normalize(x)) |>
    workflows::add_model(parsnip::logistic_reg(engine = "glm"))
  # prop is P's fraction of each Q, not B's fraction. Both B and P need both
  # classes and at least two P rows. Constant inputs are allowed.
  # Invalid splits, nonfinite inputs or failed convergence
  # fail the fit; there are no retries, size corrections or fallback methods.
  outer <- withr::with_seed(74, rsample::vfold_cv(d, v = 2, repeats = 2, strata = truth, pool = 0))
  metrics <- yardstick::metric_set(yardstick::brier_class, yardstick::mn_log_loss)
  audit <- function(result, plans, event) {
    predictions <- tune::collect_predictions(result, summarize = FALSE)
    scores <- tune::collect_metrics(result, summarize = FALSE)
    stopifnot(nrow(tune::collect_notes(result)) == 0L, all(is.finite(scores$.estimate)),
              nrow(scores) == 2L * nrow(plans))
    ids <- setdiff(names(plans), "splits")
    if (inherits(result, "last_fit")) for (id in ids) scores[[id]] <- plans[[id]][1L]
    expected <- do.call(rbind, lapply(seq_len(nrow(plans)), function(i) {
      rows <- as.integer(plans$splits[[i]], "assessment")
      cbind(as.data.frame(plans[rep(i, length(rows)), ids, drop = FALSE]),
            .row = rows, .config = "pre0_mod0_post0")
    }))
    keys <- c(ids, ".row", ".config")
    stopifnot(!anyDuplicated(predictions[keys]), nrow(predictions) == nrow(expected),
              nrow(merge(predictions[keys], expected, by = keys)) == nrow(expected),
              !anyDuplicated(scores[c(ids, ".metric", ".config")]))
    for (i in seq_len(nrow(plans))) {
      matches <- function(x) Reduce(`&`, lapply(ids, function(id) x[[id]] == plans[[id]][i]))
      p <- predictions[matches(predictions), ]
      m <- scores[matches(scores), ]
      column <- paste0(".pred_", levels(d$truth)[if (event == "first") 1L else 2L])
      values <- c(brier_class = yardstick::brier_class_vec(p$truth, p[[column]], event_level = event),
                  mn_log_loss = yardstick::mn_log_loss_vec(p$truth, p[[column]], event_level = event))
      stopifnot(all(abs(m$.estimate - values[m$.metric]) <= 1e-10))
    }
  }
  for (input in c("probability", "glm_link")) for (method in c("inductive", "cross")) for (event in c("first", "second")) {
    post <- list(method = "sigmoid", strategy = "holdout", prop = .3, sigmoid_input = input)
    spec <- vennabers::calibrated_workflow(base, "truth", method = method, event_level = event,
      seed = 42, postprocessing = post)
    fitted <- generics::fit(spec, d)
    details <- vennabers::venn_abers_details(fitted, d[c("x", "row_id")])
    stopifnot(identical(details$prediction, predict(fitted, d, type = "prob")),
              all(details$details$postprocessing_method == "sigmoid"))
    result <- tune::fit_resamples(spec, outer, metrics = metrics,
      control = tune::control_resamples(save_pred = TRUE, extract = workflows::extract_fit_engine,
        event_level = event, allow_par = FALSE))
    audit(result, outer, event)
    states <- tune::collect_extracts(result)$.extracts
    for (i in seq_along(states)) {
      local <- rsample::analysis(outer$splits[[i]])
      A <- rsample::assessment(outer$splits[[i]])$row_id
      for (plan in states[[i]]$postprocessing) {
        stopifnot(!any(local$row_id[c(plan$B, plan$P, plan$C)] %in% A),
                  !length(intersect(plan$B, plan$P)), !length(intersect(plan$Q, plan$C)))
      }
    }
    split <- rsample::make_splits(list(analysis = 1:180, assessment = 181:240), d)
    last <- tune::last_fit(spec, split, metrics = metrics,
      control = tune::control_last_fit(event_level = event))
    audit(last, rsample::manual_rset(list(split), "train/test split"), event)
    # Changing A changes evaluation, never the fitted state or predictions.
    changed <- d; changed$x[181:240] <- 1000; changed$truth[181:240] <- "yes"
    changed_split <- rsample::make_splits(list(analysis = 1:180, assessment = 181:240), changed)
    other <- tune::last_fit(spec, changed_split, metrics = metrics,
      control = tune::control_last_fit(event_level = event))
    original <- workflows::extract_fit_engine(last$.workflow[[1]])
    after <- workflows::extract_fit_engine(other$.workflow[[1]])
    stopifnot(identical(original$postprocessing, after$postprocessing),
      identical(predict(last$.workflow[[1]], d, type = "prob"), predict(other$.workflow[[1]], d, type = "prob")))
  }
})

# Run with an installed vennabers and its optional tidymodels, tailor and
# probably dependencies. B learns the recipe/engine, P learns Tailor, and C
# learns VA. Every outer assessment A stays outside all three learning roles.
if (all(vapply(c("vennabers", "tailor", "probably", "tune", "yardstick", "recipes"),
               requireNamespace, logical(1), quietly = TRUE))) local({
  d <- data.frame(x = sin(1:240), row_id = 1:240,
                  truth = factor(rep(c("yes", "no", "no", "yes"), 60)))
  base <- workflows::workflow() |>
    workflows::add_recipe(recipes::recipe(truth ~ x, d) |> recipes::step_normalize(x)) |>
    workflows::add_model(parsnip::logistic_reg(engine = "glm"))
  # prop is P's fraction of each Q, not B's fraction. Both B and P need both
  # classes. Logistic P needs at least 3 rows and a full-rank two-column design.
  # Invalid splits, rank deficiency, failed convergence or a switch to none
  # fail the fit; there are no retries, size corrections or fallback methods.
  post <- list(method = "tailor_logistic", strategy = "holdout", prop = .3)
  outer <- withr::with_seed(74, rsample::vfold_cv(d, v = 2, repeats = 2, strata = truth, pool = 0))
  metrics <- yardstick::metric_set(yardstick::brier_class, yardstick::mn_log_loss)
  audit <- function(result, plans, event) {
    predictions <- tune::collect_predictions(result, summarize = FALSE)
    scores <- tune::collect_metrics(result, summarize = FALSE)
    stopifnot(nrow(tune::collect_notes(result)) == 0L, all(is.finite(scores$.estimate)),
              nrow(scores) == 2L * nrow(plans))
    ids <- setdiff(names(plans), "splits")
    if (inherits(result, "last_fit")) for (id in ids) scores[[id]] <- plans[[id]][1L]
    expected <- do.call(rbind, lapply(seq_len(nrow(plans)), function(i) {
      rows <- as.integer(plans$splits[[i]], "assessment")
      cbind(as.data.frame(plans[rep(i, length(rows)), ids, drop = FALSE]),
            .row = rows, .config = "pre0_mod0_post0")
    }))
    keys <- c(ids, ".row", ".config")
    stopifnot(!anyDuplicated(predictions[keys]), nrow(predictions) == nrow(expected),
              nrow(merge(predictions[keys], expected, by = keys)) == nrow(expected),
              !anyDuplicated(scores[c(ids, ".metric", ".config")]))
    for (i in seq_len(nrow(plans))) {
      matches <- function(x) Reduce(`&`, lapply(ids, function(id) x[[id]] == plans[[id]][i]))
      p <- predictions[matches(predictions), ]
      m <- scores[matches(scores), ]
      column <- paste0(".pred_", levels(d$truth)[if (event == "first") 1L else 2L])
      values <- c(brier_class = yardstick::brier_class_vec(p$truth, p[[column]], event_level = event),
                  mn_log_loss = yardstick::mn_log_loss_vec(p$truth, p[[column]], event_level = event))
      stopifnot(all(abs(m$.estimate - values[m$.metric]) <= 1e-10))
    }
  }
  for (method in c("inductive", "cross")) for (event in c("first", "second")) {
    spec <- vennabers::calibrated_workflow(base, "truth", method = method, event_level = event,
      seed = 42, postprocessing = post)
    fitted <- generics::fit(spec, d)
    details <- vennabers::venn_abers_details(fitted, d[c("x", "row_id")])
    stopifnot(identical(details$prediction, predict(fitted, d, type = "prob")),
              all(details$details$postprocessing_method == "tailor_logistic"))
    result <- tune::fit_resamples(spec, outer, metrics = metrics,
      control = tune::control_resamples(save_pred = TRUE, extract = workflows::extract_fit_engine,
        event_level = event, allow_par = FALSE))
    audit(result, outer, event)
    states <- tune::collect_extracts(result)$.extracts
    for (i in seq_along(states)) {
      local <- rsample::analysis(outer$splits[[i]])
      A <- rsample::assessment(outer$splits[[i]])$row_id
      for (plan in states[[i]]$postprocessing) {
        stopifnot(!any(local$row_id[c(plan$B, plan$P, plan$C)] %in% A),
                  !length(intersect(plan$B, plan$P)), !length(intersect(plan$Q, plan$C)))
      }
    }
    split <- rsample::make_splits(list(analysis = 1:180, assessment = 181:240), d)
    last <- tune::last_fit(spec, split, metrics = metrics,
      control = tune::control_last_fit(event_level = event))
    audit(last, rsample::manual_rset(list(split), "train/test split"), event)
    # Changing A changes evaluation, never the fitted state or predictions.
    changed <- d; changed$x[181:240] <- 1000; changed$truth[181:240] <- "yes"
    changed_split <- rsample::make_splits(list(analysis = 1:180, assessment = 181:240), changed)
    other <- tune::last_fit(spec, changed_split, metrics = metrics,
      control = tune::control_last_fit(event_level = event))
    original <- workflows::extract_fit_engine(last$.workflow[[1]])
    after <- workflows::extract_fit_engine(other$.workflow[[1]])
    stopifnot(identical(original$postprocessing, after$postprocessing),
      identical(predict(last$.workflow[[1]], d, type = "prob"), predict(other$.workflow[[1]], d, type = "prob")))
  }
})

# Installed example: shared OvO/OvR retains full workflows trained on B, with
# one Tailor step learned on disjoint P, before VA calibration on held-out C.
# Choose logistic explicitly for two classes, multinomial for three or more.
# Multinomial P uses probably/nnet's default 100 iterations, independently of
# the B engine. Weakly informative probabilities may fail with fold/pair/B/P
# context, without retry or method switch; postprocessing has no maxit option.
packages <- c("vennabers", "workflows", "tailor", "probably", "recipes", "nnet", "tune", "yardstick")
cases <- list()
if (all(vapply(packages, requireNamespace, logical(1), quietly = TRUE))) {
  source(system.file("examples", "assertions.R", package = "vennabers"), local = TRUE)
  audit <- new.env()
  sys.source(system.file("examples", "check-encoded-evaluation.R", package = "vennabers"), audit)
  for (k in 2:4) for (method in c("inductive", "cross")) for (classification in c("ovo", "ovr")) {
    original <- withr::with_seed(123, {
      truth <- factor(rep(c("z z", "a.a", "a a", ".pred_class")[seq_len(k)], length.out = 480),
        levels = c("z z", "a.a", "a a", ".pred_class")[seq_len(k)])
      data.frame(x = rnorm(480, sd = 2) + c(-1, 1, -1, 1)[truth],
        z = rnorm(480, sd = 2) + c(-1, -1, 1, 1)[truth],
        w = rnorm(480, sd = 2) + c(1, -1, -1, 1)[truth], truth = truth)
    })
    names(original) <- c("input value", "input.value", "other value", ".pred_class")
    schema <- vennabers::venn_abers_schema(original, ".pred_class", classification = classification)
    d <- vennabers::venn_abers_encode(original, schema)
    outcome <- schema$encoded_outcome
    base <- workflows::workflow() |>
      workflows::add_recipe(recipes::recipe(reformulate(setdiff(names(d), outcome), outcome), d) |>
        recipes::step_normalize(recipes::all_numeric_predictors())) |>
      workflows::add_model(if (k == 2L) parsnip::logistic_reg(engine = "glm") else
        parsnip::multinom_reg(penalty = .1) |> parsnip::set_engine("nnet", trace = FALSE))
    # Both B and P need all k classes, P needs at least k+1 rows and the actual
    # Tailor design must have rank k. Failed convergence is an error, not fallback.
    post <- list(method = if (k == 2L) "tailor_logistic" else "tailor_multinomial", strategy = "holdout", prop = .4)
    spec <- vennabers::calibrated_workflow(base, outcome, schema = schema, method = method,
      seed = 24, postprocessing = post)
    split <- rsample::make_splits(list(analysis = 1:384, assessment = 385:480), d)
    metrics <- yardstick::metric_set(yardstick::brier_class, yardstick::mn_log_loss)
    result <- tune::last_fit(spec, split, metrics = metrics)
    fit <- result$.workflow[[1]]
    native <- vennabers::venn_abers_details(fit, d[385:480, setdiff(names(d), outcome)])
    decoded <- vennabers::venn_abers_decode(native, schema)
    predictions <- tune::collect_predictions(result)
    scores <- tune::collect_metrics(result)
    assert_conditions(nrow(tune::collect_notes(result)) == 0L, identical(predictions$.row, 385:480),
      !anyDuplicated(predictions$.row), all(predictions$.config == "pre0_mod0_post0"),
      nrow(scores) == 2L, all(is.finite(scores$.estimate)),
      identical(as.matrix(predictions[names(native$prediction)]), as.matrix(native$prediction)),
      identical(colnames(decoded$probability), schema$class_levels),
      identical(decoded$postprocessing[[1]]$classes, schema$class_levels),
      identical(decoded$postprocessing[[1]]$columns, names(original)),
      all(native$details$postprocessing_method == post$method),
      abs(scores$.estimate[scores$.metric == "brier_class"] -
        vennabers::brier_score(original[[schema$outcome]][385:480], decoded$probability) / 2) <= 1e-10)
    if (k > 2L) {
      coefficients <- decoded$postprocessing[[1]]$coefficients
      assert_conditions(identical(rownames(coefficients), schema$class_levels[-1L]),
        all(colnames(coefficients)[-1L] %in% paste0(".pred_", schema$class_levels)))
    }
    outer <- withr::with_seed(74, rsample::vfold_cv(d, v = 2, repeats = 2))
    resampled <- tune::fit_resamples(spec, outer, metrics = metrics,
      control = tune::control_resamples(save_pred = TRUE, extract = workflows::extract_fit_engine, allow_par = FALSE))
    audit$check_encoded_evaluation(resampled, outer, schema)
    states <- tune::collect_extracts(resampled)$.extracts
    for (i in seq_along(states)) for (plan in states[[i]]$postprocessing) {
      Q <- as.integer(outer$splits[[i]], "analysis")
      A <- as.integer(outer$splits[[i]], "assessment")
      assert_conditions(!any(Q[c(plan$B, plan$P, plan$C)] %in% A),
        !length(intersect(plan$B, plan$P)), !length(intersect(plan$Q, plan$C)),
        plan$observed_base_fits == 1L, plan$observed_postprocessor_fits == 1L)
    }
    # Changing outer A never changes the learned state.
    changed <- d; changed[385:480, 1L] <- 1000
    changed[[outcome]][385:480] <- levels(changed[[outcome]])[1L]
    other <- tune::last_fit(spec, rsample::make_splits(list(analysis = 1:384, assessment = 385:480), changed), metrics = metrics)
    assert_conditions(identical(workflows::extract_fit_engine(fit)$postprocessing,
      workflows::extract_fit_engine(other$.workflow[[1]])$postprocessing),
      identical(predict(fit, d, type = "prob"), predict(other$.workflow[[1]], d, type = "prob")))
    cases[[paste(k, method, classification)]] <- list(fit = fit, schema = schema,
      new = d[setdiff(names(d), outcome)])
  }
}

# Installed example: B learns the recipe/engine, disjoint P learns Tailor's
# linear adjustment, and held-out C learns IVAR/CVAR. Outer A learns nothing.
packages <- c("vennabers", "workflows", "tailor", "probably", "recipes", "tune", "yardstick")
cases <- list()
if (all(vapply(packages, requireNamespace, logical(1), quietly = TRUE))) {
  source(system.file("examples", "assertions.R", package = "vennabers"), local = TRUE)
  audit <- new.env()
  sys.source(system.file("examples", "check-encoded-evaluation.R", package = "vennabers"), audit)
  original <- data.frame("input value" = sin(1:240), "input.value" = cos(1:240),
    ".pred" = 10 + 3 * sin(1:240) + cos(1:240) + sin((1:240) / 3), check.names = FALSE)
  schema <- vennabers::venn_abers_schema(original, ".pred")
  d <- vennabers::venn_abers_encode(original, schema)
  outcome <- schema$encoded_outcome
  base <- workflows::workflow() |>
    workflows::add_recipe(recipes::recipe(reformulate(setdiff(names(d), outcome), outcome), d) |>
      recipes::step_normalize(recipes::all_numeric_predictors())) |>
    workflows::add_model(parsnip::linear_reg(engine = "lm"))
  # prop reserves P's fraction of Q. P needs at least three rows and an actual
  # full-rank intercept/prediction design. smooth=FALSE is fixed; finite input,
  # learned method and convergence are checked. No fallback or refit at predict.
  # Automatic B/P plans are unstratified, including numeric 0/1 outcomes.
  post <- list(method = "tailor_linear", strategy = "holdout", prop = .3)
  metrics <- yardstick::metric_set(yardstick::rmse, yardstick::mae)
  for (method in c("inductive", "cross")) {
    spec <- vennabers::calibrated_workflow(base, outcome, schema = schema,
      method = method, m = 1, seed = 42, postprocessing = post)
    outer <- withr::with_seed(74, rsample::vfold_cv(d, v = 2, repeats = 2))
    result <- tune::fit_resamples(spec, outer, metrics = metrics,
      control = tune::control_resamples(save_pred = TRUE, extract = workflows::extract_fit_engine, allow_par = FALSE))
    audit$check_encoded_evaluation(result, outer, schema)
    states <- tune::collect_extracts(result)$.extracts
    for (i in seq_along(states)) for (plan in states[[i]]$postprocessing) {
      Q <- as.integer(outer$splits[[i]], "analysis")
      A <- as.integer(outer$splits[[i]], "assessment")
      assert_conditions(!any(Q[c(plan$B, plan$P, plan$C)] %in% A),
        !length(intersect(plan$B, plan$P)), !length(intersect(plan$Q, plan$C)),
        plan$observed_base_fits == 1L, plan$observed_postprocessor_fits == 1L)
    }
    split <- rsample::make_splits(list(analysis = 1:180, assessment = 181:240), d)
    last <- tune::last_fit(spec, split, metrics = metrics)
    fit <- last$.workflow[[1L]]
    native <- vennabers::venn_abers_details(fit, d[181:240, setdiff(names(d), outcome)])
    decoded <- vennabers::venn_abers_decode(native, schema)
    predictions <- tune::collect_predictions(last)
    scores <- tune::collect_metrics(last)
    truth <- original[[schema$outcome]][181:240]
    reference <- c(rmse = yardstick::rmse_vec(truth, decoded$prediction),
      mae = yardstick::mae_vec(truth, decoded$prediction))
    assert_conditions(nrow(tune::collect_notes(last)) == 0L, identical(predictions$.row, 181:240),
      !anyDuplicated(predictions$.row), all(predictions$.config == "pre0_mod0_post0"),
      nrow(scores) == 2L, setequal(scores$.metric, names(reference)), all(is.finite(scores$.estimate)),
      all(abs(scores$.estimate - reference[scores$.metric]) <= 1e-10),
      identical(predictions$.pred, native$prediction$.pred),
      identical(decoded$postprocessing[[1L]]$columns, names(original)),
      all(native$details$postprocessing_method == "tailor_linear"),
      all(native$details$postprocessing_input == "numeric"))
    # Predictor-only and truth-only outer A mutations leave all learned state fixed.
    for (column in c(names(d)[1L], outcome)) {
      changed <- d; changed[181:240, column] <- changed[181:240, column] + 1000
      other <- tune::last_fit(spec, rsample::make_splits(list(analysis = 1:180, assessment = 181:240), changed), metrics = metrics)
      before <- workflows::extract_fit_engine(fit)
      after <- workflows::extract_fit_engine(other$.workflow[[1L]])
      assert_conditions(identical(before$postprocessing, after$postprocessing),
        identical(before$calibrator, after$calibrator),
        identical(predict(fit, d), predict(other$.workflow[[1L]], d)))
      for (id in names(before$models)) assert_conditions(
        identical(workflows::extract_recipe(before$models[[id]])$steps, workflows::extract_recipe(after$models[[id]])$steps),
        identical(coef(workflows::extract_fit_engine(before$models[[id]])), coef(workflows::extract_fit_engine(after$models[[id]]))))
    }
    cases[[method]] <- list(fit = fit, schema = schema, new = d[setdiff(names(d), outcome)])
  }
}

# B trains the full recipe/engine. Disjoint P trains numeric isotonic
# calibration; C trains IVAR/CVAR. Outer assessment A is evaluation only.
packages <- c("vennabers", "workflows", "recipes", "rsample", "tune", "yardstick")
cases <- list()
if (all(vapply(packages, requireNamespace, logical(1), quietly = TRUE))) {
  source(system.file("examples", "assertions.R", package = "vennabers"), local = TRUE)
  original <- data.frame("input value" = sin(1:120),
    "target y" = 10 + 3 * sin(1:120) + cos(1:120) + sin((1:120) / 4), check.names = FALSE)
  schema <- vennabers::venn_abers_schema(original, "target y")
  d <- vennabers::venn_abers_encode(original, schema)
  outcome <- schema$encoded_outcome
  base <- workflows::workflow() |>
    workflows::add_recipe(recipes::recipe(reformulate(setdiff(names(d), outcome), outcome), d) |>
      recipes::step_normalize(recipes::all_numeric_predictors())) |>
    workflows::add_model(parsnip::linear_reg(engine = "lm"))
  metrics <- yardstick::metric_set(yardstick::rmse, yardstick::mae)
  post <- list(method = "isotonic_numeric", strategy = "holdout", prop = .3)
  outer <- withr::with_seed(74, rsample::vfold_cv(d, v = 2))
  split <- rsample::make_splits(list(analysis = 1:90, assessment = 91:120), d)
  for (method in c("inductive", "cross")) {
    options <- if (method == "inductive") list(m = 1) else list(epsilon = .5)
    spec <- do.call(vennabers::calibrated_workflow, c(list(workflow = base,
      outcome = outcome, schema = schema, method = method, seed = 42,
      postprocessing = post), options))
    resampled <- tune::fit_resamples(spec, outer, metrics = metrics,
      control = tune::control_resamples(save_pred = TRUE, extract = workflows::extract_fit_engine, allow_par = FALSE))
    assert_conditions(nrow(tune::collect_notes(resampled)) == 0L,
      nrow(tune::collect_predictions(resampled)) == 120L)
    for (i in seq_along(outer$splits)) {
      state <- tune::collect_extracts(resampled)$.extracts[[i]]
      Q <- as.integer(outer$splits[[i]], "analysis")
      A <- as.integer(outer$splits[[i]], "assessment")
      for (plan in state$postprocessing) assert_conditions(
        !any(Q[c(plan$B, plan$P, plan$C)] %in% A),
        !length(intersect(plan$B, plan$P)), !length(intersect(plan$Q, plan$C)),
        plan$observed_base_fits == 1L, plan$observed_postprocessor_fits == 1L)
    }
    last <- tune::last_fit(spec, split, metrics = metrics)
    assert_conditions(nrow(tune::collect_notes(last)) == 0L)
    fit <- last$.workflow[[1L]]
    new <- d[91:120, setdiff(names(d), outcome), drop = FALSE]
    native <- vennabers::venn_abers_details(fit, new)
    decoded <- vennabers::venn_abers_decode(native, schema)
    collected <- tune::collect_predictions(last)
    assert_conditions(identical(collected$.row, 91:120),
      identical(collected$.pred, native$prediction$.pred),
      all(native$details$postprocessing_method == "isotonic_numeric"),
      all(native$details$postprocessing_input == "numeric"),
      all(is.finite(decoded$prediction)))
    before <- workflows::extract_fit_engine(fit)
    for (column in c(names(d)[1L], outcome)) {
      changed <- d
      changed[91:120, column] <- changed[91:120, column] + 100
      other <- tune::last_fit(spec, rsample::make_splits(list(analysis = 1:90, assessment = 91:120), changed),
        metrics = metrics)$.workflow[[1L]]
      after <- workflows::extract_fit_engine(other)
      assert_conditions(identical(before$postprocessing, after$postprocessing),
        identical(before$calibrator, after$calibrator),
        identical(predict(fit, new), predict(other, new)))
      for (id in names(before$models)) assert_conditions(
        identical(before$models[[id]]$isotonic, after$models[[id]]$isotonic),
        identical(coef(workflows::extract_fit_engine(before$models[[id]]$workflow)),
                  coef(workflows::extract_fit_engine(after$models[[id]]$workflow))))
    }
    cases[[method]] <- list(fit = fit, new = new, schema = schema)
  }
}

# Run with an installed vennabers and its optional tidymodels dependencies.
# Each inner B/P pair learns a complete workflow and postprocessor. Equal
# pair means train VA on C; outer assessment A stays outside all learning.
if (all(vapply(c("vennabers", "tune", "yardstick", "recipes", "tailor", "probably"),
               requireNamespace, logical(1), quietly = TRUE))) local({
  d <- data.frame(x = sin(1:240), row_id = 1:240,
                  truth = factor(rep(c("yes", "no", "no", "yes"), 60)))
  base <- workflows::workflow() |>
    workflows::add_recipe(recipes::recipe(truth ~ x, d) |> recipes::step_normalize(x)) |>
    workflows::add_model(parsnip::logistic_reg(engine = "glm"))
  # P folds partition each local Q exactly once; each B is the complement.
  # J=3 complete pairs are retained per VA fold. No inner VA is fitted.
  outer <- withr::with_seed(74, rsample::vfold_cv(d, v = 2, repeats = 2, strata = truth, pool = 0))
  metrics <- yardstick::metric_set(yardstick::brier_class, yardstick::mn_log_loss)
  audit <- function(result, plans, event) {
    predictions <- tune::collect_predictions(result, summarize = FALSE)
    scores <- tune::collect_metrics(result, summarize = FALSE)
    stopifnot(nrow(tune::collect_notes(result)) == 0L, all(is.finite(scores$.estimate)),
              nrow(scores) == 2L * nrow(plans))
    ids <- setdiff(names(plans), "splits")
    if (inherits(result, "last_fit")) for (id in ids) scores[[id]] <- plans[[id]][1L]
    expected <- do.call(rbind, lapply(seq_len(nrow(plans)), function(i) {
      rows <- as.integer(plans$splits[[i]], "assessment")
      cbind(as.data.frame(plans[rep(i, length(rows)), ids, drop = FALSE]),
            .row = rows, .config = "pre0_mod0_post0")
    }))
    keys <- c(ids, ".row", ".config")
    stopifnot(!anyDuplicated(predictions[keys]), nrow(predictions) == nrow(expected),
              nrow(merge(predictions[keys], expected, by = keys)) == nrow(expected),
              !anyDuplicated(scores[c(ids, ".metric", ".config")]))
    for (i in seq_len(nrow(plans))) {
      matches <- function(x) Reduce(`&`, lapply(ids, function(id) x[[id]] == plans[[id]][i]))
      p <- predictions[matches(predictions), ]
      m <- scores[matches(scores), ]
      column <- paste0(".pred_", levels(d$truth)[if (event == "first") 1L else 2L])
      values <- c(brier_class = yardstick::brier_class_vec(p$truth, p[[column]], event_level = event),
                  mn_log_loss = yardstick::mn_log_loss_vec(p$truth, p[[column]], event_level = event))
      stopifnot(all(abs(m$.estimate - values[m$.metric]) <= 1e-10))
    }
  }
  for (kind in c("tailor_logistic", "probability", "glm_link")) for (method in c("inductive", "cross")) for (event in c("first", "second")) {
    post <- list(method = if (kind == "tailor_logistic") kind else "sigmoid", strategy = "ensemble", v = 3L)
    if (kind != "tailor_logistic") post$sigmoid_input <- kind
    spec <- vennabers::calibrated_workflow(base, "truth", method = method, event_level = event,
      seed = 42, postprocessing = post)
    fitted <- generics::fit(spec, d)
    details <- vennabers::venn_abers_details(fitted, d[c("x", "row_id")])
    stopifnot(identical(details$prediction, predict(fitted, d, type = "prob")),
              all(details$details$postprocessing_method == post$method),
              all(lengths(details$details$inner_fold) == 3L))
    result <- tune::fit_resamples(spec, outer, metrics = metrics,
      control = tune::control_resamples(save_pred = TRUE, extract = workflows::extract_fit_engine,
        event_level = event, allow_par = FALSE))
    audit(result, outer, event)
    states <- tune::collect_extracts(result)$.extracts
    for (i in seq_along(states)) {
      local <- rsample::analysis(outer$splits[[i]])
      A <- rsample::assessment(outer$splits[[i]])$row_id
      for (ensemble in states[[i]]$postprocessing) for (plan in ensemble$inner_folds) {
        stopifnot(!any(local$row_id[c(plan$B, plan$P, plan$C)] %in% A),
                  !length(intersect(plan$B, plan$P)), !length(intersect(plan$Q, plan$C)))
      }
    }
    split <- rsample::make_splits(list(analysis = 1:180, assessment = 181:240), d)
    last <- tune::last_fit(spec, split, metrics = metrics,
      control = tune::control_last_fit(event_level = event))
    audit(last, rsample::manual_rset(list(split), "train/test split"), event)
    # Changing either A predictors or truth changes evaluation, never learning.
    for (variable in c("x", "truth")) {
      changed <- d
      if (variable == "x") changed$x[181:240] <- 1000 else changed$truth[181:240] <- "yes"
      changed_split <- rsample::make_splits(list(analysis = 1:180, assessment = 181:240), changed)
      other <- tune::last_fit(spec, changed_split, metrics = metrics,
        control = tune::control_last_fit(event_level = event))
      original <- workflows::extract_fit_engine(last$.workflow[[1]])
      after <- workflows::extract_fit_engine(other$.workflow[[1]])
      stopifnot(identical(original$postprocessing, after$postprocessing),
        identical(predict(last$.workflow[[1]], d, type = "prob"), predict(other$.workflow[[1]], d, type = "prob")))
    }
  }
})

# Installed example: shared OvO/OvR retains J complete B/P workflows per VA
# fold. Their full probability vectors are averaged equally before VA on C.
# Choose logistic explicitly for two classes, multinomial for three or more.
# Multinomial P uses probably/nnet's default 100 iterations, independently of
# the B engine. Any unconverged pair fails the whole ensemble with fold/pair/B/P
# context, without retry or method switch; postprocessing has no maxit option.
packages <- c("vennabers", "workflows", "tailor", "probably", "recipes", "nnet", "tune", "yardstick")
cases <- list()
if (all(vapply(packages, requireNamespace, logical(1), quietly = TRUE))) {
  source(system.file("examples", "assertions.R", package = "vennabers"), local = TRUE)
  audit <- new.env()
  sys.source(system.file("examples", "check-encoded-evaluation.R", package = "vennabers"), audit)
  for (k in 2:4) for (method in c("inductive", "cross")) for (classification in c("ovo", "ovr")) {
    original <- withr::with_seed(123, {
      truth <- factor(rep(c("z z", "a.a", "a a", ".pred_class")[seq_len(k)], length.out = 480),
        levels = c("z z", "a.a", "a a", ".pred_class")[seq_len(k)])
      data.frame(x = rnorm(480, sd = 2) + c(-1, 1, -1, 1)[truth],
        z = rnorm(480, sd = 2) + c(-1, -1, 1, 1)[truth],
        w = rnorm(480, sd = 2) + c(1, -1, -1, 1)[truth], truth = truth)
    })
    names(original) <- c("input value", "input.value", "other value", ".pred_class")
    schema <- vennabers::venn_abers_schema(original, ".pred_class", classification = classification)
    d <- vennabers::venn_abers_encode(original, schema)
    outcome <- schema$encoded_outcome
    base <- workflows::workflow() |>
      workflows::add_recipe(recipes::recipe(reformulate(setdiff(names(d), outcome), outcome), d) |>
        recipes::step_normalize(recipes::all_numeric_predictors())) |>
      workflows::add_model(if (k == 2L) parsnip::logistic_reg(engine = "glm") else
        parsnip::multinom_reg(penalty = .1) |> parsnip::set_engine("nnet", trace = FALSE))
    # Both B and P need all k classes, P needs at least k+1 rows and the actual
    # Tailor design must have rank k. Failed convergence is an error, not fallback.
    post <- list(method = if (k == 2L) "tailor_logistic" else "tailor_multinomial", strategy = "ensemble", v = 3L)
    spec <- vennabers::calibrated_workflow(base, outcome, schema = schema, method = method,
      seed = 24, postprocessing = post)
    split <- rsample::make_splits(list(analysis = 1:384, assessment = 385:480), d)
    metrics <- yardstick::metric_set(yardstick::brier_class, yardstick::mn_log_loss)
    result <- tune::last_fit(spec, split, metrics = metrics)
    fit <- result$.workflow[[1]]
    native <- vennabers::venn_abers_details(fit, d[385:480, setdiff(names(d), outcome)])
    decoded <- vennabers::venn_abers_decode(native, schema)
    predictions <- tune::collect_predictions(result)
    scores <- tune::collect_metrics(result)
    assert_conditions(nrow(tune::collect_notes(result)) == 0L, identical(predictions$.row, 385:480),
      !anyDuplicated(predictions$.row), all(predictions$.config == "pre0_mod0_post0"),
      nrow(scores) == 2L, all(is.finite(scores$.estimate)),
      identical(as.matrix(predictions[names(native$prediction)]), as.matrix(native$prediction)),
      identical(colnames(decoded$probability), schema$class_levels),
      identical(decoded$postprocessing[[1]]$inner_folds[[1]]$classes, schema$class_levels),
      identical(decoded$postprocessing[[1]]$inner_folds[[1]]$columns, names(original)),
      all(native$details$postprocessing_method == post$method),
      all(lengths(native$details$inner_fold) == 3L),
      abs(scores$.estimate[scores$.metric == "brier_class"] -
        vennabers::brier_score(original[[schema$outcome]][385:480], decoded$probability) / 2) <= 1e-10)
    if (k > 2L) {
      coefficients <- decoded$postprocessing[[1]]$inner_folds[[1]]$coefficients
      assert_conditions(identical(rownames(coefficients), schema$class_levels[-1L]),
        all(colnames(coefficients)[-1L] %in% paste0(".pred_", schema$class_levels)))
    }
    outer <- withr::with_seed(74, rsample::vfold_cv(d, v = 2, repeats = 2))
    resampled <- tune::fit_resamples(spec, outer, metrics = metrics,
      control = tune::control_resamples(save_pred = TRUE, extract = workflows::extract_fit_engine, allow_par = FALSE))
    audit$check_encoded_evaluation(resampled, outer, schema)
    states <- tune::collect_extracts(resampled)$.extracts
    for (i in seq_along(states)) for (ensemble in states[[i]]$postprocessing) for (plan in ensemble$inner_folds) {
      Q <- as.integer(outer$splits[[i]], "analysis")
      A <- as.integer(outer$splits[[i]], "assessment")
      assert_conditions(!any(Q[c(plan$B, plan$P, plan$C)] %in% A),
        !length(intersect(plan$B, plan$P)), !length(intersect(plan$Q, plan$C)),
        plan$observed_base_fits == 1L, plan$observed_postprocessor_fits == 1L)
    }
    # Change A predictors and truth separately: neither can affect learning.
    for (variable in c(names(d)[1L], outcome)) {
      changed <- d
      if (variable == outcome) changed[[outcome]][385:480] <- levels(d[[outcome]])[1L] else
        changed[385:480, variable] <- 1000
      other <- tune::last_fit(spec, rsample::make_splits(list(analysis = 1:384, assessment = 385:480), changed), metrics = metrics)
      assert_conditions(identical(workflows::extract_fit_engine(fit)$postprocessing,
        workflows::extract_fit_engine(other$.workflow[[1]])$postprocessing),
        identical(predict(fit, d, type = "prob"), predict(other$.workflow[[1]], d, type = "prob")))
    }
    cases[[paste(k, method, classification)]] <- list(fit = fit, schema = schema,
      new = d[setdiff(names(d), outcome)])
  }
}

# Each inner pair learns its complete recipe/engine on B_j and its numeric
# postprocessor on disjoint P_j. P folds partition Q; B_j is Q minus P_j.
# Average finished numeric pair predictions equally, then calibrate VA on C.
# CVAR averages outer fold points and bounds separately: these bounds are
# descriptive VA bounds, not confidence or prediction intervals.
packages <- c("vennabers", "workflows", "tailor", "probably", "recipes", "rsample", "tune", "yardstick")
cases <- list()
if (all(vapply(packages, requireNamespace, logical(1), quietly = TRUE))) {
  source(system.file("examples", "assertions.R", package = "vennabers"), local = TRUE)
  audit <- new.env()
  sys.source(system.file("examples", "check-encoded-evaluation.R", package = "vennabers"), audit)
  original <- data.frame("input value" = sin(1:120),
    "target y" = 10 + 3 * sin(1:120) + cos(1:120) + sin((1:120) / 4), check.names = FALSE)
  schema <- vennabers::venn_abers_schema(original, "target y")
  d <- vennabers::venn_abers_encode(original, schema)
  outcome <- schema$encoded_outcome
  base <- workflows::workflow() |>
    workflows::add_recipe(recipes::recipe(reformulate(setdiff(names(d), outcome), outcome), d) |>
      recipes::step_normalize(recipes::all_numeric_predictors())) |>
    workflows::add_model(parsnip::linear_reg(engine = "lm"))
  metrics <- yardstick::metric_set(yardstick::rmse, yardstick::mae)
  outer <- withr::with_seed(74, rsample::vfold_cv(d, v = 2, repeats = 2))
  split <- rsample::make_splits(list(analysis = 1:90, assessment = 91:120), d)
  for (post_method in c("tailor_linear", "isotonic_numeric")) for (method in c("inductive", "cross")) {
    # Linear requires >=3 P rows and rank two; isotonic requires >=2 finite
    # P rows and permits constant inputs/truths. Failed pairs abort the fit.
    post <- list(method = post_method, strategy = "ensemble", v = 3L)
    options <- if (method == "inductive") list(m = 1) else list(epsilon = .5, v = 3L)
    spec <- do.call(vennabers::calibrated_workflow, c(list(workflow = base,
      outcome = outcome, schema = schema, method = method, seed = 42,
      postprocessing = post), options))
    resampled <- tune::fit_resamples(spec, outer, metrics = metrics,
      control = tune::control_resamples(save_pred = TRUE, extract = workflows::extract_fit_engine, allow_par = FALSE))
    audit$check_encoded_evaluation(resampled, outer, schema)
    states <- tune::collect_extracts(resampled)$.extracts
    for (i in seq_along(states)) for (ensemble in states[[i]]$postprocessing) {
      assert_conditions(ensemble$observed_base_fits == 3L, ensemble$observed_postprocessor_fits == 3L,
        identical(sort(unlist(lapply(ensemble$inner_folds, `[[`, "P"), use.names = FALSE)), sort(ensemble$Q)))
      for (plan in ensemble$inner_folds) {
        Q <- as.integer(outer$splits[[i]], "analysis")
        A <- as.integer(outer$splits[[i]], "assessment")
        assert_conditions(!any(Q[c(plan$B, plan$P, plan$C)] %in% A),
          !length(intersect(plan$B, plan$P)), !length(intersect(plan$Q, plan$C)),
          plan$observed_base_fits == 1L, plan$observed_postprocessor_fits == 1L)
      }
    }
    last <- tune::last_fit(spec, split, metrics = metrics)
    fit <- last$.workflow[[1L]]
    new <- d[91:120, setdiff(names(d), outcome), drop = FALSE]
    native <- vennabers::venn_abers_details(fit, new)
    decoded <- vennabers::venn_abers_decode(native, schema)
    collected <- tune::collect_predictions(last, summarize = FALSE)
    scores <- tune::collect_metrics(last)
    expected <- c(rmse = yardstick::rmse_vec(original[[schema$outcome]][91:120], decoded$prediction),
      mae = yardstick::mae_vec(original[[schema$outcome]][91:120], decoded$prediction))
    assert_conditions(nrow(tune::collect_notes(last)) == 0L, identical(collected$.row, 91:120),
      !anyDuplicated(collected$.row), all(collected$.config == "pre0_mod0_post0"),
      nrow(scores) == 2L, all(abs(scores$.estimate - expected[scores$.metric]) <= 1e-10),
      identical(collected$.pred, native$prediction$.pred), all(is.finite(decoded$prediction)),
      all(native$details$postprocessing_method == post_method),
      all(native$details$postprocessing_input == "numeric"), all(lengths(native$details$inner_fold) == 3L),
      identical(decoded$postprocessing[[1]]$inner_folds[[1]]$columns, names(original)))
    # Mutate A predictors and truth separately: neither may affect any learning.
    before <- workflows::extract_fit_engine(fit)
    for (column in c(names(d)[1L], outcome)) {
      changed <- d; changed[91:120, column] <- changed[91:120, column] + 100
      other <- tune::last_fit(spec, rsample::make_splits(list(analysis = 1:90, assessment = 91:120), changed), metrics = metrics)
      assert_conditions(nrow(tune::collect_notes(other)) == 0L)
      other_fit <- other$.workflow[[1L]]; after <- workflows::extract_fit_engine(other_fit)
      assert_conditions(identical(before$postprocessing, after$postprocessing),
        identical(before$calibrator, after$calibrator), identical(predict(fit, new), predict(other_fit, new)))
      for (id in names(before$models)) for (j in names(before$models[[id]]$models)) {
        left <- before$models[[id]]$models[[j]]; right <- after$models[[id]]$models[[j]]
        if (post_method == "isotonic_numeric") {
          assert_conditions(identical(left$isotonic, right$isotonic))
          left <- left$workflow; right <- right$workflow
        }
        assert_conditions(identical(coef(workflows::extract_fit_engine(left)), coef(workflows::extract_fit_engine(right))),
          identical(workflows::extract_recipe(left)$steps, workflows::extract_recipe(right)$steps))
      }
    }
    cases[[paste(post_method, method)]] <- list(fit = fit, new = new, schema = schema)
  }
}

# Class pairs (pair_N) and inner B/P model/postprocessor pairs are different:
# each class pair owns its VA folds, and each VA fold retains its own B/P paths.
source(system.file("examples", "assertions.R", package = "vennabers"))
packages <- c("vennabers", "workflows", "recipes", "rsample", "tune", "yardstick", "tailor", "probably")
if (all(vapply(packages, requireNamespace, logical(1), quietly = TRUE))) {
  library(vennabers)
  raw <- data.frame(x = sin(1:360), z = cos(1:360),
    truth = factor(rep(c("class", "a b", "class", "a.b", "a b", "class"), 60),
      levels = c("class", "a b", "a.b")))
  names(raw) <- c("input value", "a.b", ".pred_class")
  schema <- venn_abers_schema(raw, ".pred_class", classification = "ovo")
  d <- venn_abers_encode(raw, schema); outcome <- schema$encoded_outcome
  predictors <- setdiff(names(d), outcome)
  base <- workflows::workflow() |> workflows::add_recipe(
    recipes::recipe(reformulate(predictors, outcome), d) |>
      recipes::step_normalize(recipes::all_numeric_predictors())) |>
    workflows::add_model(parsnip::logistic_reg(engine = "glm"))
  outer <- withr::with_seed(41, rlang::inject(rsample::vfold_cv(d, v = 2, repeats = 2, strata = !!outcome, pool = 0)))
  split <- rsample::make_splits(list(analysis = 1:270, assessment = 271:360), d)
  metrics <- yardstick::metric_set(yardstick::brier_class, yardstick::mn_log_loss)
  checker <- new.env()
  sys.source(system.file("examples", "check-encoded-evaluation.R", package = "vennabers"), checker)
  cases <- list()
  for (kind in c("tailor_logistic", "probability", "glm_link")) for (strategy in c("holdout", "ensemble"))
    for (method in c("inductive", "cross")) {
    post <- list(method = if (kind == "tailor_logistic") kind else "sigmoid", strategy = strategy)
    if (kind != "tailor_logistic") post$sigmoid_input <- kind
    if (strategy == "holdout") post$prop <- .3 else post$v <- 2L
    args <- list(base, outcome, schema = schema, model_training = "pairwise", method = method,
      seed = 42, postprocessing = post)
    if (method == "cross") args$v <- 2L
    model <- do.call(calibrated_workflow, args)
    result <- tune::fit_resamples(model, outer, metrics = metrics,
      control = tune::control_resamples(save_pred = TRUE, extract = workflows::extract_fit_engine, allow_par = FALSE))
    checker$check_encoded_evaluation(result, outer, schema)
    states <- tune::collect_extracts(result)$.extracts
    for (i in seq_along(states)) {
      local <- rsample::analysis(outer$splits[[i]])
      analysis_rows <- as.integer(outer$splits[[i]], "analysis")
      A <- as.integer(outer$splits[[i]], "assessment")
      for (component in states[[i]]$pair_models) for (diagnostic in component$postprocessing) {
        members <- if (strategy == "ensemble") diagnostic$inner_folds else list(diagnostic)
        for (p in members) assert_conditions(
          all(as.character(local[[outcome]][component$rows]) %in% component$class_levels),
          identical(p$pair_id, component$pair_id), identical(p$classes, component$class_levels),
          !any(analysis_rows[component$rows[c(p$B, p$P, p$C)]] %in% A),
          !length(intersect(p$B, p$P)), !length(intersect(p$Q, p$C)))
      }
    }
    last <- tune::last_fit(model, split, metrics = metrics)
    native <- tune::collect_predictions(last); scores <- tune::collect_metrics(last)
    decoded <- venn_abers_decode(native, schema)
    values <- c(brier_class = yardstick::brier_class_vec(decoded$truth, decoded$probability),
      mn_log_loss = yardstick::mn_log_loss_vec(decoded$truth, decoded$probability))
    fit <- tune::extract_workflow(last)
    new <- d[271:360, predictors]
    assert_conditions(nrow(tune::collect_notes(last)) == 0L, identical(native$.row, 271:360),
      !anyDuplicated(native$.row), all(native$.config == "pre0_mod0_post0"),
      identical(native[[outcome]], d[[outcome]][271:360]), nrow(scores) == 2L,
      setequal(scores$.metric, names(values)), all(is.finite(scores$.estimate)),
      all(abs(scores$.estimate - values[scores$.metric]) <= 1e-10),
      all(abs(as.matrix(native[paste0(".pred_", schema$classes)]) - as.matrix(predict(fit, new, type = "prob"))) <= 1e-10))
    state <- workflows::extract_fit_engine(fit)
    details <- venn_abers_details(fit, new)
    cost <- sum(vapply(state$pair_models, function(p) sum(vapply(p$postprocessing, `[[`, 1L, "observed_base_fits")), 1L))
    stopifnot(cost == 3L * (if (method == "cross") 2L else 1L) * (if (strategy == "ensemble") 2L else 1L),
      identical(details$prediction, predict(fit, new, type = "prob")))
    # A truth and predictor changes affect assessment only, never any class pair.
    for (column in c(predictors[1], outcome)) {
      changed <- d
      if (column == outcome) changed[[column]][271:360] <- schema$classes[1] else changed[[column]][271:360] <- 1000
      other <- tune::last_fit(model, rsample::make_splits(list(analysis = 1:270, assessment = 271:360), changed), metrics = metrics)
      other_fit <- tune::extract_workflow(other)
      stopifnot(identical(venn_abers_details(fit, new), venn_abers_details(other_fit, new)))
    }
    cases[[paste(kind, strategy, method)]] <- list(fit = fit, new = new, schema = schema)
    cat(kind, strategy, method, ": 3 class pairs;", cost, "retained model/postprocessor pairs.\n")
  }
}

# Full means an additional complete B/P composition on F (each local class
# pair for pairwise OvO), not an engine fitted on every F row. F gets its own
# holdout/inner folds. Held C predictions and VA calibrators stay unchanged;
# after success only F workflows remain, alongside all source diagnostics.
# Transfer to F changes the predictor distribution: split-calibration guarantees
# do not automatically transfer. CVAR bounds remain descriptive VA bounds.
source(system.file("examples", "assertions.R", package = "vennabers"))
packages <- c("vennabers", "workflows", "recipes", "rsample", "tune", "yardstick", "tailor", "probably", "nnet")
cases <- list()
if (all(vapply(packages, requireNamespace, logical(1), quietly = TRUE))) {
  library(vennabers)
  checker <- new.env()
  sys.source(system.file("examples", "check-encoded-evaluation.R", package = "vennabers"), checker)
  # Ten domain/method choices x two strategies x two VA methods x two sources.
  domains <- data.frame(path = c("binary", "binary", "pairwise", "pairwise",
    "ovo3", "ovr3", "ovo2", "ovr2", "regression", "regression"),
    post = c("sigmoid", "tailor_logistic", "sigmoid", "tailor_logistic",
      "tailor_multinomial", "tailor_multinomial", "tailor_logistic", "tailor_logistic",
      "isotonic_numeric", "tailor_linear"))
  for (i in seq_len(nrow(domains))) {
    path <- domains$path[i]; kind <- domains$post[i]
    regression <- path == "regression"; pairwise <- path == "pairwise"
    classification <- if (pairwise) "ovo" else if (path %in% c("binary", "regression")) "binary" else substr(path, 1, 3)
    k <- if (pairwise || path %in% c("ovo3", "ovr3")) 3L else 2L
    raw <- withr::with_seed(123, {
      cl <- factor(rep(c("a a", "a.a", "class")[seq_len(k)], length.out = 480),
        levels = c("a a", "a.a", "class")[seq_len(k)])
      x <- rnorm(480, sd = 2) + c(-1, 1, -1)[cl]
      z <- rnorm(480, sd = 2) + c(-1, -1, 1)[cl]
      w <- rnorm(480, sd = 2) + c(1, -1, -1)[cl]
      data.frame(x = x, z = z, w = w, truth = if (regression) 10 + 2*x + z + rnorm(480) else cl)
    })
    names(raw) <- c("input value", "input.value", "other value", ".pred_class")
    schema <- if (regression) venn_abers_schema(raw, ".pred_class") else
      venn_abers_schema(raw, ".pred_class", classification = classification)
    d <- venn_abers_encode(raw, schema); outcome <- schema$encoded_outcome
    predictors <- setdiff(names(d), outcome)
    engine <- if (regression) parsnip::linear_reg(engine = "lm") else
      if (pairwise || k == 2L) parsnip::logistic_reg(engine = "glm") else
        parsnip::multinom_reg(penalty = .1) |> parsnip::set_engine("nnet", trace = FALSE, maxit = 1000)
    # maxit = 1000 controls only B. Tailor multinomial P still uses probably's
    # default 100 iterations. Any unconverged pair fails the whole composition
    # with fold/pair/B/P context, without retry, method switch or partial ensemble.
    base <- workflows::workflow() |> workflows::add_recipe(
      recipes::recipe(reformulate(predictors, outcome), d) |>
        recipes::step_normalize(recipes::all_numeric_predictors())) |> workflows::add_model(engine)
    # Repeated outer folds: identities are checked on (id, id2, .row, .config).
    # Small nested data: with seed 44 one pairwise Tailor P of 25 rows stops
    # unconverged and that resample fails (no retry, no switch to none); seeds
    # 43 and 45 keep a converged separable pairwise B engine with its retained
    # glm warning, a tune note. This example uses 42, whose evaluation has none.
    outer <- withr::with_seed(42, rsample::vfold_cv(d, v = 2, repeats = 2))
    split <- rsample::make_splits(list(analysis = 1:384, assessment = 385:480), d)
    metrics <- if (regression) yardstick::metric_set(yardstick::rmse, yardstick::mae) else
      yardstick::metric_set(yardstick::brier_class, yardstick::mn_log_loss)
    for (strategy in c("holdout", "ensemble")) for (method in c("inductive", "cross"))
      for (mode in c("matched", "full")) {
      post <- list(method = kind, strategy = strategy)
      if (kind == "sigmoid") post$sigmoid_input <- "probability"
      if (strategy == "holdout") post$prop <- .3 else post$v <- 3L
      args <- list(base, outcome, schema = schema, method = method,
        prediction_model = mode, seed = 24, postprocessing = post)
      if (method == "cross") args$v <- 2L
      if (pairwise) args$model_training <- "pairwise"
      model <- do.call(calibrated_workflow, args)
      result <- tune::fit_resamples(model, outer, metrics = metrics,
        control = tune::control_resamples(save_pred = TRUE, extract = workflows::extract_fit_engine, allow_par = FALSE))
      checker$check_encoded_evaluation(result, outer, schema)
      states <- checker$check_outer_identities(result, outer, metrics = 2L)$extracts
      for (h in seq_along(states)) {
        components <- if (pairwise) states[[h]]$pair_models else list(states[[h]])
        F_rows <- as.integer(outer$splits[[h]], "analysis"); A_rows <- as.integer(outer$splits[[h]], "assessment")
        for (component in components) {
          rows <- if (pairwise) component$rows else seq_along(F_rows)
          for (diagnostic in component$postprocessing) {
            members <- if (strategy == "ensemble") diagnostic$inner_folds else list(diagnostic)
            for (p in members) assert_conditions(!any(F_rows[rows[c(p$B, p$P, p$C)]] %in% A_rows),
              !length(intersect(p$B, p$P)), !length(intersect(p$Q, p$C)),
              p$observed_base_fits == 1L, p$observed_postprocessor_fits == 1L)
          }
          if (mode == "full") stopifnot(identical(names(component$models), "Full1"),
            identical(component$postprocessing$Full1$Q, seq_along(rows)))
        }
      }
      last <- tune::last_fit(model, split, metrics = metrics)
      fit <- tune::extract_workflow(last); new <- d[385:480, predictors]
      native <- tune::collect_predictions(last)
      decoded <- venn_abers_decode(native, schema)
      values <- if (regression) c(rmse = yardstick::rmse_vec(decoded$truth, decoded$prediction),
        mae = yardstick::mae_vec(decoded$truth, decoded$prediction)) else {
        p <- decoded$probability
        if (ncol(p) == 2L) p <- p[, 1L]
        c(brier_class = yardstick::brier_class_vec(decoded$truth, p),
          mn_log_loss = yardstick::mn_log_loss_vec(decoded$truth, p))
      }
      scores <- tune::collect_metrics(last)
      assert_conditions(nrow(tune::collect_notes(last)) == 0L, identical(native$.row, 385:480),
        !anyDuplicated(native$.row), all(native$.config == "pre0_mod0_post0"),
        identical(native[[outcome]], d[[outcome]][385:480]), nrow(scores) == 2L,
        setequal(scores$.metric, names(values)), all(is.finite(scores$.estimate)),
        all(abs(scores$.estimate - values[scores$.metric]) <= 1e-10))
      prediction <- predict(fit, new, type = if (regression) "numeric" else "prob")
      stopifnot(identical(as.matrix(native[names(prediction)]), as.matrix(prediction)))
      if (mode == "full") for (column in c(predictors[1L], outcome)) {
        changed <- d
        if (column != outcome || regression) changed[[column]][385:480] <- changed[[column]][385:480] + 100 else
          changed[[column]][385:480] <- rev(changed[[column]][385:480])
        other <- tune::last_fit(model, rsample::make_splits(list(analysis = 1:384, assessment = 385:480), changed), metrics = metrics)
        stopifnot(nrow(tune::collect_notes(other)) == 0L,
          identical(venn_abers_details(fit, new), venn_abers_details(tune::extract_workflow(other), new)))
      }
      cases[[paste(path, kind, strategy, method, mode)]] <- list(fit = fit, new = new, schema = schema)
      cat(path, kind, strategy, method, mode, ": native evaluation complete.\n")
    }
  }
  stopifnot(length(cases) == 80L)
}