inst/doc/coordinate-systems.R

In neuroim2: Data Structures for Brain Imaging Data

params <-
list(family = "red", preset = "homage")

## ----setup, include = FALSE---------------------------------------------------
if (requireNamespace("ggplot2", quietly = TRUE) && requireNamespace("albersdown", quietly = TRUE)) ggplot2::theme_set(albersdown::theme_albers(family = params$family, preset = params$preset))
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  message = FALSE,
  warning = FALSE
)

## ----load-pkg-----------------------------------------------------------------
library(neuroim2)

## ----create-space-------------------------------------------------------------
sp <- NeuroSpace(
  dim     = c(64L, 64L, 40L),
  spacing = c(2, 2, 2),
  origin  = c(-90, -126, -72)
)
sp

## ----inspect-space------------------------------------------------------------
dim(sp)       # grid dimensions
spacing(sp)   # voxel sizes in mm
origin(sp)    # world coords of voxel (1,1,1)
ndim(sp)      # number of spatial dimensions

## ----show-trans---------------------------------------------------------------
trans(sp)

## ----decompose-affine---------------------------------------------------------
# Translation column = origin
trans(sp)[1:3, 4]

# Diagonal of linear block = voxel sizes
diag(trans(sp)[1:3, 1:3])

## ----inverse-trans------------------------------------------------------------
inverse_trans(sp)

## ----explicit-affine----------------------------------------------------------
aff <- diag(c(3, 3, 4, 1))          # 3 × 3 × 4 mm voxels
aff[1:3, 4] <- c(-90, -126, -72)    # origin

sp_aff <- NeuroSpace(dim = c(60L, 60L, 35L), trans = aff)
spacing(sp_aff)   # derived from column norms of linear block
origin(sp_aff)    # derived from translation column

## ----coord-systems-diagram, echo=FALSE, fig.cap="The three addressing schemes and the functions that convert between them.", fig.width=5.5, fig.height=2.2----
op <- par(mar = c(0, 0, 0, 0))
plot.new()
plot.window(xlim = c(0, 10), ylim = c(0, 3))

# Boxes
rect(0.2, 0.8, 2.8, 2.2, col = "#dce8f5", border = "#3a7abf", lwd = 1.5)
rect(3.7, 0.8, 6.3, 2.2, col = "#dce8f5", border = "#3a7abf", lwd = 1.5)
rect(7.2, 0.8, 9.8, 2.2, col = "#dce8f5", border = "#3a7abf", lwd = 1.5)

text(1.5, 1.7, "Linear\nindex", cex = 0.85, font = 2)
text(1.5, 1.15, "1 ... prod(dim)", cex = 0.68, col = "#555555")
text(5.0, 1.7, "Grid\nindex", cex = 0.85, font = 2)
text(5.0, 1.15, "(i, j, k)  1-based", cex = 0.68, col = "#555555")
text(8.5, 1.7, "World\ncoords", cex = 0.85, font = 2)
text(8.5, 1.15, "x, y, z  mm", cex = 0.68, col = "#555555")

# Arrows and labels
arrows(2.85, 1.5, 3.65, 1.5, length = 0.08, lwd = 1.4, col = "#3a7abf")
arrows(3.65, 1.3, 2.85, 1.3, length = 0.08, lwd = 1.4, col = "#888888")
text(3.25, 1.75, "index_to_grid", cex = 0.58, col = "#3a7abf")
text(3.25, 1.05, "grid_to_index", cex = 0.58, col = "#888888")

arrows(6.35, 1.5, 7.15, 1.5, length = 0.08, lwd = 1.4, col = "#3a7abf")
arrows(7.15, 1.3, 6.35, 1.3, length = 0.08, lwd = 1.4, col = "#888888")
text(6.75, 1.75, "grid_to_coord", cex = 0.58, col = "#3a7abf")
text(6.75, 1.05, "coord_to_grid", cex = 0.58, col = "#888888")

# Shortcut arrows below
arrows(2.85, 0.9, 7.15, 0.9, length = 0.08, lwd = 1.2, col = "#3a7abf", lty = 2)
arrows(7.15, 0.7, 2.85, 0.7, length = 0.08, lwd = 1.2, col = "#888888", lty = 2)
text(5.0, 1.0, "index_to_coord", cex = 0.55, col = "#3a7abf")
text(5.0, 0.6, "coord_to_index", cex = 0.55, col = "#888888")

par(op)

## ----grid-index---------------------------------------------------------------
# Which linear index does grid position (10, 12, 5) map to?
grid_to_index(sp, matrix(c(10, 12, 5), nrow = 1))

# And back to grid
index_to_grid(sp, 8394L)

## ----grid-to-coord------------------------------------------------------------
grid_to_coord(sp, matrix(c(1, 1, 1), nrow = 1))   # should equal origin(sp)
grid_to_coord(sp, matrix(c(10, 12, 5), nrow = 1))

## ----grid-to-coord-multi------------------------------------------------------
pts <- matrix(c(
   1,  1,  1,
  32, 32, 20,
  64, 64, 40
), ncol = 3, byrow = TRUE)

grid_to_coord(sp, pts)

## ----coord-to-grid------------------------------------------------------------
coord_to_grid(sp, c(0, 0, 0))          # near isocenter
coord_to_grid(sp, matrix(c(0, 0, 0,
                           10, -20, 8), ncol = 3, byrow = TRUE))

## ----index-coord--------------------------------------------------------------
# Linear index 1 should land at the origin (pass integer)
index_to_coord(sp, 1L)

# World coord back to linear index
coord_to_index(sp, matrix(c(-90, -126, -72), nrow = 1))

## ----roundtrip----------------------------------------------------------------
idx   <- 12345L
grid  <- index_to_grid(sp, idx)
world <- grid_to_coord(sp, grid)
back  <- coord_to_index(sp, world)

cat("index:", idx, "-> grid:", grid, "-> world:", round(world, 2),
    "-> index:", back, "\n")

## ----axcodes------------------------------------------------------------------
affine_to_axcodes(trans(sp))

## ----axes-slot----------------------------------------------------------------
axes(sp)

## ----reorient-----------------------------------------------------------------
sp_ras <- reorient(sp, c("R", "A", "S"))
affine_to_axcodes(trans(sp_ras))

## ----create-simple------------------------------------------------------------
# 2 mm isotropic, MNI-ish origin
sp_mni <- NeuroSpace(
  dim     = c(91L, 109L, 91L),
  spacing = c(2, 2, 2),
  origin  = c(-90, -126, -72)
)
sp_mni

## ----create-from-affine-------------------------------------------------------
# Oblique affine: slight off-diagonal terms (scanner tilt)
aff_obl <- matrix(c(
   2.0,  0.2,  0.0,  -90,
   0.0,  2.0,  0.1, -126,
   0.0,  0.0,  2.0,  -72,
   0.0,  0.0,  0.0,    1
), nrow = 4, byrow = TRUE)

sp_obl <- NeuroSpace(dim = c(91L, 109L, 91L), trans = aff_obl)

# spacing() returns column norms — the true physical voxel sizes
spacing(sp_obl)

# diagonal is not exactly 2 mm when the image is tilted
diag(aff_obl[1:3, 1:3])

## ----voxel-sizes--------------------------------------------------------------
voxel_sizes(aff_obl)

## ----add-dim------------------------------------------------------------------
sp_3d <- NeuroSpace(c(64L, 64L, 40L), spacing = c(2, 2, 2),
                    origin = c(-90, -126, -72))
sp_4d <- add_dim(sp_3d, 200)   # 200 time points
dim(sp_4d)
trans(sp_4d)                   # 4x4 spatial affine unchanged

## ----drop-dim-----------------------------------------------------------------
sp_back <- drop_dim(sp_4d)
dim(sp_back)
all.equal(trans(sp_back), trans(sp_3d))   # affine preserved

## ----resample-space-----------------------------------------------------------
vol_mni <- NeuroVol(array(rnorm(prod(dim(sp_mni))), dim(sp_mni)), sp_mni)
sp_coarse <- NeuroSpace(c(45L, 54L, 45L), spacing = c(4, 4, 4),
                        origin = origin(sp_mni))
vol_coarse <- resample(vol_mni, sp_coarse)
dim(vol_coarse)
spacing(space(vol_coarse))

## ----deoblique----------------------------------------------------------------
sp_deob <- deoblique(sp_obl)
affine_to_axcodes(trans(sp_deob))   # now axis-aligned
obliquity(trans(sp_deob))           # near zero

## ----gotcha-obliquity---------------------------------------------------------
obliquity(aff_obl)        # non-zero: image is slightly tilted
obliquity(trans(sp_mni))  # near zero: axis-aligned