inst/doc/null-models.R

In neuromapr: Spatial Null Models and Transforms for Brain Map Comparison

## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  fig.width = 7,
  fig.height = 4.5
)

## ----setup--------------------------------------------------------------------
library(neuromapr)

## ----shared-data--------------------------------------------------------------
set.seed(42)
n <- 80
coords_3d <- matrix(rnorm(n * 3), ncol = 3)
distmat <- as.matrix(dist(coords_3d))

map_x <- rnorm(n)

## ----burt2020-----------------------------------------------------------------
nulls_vario <- generate_nulls(
  map_x,
  method = "burt2020",
  distmat = distmat,
  n_perm = 100L,
  seed = 1
)
nulls_vario

## ----burt2018-----------------------------------------------------------------
nulls_sar <- generate_nulls(
  map_x,
  method = "burt2018",
  distmat = distmat,
  n_perm = 100L,
  seed = 1
)
nulls_sar

## ----sar-params---------------------------------------------------------------
nulls_sar$params$rho
nulls_sar$params$d0

## ----moran--------------------------------------------------------------------
nulls_moran <- generate_nulls(
  map_x,
  method = "moran",
  distmat = distmat,
  n_perm = 100L,
  seed = 1,
  procedure = "singleton"
)
nulls_moran

## ----spin-coords--------------------------------------------------------------
n_lh <- 40
n_rh <- 40
sphere_coords <- list(
  lh = matrix(rnorm(n_lh * 3), ncol = 3),
  rh = matrix(rnorm(n_rh * 3), ncol = 3)
)

vertex_data <- rnorm(n_lh + n_rh)

## ----alexander-bloch----------------------------------------------------------
nulls_ab <- null_alexander_bloch(
  vertex_data, sphere_coords,
  n_perm = 100L, seed = 1
)
nulls_ab

## ----spin-vasa----------------------------------------------------------------
nulls_vasa <- null_spin_vasa(
  vertex_data, sphere_coords,
  n_perm = 100L, seed = 1
)
nulls_vasa

## ----spin-hungarian, eval = rlang::is_installed("clue")-----------------------
nulls_hung <- null_spin_hungarian(
  vertex_data, sphere_coords,
  n_perm = 100L, seed = 1
)
nulls_hung

## ----parcel-setup-------------------------------------------------------------
n_parcel_lh <- 340
n_parcel_rh <- 340
parcel_coords <- list(
  lh = matrix(rnorm(n_parcel_lh * 3), ncol = 3),
  rh = matrix(rnorm(n_parcel_rh * 3), ncol = 3)
)
parcellation <- rep(1:68, each = 10)
parcel_data <- rnorm(68)

## ----baum---------------------------------------------------------------------
nulls_baum <- null_baum(
  parcel_data, parcel_coords, parcellation,
  n_perm = 50L, seed = 1
)
nulls_baum

## ----cornblath----------------------------------------------------------------
nulls_corn <- null_cornblath(
  parcel_data, parcel_coords, parcellation,
  n_perm = 50L, seed = 1
)
nulls_corn

## ----comparison-plot, fig.cap = "Surrogate distributions from variogram-matching (left) and Moran spectral randomization (right). The dashed red line is the original data distribution.", fig.width = 7, fig.height = 3.5----
df <- data.frame(
  value = c(
    as.vector(nulls_vario$nulls[, 1:50]),
    as.vector(nulls_moran$nulls[, 1:50])
  ),
  method = rep(
    c("burt2020 (variogram)", "moran (spectral)"),
    each = n * 50
  )
)

ggplot2::ggplot(df, ggplot2::aes(x = value)) +
  ggplot2::geom_density(fill = "steelblue", alpha = 0.5) +
  ggplot2::facet_wrap(~method) +
  ggplot2::geom_density(
    data = data.frame(value = map_x),
    color = "red", linetype = "dashed", linewidth = 0.8
  ) +
  ggplot2::labs(x = "Value", y = "Density") +
  ggplot2::theme_minimal()

## ----permtest-----------------------------------------------------------------
mae <- function(a, b) mean(abs(a - b))

result <- permtest_metric(
  map_x, rnorm(n),
  metric_func = mae,
  n_perm = 200L,
  seed = 1
)
result$observed
result$p_value

## ----permtest-spatial---------------------------------------------------------
result_spatial <- permtest_metric(
  map_x, rnorm(n),
  metric_func = mae,
  n_perm = 200L,
  seed = 1,
  null_method = "burt2020",
  distmat = distmat
)
result_spatial$p_value

## ----custom-nulls-------------------------------------------------------------
custom_nulls <- matrix(rnorm(n * 50), nrow = n, ncol = 50)
nd <- new_null_distribution(
  custom_nulls,
  method = "custom",
  observed = map_x
)
nd
summary(nd)