---
title: 'End-to-end: From NIfTI to clusters'
name: end-to-end-export
description: Read 4D data and a mask, fit a checked partition, and round-trip its NIfTI label map.
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{End-to-end: From NIfTI to clusters}
%\VignetteEngine{knitr::rmarkdown}
%\VignetteEncoding{UTF-8}
---
```{r setup, include=FALSE}
if (requireNamespace("albersdown", quietly = TRUE)) albersdown::albers_register_fonts()
knitr::opts_chunk$set(
collapse = TRUE, comment = "#>", fig.align = "center", fig.retina = 2,
out.width = "100%", fig.width = 8.5, fig.asp = 0.56,
message = FALSE, warning = FALSE
)
options(width = 88)
suppressPackageStartupMessages({
library(neurocluster)
library(neuroim2)
})
parcel_colors <- c("#0072B2", "#E69F00", "#009E73", "#CC79A7",
"#56B4E9", "#D55E00", "#F0E442", "#000000")
```
```{r albers-classes, echo=FALSE, results='asis'}
cat(sprintf(paste0(
''
), params$family, params$preset, params$content_width))
```
# What does the complete workflow do? {#workflow}
The production path has five explicit boundaries: read the 4D image and mask,
check that their geometry matches, fit a partition, validate the returned object
against those inputs, and write then reread the label map. This article executes
every boundary using temporary NIfTI files created from a deterministic fixture.
For your analysis, replace only `vec_file` and `mask_file` with your own paths.
The remaining calls are the same.
# How do you create a reproducible input boundary? {#fixture}
The generated data contain four spatial regions with distinct time series. We
write them first so the example exercises the same I/O path as external files.
```{r write-inputs}
base_source <- generate_synthetic_volume(
scenario = "gaussian_blobs", dims = c(16, 16, 8),
n_clusters = 4, n_time = 40, noise_sd = 0.08, seed = 42
)
dims <- base_source$dims
ijk <- arrayInd(seq_len(prod(dims)), dims)
inside <- ((ijk[, 1] - 8.5) / 7.5)^2 +
((ijk[, 2] - 8.5) / 7.0)^2 + ((ijk[, 3] - 4.5) / 3.8)^2 <= 1
mask_array <- array(as.integer(inside), dims)
spatial_space <- neuroim2::NeuroSpace(
dims, spacing = c(2, 2.5, 3), origin = c(-18, 7, 11)
)
series_space <- neuroim2::NeuroSpace(
c(dims, 40L), spacing = c(2, 2.5, 3), origin = c(-18, 7, 11)
)
series_values <- array(
as.numeric(base_source$vec), dim = dim(base_source$vec)
)
source_data <- list(
vec = neuroim2::NeuroVec(series_values, series_space),
mask = neuroim2::NeuroVol(mask_array, spatial_space),
truth = base_source$truth[inside], dims = dims
)
stopifnot(all(sort(unique(source_data$truth)) == 1:4), any(!inside), any(inside))
vec_file <- file.path(tempdir(), "neurocluster-input-4d.nii.gz")
mask_file <- file.path(tempdir(), "neurocluster-input-mask.nii.gz")
neuroim2::write_vec(source_data$vec, vec_file)
neuroim2::write_vol(source_data$mask, mask_file)
```
# How do you read and check the data? {#read-inputs}
Use `read_vec()` for a 4D image and `read_vol()` for a 3D mask. The mask controls
both which voxels enter clustering and the order of returned labels.
```{r read-inputs}
vec <- neuroim2::read_vec(vec_file)
mask <- neuroim2::read_vol(mask_file)
input_max_abs_error <- max(abs(as.array(vec) - as.array(source_data$vec)))
c(vec_dimensions = paste(dim(vec), collapse = " x "),
mask_dimensions = paste(dim(mask), collapse = " x "),
included_voxels = sum(as.array(mask) > 0),
max_signal_roundtrip_error = signif(input_max_abs_error, 3))
```
```{r check-inputs, include=FALSE}
stopifnot(
identical(dim(vec)[1:3], dim(mask)),
identical(dim(vec), c(16L, 16L, 8L, 40L)),
isTRUE(all.equal(neuroim2::space(vec), neuroim2::space(source_data$vec))),
isTRUE(all.equal(neuroim2::space(mask), neuroim2::space(source_data$mask))),
isTRUE(all.equal(neuroim2::trans(neuroim2::space(vec)),
neuroim2::trans(neuroim2::space(mask)))),
input_max_abs_error < 2e-6,
identical(as.integer(as.array(mask)),
as.integer(as.array(source_data$mask))),
all(is.finite(as.array(mask))),
sum(as.array(mask) > 0) == length(source_data$truth)
)
```
# How do you fit and validate the partition? {#fit}
ReNA is used here to keep the first production-style path concise. Method choice
and tuning should be justified separately; see [Compare methods](compare-methods.html)
and [Choose parameters](choose-parameters.html).
```{r fit-partition}
fit <- cluster4d(
vec, mask, n_clusters = 4, method = "rena",
connectivity = 26, parallel = FALSE
)
validation <- validate_cluster4d(fit, vec, mask)
c(valid = validation$valid, requested_k = 4, actual_k = fit$actual_k)
```
```{r measure-partition}
metrics <- cluster_metrics(fit, truth = source_data$truth)
metrics[c("ari_truth", "size_summary", "spatial_rms_distance_mm")]
```
```{r check-fit, include=FALSE}
stopifnot(
validation$valid,
length(validation$errors) == 0L,
identical(fit$actual_k, 4L),
is.finite(metrics$ari_truth), metrics$ari_truth > 0.75,
all(metrics$size_summary > 0),
is.finite(metrics$spatial_rms_distance_mm)
)
voxel_series <- as.matrix(neuroim2::series(
vec, which(as.array(mask) > 0)
))
temporal_sd <- apply(voxel_series, 2, sd)
sd_array <- array(NA_real_, dim(mask))
sd_array[which(as.array(mask) > 0)] <- temporal_sd
label_array <- as.array(fit$clusvol)
```
```{r input-output-figure, echo=FALSE, fig.cap='The input temporal variability and fitted parcel map at the same middle axial slice. The quantitative color bar reports temporal standard deviation; the parcel colors are categorical and intentionally use a different scale.', fig.alt='An axial heat map of temporal standard deviation with a numbered color bar beside a categorical four-parcel map, all within an ellipsoidal mask.'}
old_par <- par(no.readonly = TRUE)
layout(matrix(c(1, 2, 3), nrow = 1), widths = c(1, 0.16, 1))
par(mar = c(1, 1, 3, 1))
sd_slice <- sd_array[, , 4]
sd_colors <- hcl.colors(64, "YlOrRd", rev = TRUE)
sd_limits <- range(sd_slice, na.rm = TRUE)
image(t(sd_slice[, ncol(sd_slice):1]), col = sd_colors, zlim = sd_limits,
axes = FALSE, useRaster = TRUE, asp = 1, main = "Input temporal SD")
box(col = "#4A4A4A")
par(mar = c(1, 0, 3, 3))
legend_values <- seq(sd_limits[1], sd_limits[2], length.out = length(sd_colors))
image(1, legend_values, matrix(legend_values, nrow = 1), col = sd_colors,
axes = FALSE, xlab = "", ylab = "", useRaster = TRUE)
axis(4, las = 1, cex.axis = 0.8)
par(mar = c(1, 1, 3, 1))
label_slice <- label_array[, , 4]
image(t(label_slice[, ncol(label_slice):1]),
col = parcel_colors[seq_len(fit$actual_k)],
zlim = c(0.5, fit$actual_k + 0.5), axes = FALSE,
useRaster = TRUE, asp = 1, main = "Fitted parcels")
box(col = "#4A4A4A")
layout(1)
par(old_par)
```
# How do you export and prove the round trip? {#export}
Write the `ClusteredNeuroVol` directly. It carries the source geometry and final
integer labels. Then read the file back and compare every voxel with the object
that produced it.
```{r export-result}
output_file <- file.path(tempdir(), "neurocluster-parcels.nii.gz")
neuroim2::write_vol(fit$clusvol, output_file)
exported <- neuroim2::read_vol(output_file)
c(path = output_file, bytes = file.info(output_file)$size,
labels = paste(sort(unique(as.integer(as.array(exported)))), collapse = ", "))
```
```{r check-export, include=FALSE}
stopifnot(
file.exists(output_file),
identical(dim(exported), dim(mask)),
isTRUE(all.equal(neuroim2::space(exported), neuroim2::space(mask))),
identical(as.integer(as.array(exported)),
as.integer(as.array(fit$clusvol))),
identical(sort(unique(as.integer(as.array(exported)))), c(0L, seq_len(fit$actual_k))),
all(as.array(exported)[as.array(mask) == 0] == 0)
)
unlink(c(vec_file, mask_file, output_file))
```
# What should you preserve with the result? {#provenance}
Keep the input mask, image geometry, preprocessing record, package version,
method, complete parameters, requested and actual K, validation outcome, and
selection diagnostics. The NIfTI label map is an exchange artifact; the full
`cluster4d_result` retains richer feature-center and provenance information for
auditing and downstream R workflows.