---
title: "Build consensus and stitch across slices"
name: consensus-stitch
description: Understand the two independent Slice-MSF controls for ensembles and volumetric topology.
output:
  rmarkdown::html_vignette:
    toc: yes
    toc_depth: 2
    css: albers.css
    includes:
      in_header: albers-header.html
params:
  family: red
  base_size: 13
  content_width: 72
  preset: homage
resource_files:
- albers.css
- albers.js
- albers-header.html
- fonts
vignette: |
  %\VignetteIndexEntry{Build consensus and stitch across slices}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(
  collapse = TRUE, comment = "#>", message = FALSE, warning = FALSE,
  fig.align = "center", fig.retina = 2, out.width = "100%",
  fig.width = 7, fig.asp = 0.55
)
if (requireNamespace("albersdown", quietly = TRUE) &&
    requireNamespace("ggplot2", quietly = TRUE)) {
  ggplot2::theme_set(albersdown::theme_albers(family = params$family, preset = params$preset))
}
library(neurocluster)
```

```{r albers-classes, echo=FALSE, results='asis'}
cat(sprintf(
  paste0('<script>document.addEventListener("DOMContentLoaded",function(){',
         'document.body.classList.add("palette-%s","preset-%s");',
         '});</script><style>:root{--content:%sch}</style>'),
  params$family, params$preset, params$content_width
))
```

Slice-MSF has two controls that solve different problems. `consensus = TRUE`
combines multiple seeded DCT-subspace runs. `stitch_z = TRUE` adds graph edges
across axial slices. One changes ensemble evidence; the other changes which
spatial connections are possible.

> **Experimental method.** Slice-MSF is available for explicit evaluation but
> is not currently recommended automatically or for production use. Read the
> [Slice-MSF evaluation contract](slice-msf.html) before interpreting this
> vignette; local regression repairs are complete, but release-level
> recertification is still pending.

## What does stitching change?

The following example uses one run so stitching is the only changed control.
Natural segmentation (`target_k_global = -1`) is used because a global exact-K
target is unavailable when slices are independent.

```{r stitch-data, include=FALSE}
set.seed(7)
dims <- c(8L, 8L, 4L)
n_time <- 32L
tt <- 0:(n_time - 1L)
dct_basis <- vapply(
  seq_len(15L),
  function(k) cos(pi * (tt + 0.5) * k / n_time),
  numeric(n_time)
)
values <- array(0, c(dims, n_time))
truth_array <- array(0L, dims)
for (z in seq_len(dims[3])) {
  for (y in seq_len(dims[2])) {
    for (x in seq_len(dims[1])) {
      region <- 1L + (x - 1L) %/% 2L + 4L * ((y - 1L) %/% 4L)
      truth_array[x, y, z] <- region
      coefficients <- rnorm(15L, sd = 0.08)
      coefficients[region] <- 1
      coefficients[min(15L, region + 4L)] <- 0.5
      values[x, y, z, ] <-
        as.vector(dct_basis %*% coefficients) + rnorm(n_time, sd = 0.02)
    }
  }
}
syn <- list(
  vec = neuroim2::NeuroVec(
    values, neuroim2::NeuroSpace(c(dims, n_time))
  ),
  mask = neuroim2::NeuroVol(
    array(1, dims), neuroim2::NeuroSpace(dims)
  ),
  truth = as.integer(truth_array), dims = dims
)
stopifnot(length(unique(syn$truth)) == 8L, !anyNA(syn$truth))
```

```{r stitch-fits}
independent <- slice_msf(
  syn$vec, syn$mask, target_k_global = -1,
  r = 6, compactness = 10, min_size = 2, num_runs = 1,
  consensus = FALSE, stitch_z = FALSE, seed = 17
)
stitched <- slice_msf(
  syn$vec, syn$mask, target_k_global = -1,
  r = 6, compactness = 10, min_size = 2, num_runs = 1,
  consensus = FALSE, stitch_z = TRUE, seed = 17
)
```

```{r stitch-check, include=FALSE}
v_independent <- validate_cluster4d(independent, syn$vec, syn$mask)
v_stitched <- validate_cluster4d(stitched, syn$vec, syn$mask)
stopifnot(v_independent$valid, v_stitched$valid)
stopifnot(!isTRUE(independent$metadata$topology$volumetric))
stopifnot(isTRUE(stitched$metadata$topology$volumetric))
stopifnot(all(independent$labels > 0), all(stitched$labels > 0))
stopifnot(independent$actual_k > 1L, stitched$actual_k > 1L)
adjacent_slice_ari <- function(fit) {
  labels <- array(fit$labels, syn$dims)
  mean(vapply(seq_len(syn$dims[3] - 1L), function(z) {
    clustering_accuracy(
      as.vector(labels[, , z]), as.vector(labels[, , z + 1L])
    )$ari
  }, numeric(1)))
}
continuity <- data.frame(
  topology = c("independent slices", "stitched 3-D graph"),
  mean_adjacent_slice_ari = c(
    adjacent_slice_ari(independent), adjacent_slice_ari(stitched)
  )
)
stopifnot(all(is.finite(continuity$mean_adjacent_slice_ari)))
align_to_truth <- function(labels) {
  ids <- sort(unique(labels))
  map <- vapply(ids, function(id) {
    counts <- table(syn$truth[labels == id])
    as.integer(names(counts)[which.max(counts)])
  }, integer(1))
  unname(map[match(labels, ids)])
}
```

```{r continuity-summary, echo=FALSE}
knitr::kable(
  transform(continuity,
            mean_adjacent_slice_ari = round(mean_adjacent_slice_ari, 3)),
  caption = "Label-invariant continuity across adjacent axial slices."
)
```

```{r stitch-figure, echo=FALSE, fig.cap='Adjacent axial slices from independent-slice and stitched Slice-MSF fits. Each fitted subparcel is colored by its majority known region, giving the same eight-color meaning in all panels.', fig.alt='Four maps compare slices two and three under independent-slice and stitched graph topologies.'}
palette_cb <- c("#0072B2", "#D55E00", "#009E73", "#CC79A7",
               "#E69F00", "#56B4E9", "#F0E442", "#000000")
label_array <- function(fit) array(align_to_truth(fit$labels), dim = syn$dims)
a <- label_array(independent)
b <- label_array(stitched)
old_par <- par(mfrow = c(2, 2), mar = c(1.2, 1.2, 2.3, 0.6))
image(a[, , 2], col = palette_cb, axes = FALSE, main = "independent: z = 2"); box()
image(a[, , 3], col = palette_cb, axes = FALSE, main = "independent: z = 3"); box()
image(b[, , 2], col = palette_cb, axes = FALSE, main = "stitched: z = 2"); box()
image(b[, , 3], col = palette_cb, axes = FALSE, main = "stitched: z = 3"); box()
par(old_par)
```

**What to notice.** The stitched fit is allowed to propagate parcel identity
through axial edges; the independent fit is not. The adjacent-slice ARI is
label-invariant and changes from
`r sprintf("%.3f", continuity$mean_adjacent_slice_ari[1])` to
`r sprintf("%.3f", continuity$mean_adjacent_slice_ari[2])` on this fixture.
Its direction is descriptive of this fixture, not a promise that stitching
improves a scientific endpoint.

## What does consensus change?

For `num_runs > 1`, Slice-MSF constructs seeded DCT subspaces and fuses the run
partitions. The seed is recorded and the caller’s random-number stream is
preserved. Consensus is not a promise of improved accuracy; it is a defined
ensemble procedure whose stability and quality must be evaluated for the task.

```{r consensus-fit}
ensemble <- slice_msf(
  syn$vec, syn$mask, target_k_global = 8,
  r = 6, compactness = 10, min_size = 2, num_runs = 3,
  consensus = TRUE, use_features = TRUE, ensemble_fraction = 0.6,
  stitch_z = TRUE, seed = 17
)
```

```{r consensus-check, include=FALSE}
v_ensemble <- validate_cluster4d(ensemble, syn$vec, syn$mask)
stopifnot(v_ensemble$valid, ensemble$actual_k == 8L)
stopifnot(length(ensemble$metadata$ensemble$runs) == 3L)
stopifnot(identical(ensemble$metadata$ensemble$seed, 17L))
run_signatures <- vapply(
  ensemble$runs, function(run) paste(run$labels, collapse = ","), character(1)
)
consensus_stability <- data.frame(
  run = seq_along(ensemble$runs),
  run_clusters = vapply(
    ensemble$runs, function(run) length(unique(run$labels)), integer(1)
  ),
  ari_to_consensus = vapply(
    ensemble$runs,
    function(run) clustering_accuracy(run$labels, ensemble$labels)$ari,
    numeric(1)
  )
)
stopifnot(length(unique(run_signatures)) == 3L)
stopifnot(all(consensus_stability$run_clusters > 1L))
stopifnot(all(is.finite(consensus_stability$ari_to_consensus)))
```

```{r consensus-stability-table, echo=FALSE}
knitr::kable(
  transform(consensus_stability,
            ari_to_consensus = round(ari_to_consensus, 3)),
  caption = "The three seeded runs are nondegenerate and distinct; ARI measures each run's agreement with the fused eight-parcel result."
)
```

```{r consensus-stability-figure, echo=FALSE, fig.cap='Agreement of each distinct seeded run with the final consensus partition. Variation across runs is visible rather than hidden behind the fused result.', fig.alt='Three orange points show adjusted Rand agreement with consensus, ranging from roughly 0.68 to 0.73.'}
plot(consensus_stability$run, consensus_stability$ari_to_consensus,
     type = "b", pch = 17, lwd = 2, col = "#E69F00", bty = "l",
     xaxt = "n", ylim = c(0, 1), xlab = "seeded run",
     ylab = "ARI to consensus")
axis(1, at = consensus_stability$run)
```

The exact-K claim above is scoped to this connected mask and requested target;
the hidden check makes the vignette fail if it changes. The natural K, requested
K, pre/post sizes, repair direction, and effective run controls are available in
`ensemble$metadata$exact_k_repair`. Consensus does not erase run-to-run
variation: the table and figure expose it. For parameter tuning and comparison,
continue to [Choose parameters](choose-parameters.html) and [Validate and compare
clusterings](validate-compare.html).