tests/testthat/test-nulls-spin.R

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

describe("random_rotation_matrix", {
  it("returns a 3x3 orthogonal matrix", {
    rot <- random_rotation_matrix()
    expect_equal(dim(rot), c(3, 3))
    expect_equal(rot %*% t(rot), diag(3), tolerance = 1e-10)
  })

  it("has determinant of 1", {
    rot <- random_rotation_matrix()
    expect_equal(det(rot), 1, tolerance = 1e-10)
  })
})

describe("rotate_coords", {
  it("returns arrays of correct dimensions", {
    lh <- matrix(rnorm(15), ncol = 3)
    rh <- matrix(rnorm(12), ncol = 3)
    result <- rotate_coords(lh, rh, n_perm = 3, seed = 42)

    expect_equal(dim(result$lh), c(5, 3, 3))
    expect_equal(dim(result$rh), c(4, 3, 3))
  })

  it("is reproducible with seed", {
    lh <- matrix(rnorm(15), ncol = 3)
    rh <- matrix(rnorm(12), ncol = 3)
    r1 <- rotate_coords(lh, rh, n_perm = 3, seed = 42)
    r2 <- rotate_coords(lh, rh, n_perm = 3, seed = 42)
    expect_identical(r1$lh, r2$lh)
    expect_identical(r1$rh, r2$rh)
  })
})

describe("compute_cost_matrix", {
  it("computes squared distances between original and rotated", {
    original <- matrix(c(1, 0, 0, 0, 1, 0), nrow = 2, ncol = 3, byrow = TRUE)
    rotated <- original
    cost <- compute_cost_matrix(original, rotated)
    expect_equal(diag(cost), c(0, 0))
    expect_true(cost[1, 2] > 0)
  })
})

describe("assign_parcels_vasa", {
  it("returns a valid permutation", {
    cost <- matrix(c(1, 10, 10, 1), nrow = 2)
    assignment <- assign_parcels_vasa(cost)
    expect_length(assignment, 2)
    expect_equal(sort(assignment), 1:2)
  })

  it("assigns to nearest available", {
    cost <- matrix(c(1, 2, 3, 4), nrow = 2)
    assignment <- assign_parcels_vasa(cost)
    expect_equal(assignment[1], 1)
    expect_equal(assignment[2], 2)
  })
})

describe("assign_parcels_hungarian", {
  it("returns optimal assignment", {
    skip_if_not_installed("clue")
    cost <- matrix(c(1, 10, 10, 1), nrow = 2)
    assignment <- assign_parcels_hungarian(cost)
    expect_equal(assignment, c(1L, 2L))
  })
})

describe("null_spin_vasa", {
  it("generates null distribution of correct dimensions", {
    set.seed(42)
    n_lh <- 5
    n_rh <- 5
    coords <- list(
      lh = matrix(rnorm(n_lh * 3), ncol = 3),
      rh = matrix(rnorm(n_rh * 3), ncol = 3)
    )
    data <- rnorm(n_lh + n_rh)
    result <- null_spin_vasa(data, coords, n_perm = 3L, seed = 1)

    expect_s3_class(result, "null_distribution")
    expect_equal(result$n, 10)
    expect_equal(result$n_perm, 3)
    expect_equal(result$method, "spin_vasa")
  })

  it("errors when data length mismatches coords", {
    coords <- list(
      lh = matrix(rnorm(9), ncol = 3),
      rh = matrix(rnorm(9), ncol = 3)
    )
    expect_error(null_spin_vasa(1:5, coords), "total parcels")
  })

  it("null values are permutations of original data", {
    set.seed(42)
    coords <- list(
      lh = matrix(rnorm(15), ncol = 3),
      rh = matrix(rnorm(15), ncol = 3)
    )
    data <- c(1:10) * 1.0
    result <- null_spin_vasa(data, coords, n_perm = 5L, seed = 1)

    for (i in seq_len(5)) {
      lh_vals <- sort(result$nulls[1:5, i])
      rh_vals <- sort(result$nulls[6:10, i])
      expect_equal(lh_vals, sort(data[1:5]))
      expect_equal(rh_vals, sort(data[6:10]))
    }
  })
})

describe("null_spin_hungarian", {
  it("generates null distribution", {
    skip_if_not_installed("clue")
    set.seed(42)
    n_lh <- 5
    n_rh <- 5
    coords <- list(
      lh = matrix(rnorm(n_lh * 3), ncol = 3),
      rh = matrix(rnorm(n_rh * 3), ncol = 3)
    )
    data <- rnorm(n_lh + n_rh)
    result <- null_spin_hungarian(data, coords, n_perm = 3L, seed = 1)

    expect_s3_class(result, "null_distribution")
    expect_equal(result$method, "spin_hungarian")
    expect_equal(result$n_perm, 3)
  })

  it("is reproducible with seed", {
    skip_if_not_installed("clue")
    set.seed(42)
    coords <- list(
      lh = matrix(rnorm(15), ncol = 3),
      rh = matrix(rnorm(15), ncol = 3)
    )
    data <- rnorm(10)
    r1 <- null_spin_hungarian(data, coords, n_perm = 3L, seed = 1)
    r2 <- null_spin_hungarian(data, coords, n_perm = 3L, seed = 1)
    expect_identical(r1$nulls, r2$nulls)
  })
})