tests/testthat/test-brain-mesh.R

In ggseg3d: Interactive 3D Brain Atlas Visualization

test_that("resolve_brain_mesh returns mesh for inflated surface", {
  mesh <- resolve_brain_mesh(hemisphere = "lh", surface = "inflated")

  expect_true(!is.null(mesh))
  expect_true("vertices" %in% names(mesh))
  expect_true("faces" %in% names(mesh))
  expect_true(nrow(mesh$vertices) > 0)
  expect_true(nrow(mesh$faces) > 0)
  expect_equal(ncol(mesh$vertices), 3)
  expect_equal(ncol(mesh$faces), 3)
})

test_that("resolve_brain_mesh returns both hemispheres", {
  lh <- resolve_brain_mesh(hemisphere = "lh", surface = "inflated")
  rh <- resolve_brain_mesh(hemisphere = "rh", surface = "inflated")

  expect_true(!is.null(lh))
  expect_true(!is.null(rh))
  expect_equal(nrow(lh$vertices), nrow(rh$vertices))
})

test_that("resolve_brain_mesh validates arguments", {
  expect_error(resolve_brain_mesh(hemisphere = "invalid"))
  expect_error(resolve_brain_mesh(surface = "invalid"))
})

test_that("is_unified_atlas identifies unified atlases correctly", {
  expect_true(is_unified_atlas(dk()))
  expect_true(is_unified_atlas(aseg()))

  expect_false(is_unified_atlas(list()))
  expect_false(is_unified_atlas(data.frame()))
  expect_false(is_unified_atlas(NULL))
  expect_false(is_unified_atlas("dk"))
})

test_that("class-based atlas checks work correctly", {
  expect_true(is_cortical_atlas(dk()))
  expect_false(is_subcortical_atlas(dk()))
  expect_false(is_tract_atlas(dk()))

  expect_true(is_subcortical_atlas(aseg()))
  expect_false(is_cortical_atlas(aseg()))
  expect_false(is_tract_atlas(aseg()))
})


test_that("vertices_to_colors creates correct color vector", {
  atlas_data <- data.frame(
    region = c("a", "b"),
    colour = c("#FF0000", "#00FF00"),
    stringsAsFactors = FALSE
  )
  atlas_data$vertices <- list(c(0, 1, 2), c(3, 4))

  colors <- vertices_to_colors(
    atlas_data,
    n_vertices = 6,
    na_colour = "#CCCCCC"
  )

  expect_length(colors, 6)
  expect_equal(colors[1:3], rep("#FF0000", 3))
  expect_equal(colors[4:5], rep("#00FF00", 2))
  expect_equal(colors[6], "#CCCCCC")
})

test_that("vertices_to_colors handles NA colours", {
  atlas_data <- data.frame(
    region = c("a", "b"),
    colour = c("#FF0000", NA),
    stringsAsFactors = FALSE
  )
  atlas_data$vertices <- list(c(0, 1), c(2, 3))

  colors <- vertices_to_colors(
    atlas_data,
    n_vertices = 5,
    na_colour = "#AAAAAA"
  )

  expect_equal(colors[1:2], rep("#FF0000", 2))
  expect_equal(colors[3:4], rep("#AAAAAA", 2))
  expect_equal(colors[5], "#AAAAAA")
})

test_that("vertices_to_groups creates correct group vector", {
  atlas_data <- data.frame(
    region = c("precentral", "postcentral"),
    lobe = c("frontal", "parietal"),
    stringsAsFactors = FALSE
  )
  atlas_data$vertices <- list(c(0, 1, 2), c(3, 4))

  groups <- vertices_to_groups(atlas_data, n_vertices = 6, group_col = "lobe")

  expect_length(groups, 6)
  expect_equal(groups[1:3], rep("frontal", 3))
  expect_equal(groups[4:5], rep("parietal", 2))
  expect_true(is.na(groups[6]))
})

test_that("vertices_to_groups errors on missing column", {
  atlas_data <- data.frame(region = "a")
  atlas_data$vertices <- list(c(0, 1))

  expect_error(
    vertices_to_groups(atlas_data, n_vertices = 3, group_col = "missing"),
    "not found"
  )
})

test_that("resolve_brain_mesh returns inflated surfaces", {
  lh <- resolve_brain_mesh(hemisphere = "lh", surface = "inflated")
  rh <- resolve_brain_mesh(hemisphere = "rh", surface = "inflated")

  expect_true(!is.null(lh))
  expect_true(!is.null(rh))
})

test_that("resolve_brain_mesh returns white surface", {
  mesh <- resolve_brain_mesh(hemisphere = "lh", surface = "white")
  expect_true(!is.null(mesh))
  expect_true("vertices" %in% names(mesh))
  expect_true("faces" %in% names(mesh))
})

test_that("vertices_to_colors handles empty vertices", {
  atlas_data <- data.frame(
    region = c("a"),
    colour = c("#FF0000"),
    stringsAsFactors = FALSE
  )
  atlas_data$vertices <- list(integer(0))

  colors <- vertices_to_colors(
    atlas_data,
    n_vertices = 5,
    na_colour = "#CCCCCC"
  )

  expect_equal(colors, rep("#CCCCCC", 5))
})

test_that("vertices_to_colors handles out-of-bounds indices", {
  atlas_data <- data.frame(
    region = c("a"),
    colour = c("#FF0000"),
    stringsAsFactors = FALSE
  )
  atlas_data$vertices <- list(c(-1, 0, 100))

  colors <- vertices_to_colors(
    atlas_data,
    n_vertices = 5,
    na_colour = "#CCCCCC"
  )

  expect_equal(colors[1], "#FF0000")
  expect_equal(colors[5], "#CCCCCC")
})

test_that("vertices_to_groups handles NA group values", {
  atlas_data <- data.frame(
    region = c("a", "b"),
    lobe = c("frontal", NA),
    stringsAsFactors = FALSE
  )
  atlas_data$vertices <- list(c(0, 1), c(2, 3))

  groups <- vertices_to_groups(atlas_data, n_vertices = 5, group_col = "lobe")

  expect_equal(groups[1:2], rep("frontal", 2))
  expect_true(is.na(groups[3]))
  expect_true(is.na(groups[4]))
})

test_that("is_unified_atlas detects atlas with data component", {
  atlas <- structure(
    list(
      core = data.frame(label = "a", region = "r", hemi = "left"),
      data = structure(
        list(vertices = data.frame(label = "a")),
        class = "ggseg_atlas_data"
      )
    ),
    class = "ggseg_atlas"
  )
  atlas$data$vertices$vertices <- list(1:10)

  expect_true(is_unified_atlas(atlas))
})

test_that("is_unified_atlas returns FALSE for atlas without 3d data", {
  atlas <- structure(
    list(
      core = data.frame(label = "a", region = "r", hemi = "left"),
      data = structure(
        list(geometry = data.frame()),
        class = "ggseg_atlas_data"
      )
    ),
    class = "ggseg_atlas"
  )

  expect_false(is_unified_atlas(atlas))
})

test_that("is_subcortical_atlas detects subcortical atlases", {
  expect_true(is_subcortical_atlas(aseg()))
  expect_false(is_subcortical_atlas(dk()))
})

test_that("is_unified_atlas detects direct vertices", {
  atlas <- structure(
    list(
      core = data.frame(label = "a", region = "r", hemi = "left"),
      vertices = data.frame(label = "a")
    ),
    class = "ggseg_atlas"
  )
  atlas$vertices$vertices <- list(1:10)

  expect_true(is_unified_atlas(atlas))
})

test_that("is_unified_atlas detects direct meshes", {
  atlas <- structure(
    list(
      core = data.frame(label = "a", region = "r", hemi = "subcort"),
      meshes = data.frame(label = "a")
    ),
    class = "ggseg_atlas"
  )

  expect_true(is_unified_atlas(atlas))
})

test_that("cross_product computes correct cross products", {
  expect_equal(cross_product(c(1, 0, 0), c(0, 1, 0)), c(0, 0, 1))
  expect_equal(cross_product(c(0, 1, 0), c(0, 0, 1)), c(1, 0, 0))
  expect_equal(cross_product(c(1, 0, 0), c(1, 0, 0)), c(0, 0, 0))
})

test_that("rotate_vector rotates correctly", {
  rotated <- rotate_vector(c(1, 0, 0), c(0, 0, 1), pi / 2)
  expect_equal(rotated[1], 0, tolerance = 1e-10)
  expect_equal(rotated[2], 1, tolerance = 1e-10)
  expect_equal(rotated[3], 0, tolerance = 1e-10)

  no_rotation <- rotate_vector(c(1, 0, 0), c(0, 0, 1), 0)
  expect_equal(no_rotation, c(1, 0, 0), tolerance = 1e-10)
})

test_that("generate_tube_mesh creates correct mesh structure", {
  centerline <- matrix(
    c(0, 0, 0, 1, 0, 0, 2, 0, 0, 3, 0, 0),
    nrow = 4,
    byrow = TRUE
  )

  result <- generate_tube_mesh(centerline, radius = 0.5, segments = 6)

  expect_true("vertices" %in% names(result))
  expect_true("faces" %in% names(result))
  expect_true("metadata" %in% names(result))
  expect_equal(nrow(result$vertices), 4 * 6)
  expect_equal(nrow(result$faces), (4 - 1) * 6 * 2)
  expect_equal(result$metadata$n_centerline_points, 4)
})

test_that("generate_tube_mesh accepts per-point radius", {
  centerline <- matrix(
    c(0, 0, 0, 1, 0, 0, 2, 0, 0),
    nrow = 3,
    byrow = TRUE
  )

  result <- generate_tube_mesh(
    centerline,
    radius = c(0.5, 1.0, 0.5),
    segments = 4
  )

  expect_equal(nrow(result$vertices), 3 * 4)
})

test_that("generate_tube_mesh errors on bad input", {
  expect_error(generate_tube_mesh(matrix(1:3, nrow = 1)), "at least 2 rows")
  expect_error(generate_tube_mesh(c(1, 2, 3)), "matrix")
})

test_that("compute_parallel_transp_fr returns correct structure", {
  curve <- matrix(
    c(0, 0, 0, 1, 0, 0, 2, 1, 0, 3, 1, 1),
    nrow = 4,
    byrow = TRUE
  )

  frames <- compute_parallel_transp_fr(curve)

  expect_true("tangents" %in% names(frames))
  expect_true("normals" %in% names(frames))
  expect_true("binormals" %in% names(frames))
  expect_equal(nrow(frames$tangents), 4)
  expect_equal(nrow(frames$normals), 4)
  expect_equal(nrow(frames$binormals), 4)

  for (i in 1:4) {
    expect_equal(sqrt(sum(frames$tangents[i, ]^2)), 1, tolerance = 1e-10)
    expect_equal(sqrt(sum(frames$normals[i, ]^2)), 1, tolerance = 1e-10)
    expect_equal(sqrt(sum(frames$binormals[i, ]^2)), 1, tolerance = 1e-10)
  }
})

test_that("build_tract_meshes with centerlines creates tube meshes", {
  atlas_data <- data.frame(
    label = c("tract_a"),
    colour = c("#FF0000"),
    stringsAsFactors = FALSE
  )

  centerline <- matrix(
    c(0, 0, 0, 1, 0, 0, 2, 0, 0),
    nrow = 3,
    byrow = TRUE
  )
  tangents <- matrix(
    c(1, 0, 0, 1, 0, 0, 1, 0, 0),
    nrow = 3,
    byrow = TRUE
  )

  atlas_centerlines <- list(
    centerlines = data.frame(label = "tract_a", stringsAsFactors = FALSE),
    tube_radius = 0.5,
    tube_segments = 4
  )
  atlas_centerlines$centerlines$points <- list(centerline)
  atlas_centerlines$centerlines$tangents <- list(tangents)

  meshes <- build_tract_meshes(
    atlas_data,
    "#CCCCCC",
    color_by = "colour",
    atlas_centerlines = atlas_centerlines
  )

  expect_length(meshes, 1)
  expect_equal(meshes[[1]]$name, "tract_a")
  expect_equal(meshes[[1]]$colorMode, "vertexcolor")
  expect_equal(length(meshes[[1]]$colors), 3 * 4)
})

test_that("build_tract_meshes warns with no data", {
  atlas_data <- data.frame(
    label = c("tract_a"),
    colour = c("#FF0000"),
    stringsAsFactors = FALSE
  )

  expect_warning(
    meshes <- build_tract_meshes(atlas_data, "#CCCCCC"),
    "No centerlines or meshes"
  )
  expect_length(meshes, 0)
})

test_that("build_tract_meshes with centerlines and orientation coloring", {
  atlas_data <- data.frame(
    label = c("tract_a"),
    colour = c("#FF0000"),
    stringsAsFactors = FALSE
  )

  centerline <- matrix(
    c(0, 0, 0, 1, 0, 0, 2, 0, 0),
    nrow = 3,
    byrow = TRUE
  )
  tangents <- matrix(
    c(1, 0, 0, 0, 1, 0, 0, 0, 1),
    nrow = 3,
    byrow = TRUE
  )

  atlas_centerlines <- list(
    centerlines = data.frame(label = "tract_a", stringsAsFactors = FALSE),
    tube_radius = 0.5,
    tube_segments = 4
  )
  atlas_centerlines$centerlines$points <- list(centerline)
  atlas_centerlines$centerlines$tangents <- list(tangents)

  meshes <- build_tract_meshes(
    atlas_data,
    "#CCCCCC",
    color_by = "orientation",
    atlas_centerlines = atlas_centerlines
  )

  expect_length(meshes, 1)
  expect_true(all(grepl("^#", meshes[[1]]$colors)))
})

test_that("resolve_brain_mesh returns NULL for empty brain_meshes", {
  result <- resolve_brain_mesh(
    hemisphere = "lh", surface = "pial", brain_meshes = list()
  )
  expect_null(result)
})

test_that("position_hemisphere shifts left hemisphere left", {
  verts <- data.frame(x = c(0, 10), y = c(0, 0), z = c(0, 0))
  result <- position_hemisphere(verts, "left")
  expect_true(mean(result$x) < mean(verts$x))
})

test_that("position_hemisphere shifts right hemisphere right", {
  verts <- data.frame(x = c(0, 10), y = c(0, 0), z = c(0, 0))
  result <- position_hemisphere(verts, "right")
  expect_true(mean(result$x) > mean(verts$x))
})

test_that("position_hemisphere passes through unknown hemisphere", {
  verts <- data.frame(x = c(0, 10), y = c(0, 0), z = c(0, 0))
  result <- position_hemisphere(verts, "subcort")
  expect_equal(result, verts)
})

test_that("to_native_coords handles NULL input", {
  expect_null(to_native_coords(NULL))
})

test_that("to_native_coords skips NULL meshes in list", {
  df <- data.frame(label = c("a", "b"), stringsAsFactors = FALSE)
  mesh_a <- list(
    vertices = data.frame(x = 1, y = 2, z = 3),
    faces = data.frame(i = 0, j = 0, k = 0)
  )
  df$mesh <- list(mesh_a, NULL)

  result <- to_native_coords(df)
  expect_null(result$mesh[[2]])
  expect_false(identical(result$mesh[[1]]$vertices$y, 2))
})

test_that("build_tract_meshes with mesh data (no centerlines)", {
  atlas_data <- data.frame(
    label = c("tract_a"),
    colour = c("#FF0000"),
    stringsAsFactors = FALSE
  )
  mesh <- list(
    vertices = data.frame(x = c(0, 1, 0), y = c(0, 0, 1), z = c(0, 0, 0)),
    faces = data.frame(i = 0, j = 1, k = 2)
  )
  atlas_data$mesh <- list(mesh)

  meshes <- build_tract_meshes(atlas_data, "#CCCCCC", color_by = "colour")

  expect_length(meshes, 1)
  expect_equal(meshes[[1]]$name, "tract_a")
  expect_equal(meshes[[1]]$colors, rep("#FF0000", 3))
})

test_that("build_tract_meshes skips NULL mesh entries", {
  atlas_data <- data.frame(
    label = c("tract_a", "tract_b"),
    colour = c("#FF0000", "#00FF00"),
    stringsAsFactors = FALSE
  )
  mesh <- list(
    vertices = data.frame(x = c(0, 1, 0), y = c(0, 0, 1), z = c(0, 0, 0)),
    faces = data.frame(i = 0, j = 1, k = 2)
  )
  atlas_data$mesh <- list(mesh, NULL)

  meshes <- build_tract_meshes(atlas_data, "#CCCCCC", color_by = "colour")

  expect_length(meshes, 1)
  expect_equal(meshes[[1]]$name, "tract_a")
})

test_that("build_cortical_meshes warns when brain mesh not found", {
  atlas_data <- data.frame(
    region = "precentral",
    hemi = "left",
    colour = "#FF0000",
    stringsAsFactors = FALSE
  )
  atlas_data$vertices <- list(c(0, 1, 2))

  expect_warning(
    build_cortical_meshes(
      atlas_data,
      hemisphere = "left",
      surface = "pial",
      na_colour = "#CCCCCC",
      edge_by = NULL,
      brain_meshes = list()
    ),
    "Brain mesh not found"
  )
})

test_that("build_tract_meshes skips labels not in centerlines", {
  atlas_data <- data.frame(
    label = c("tract_a", "tract_missing"),
    colour = c("#FF0000", "#00FF00"),
    stringsAsFactors = FALSE
  )

  centerline <- matrix(
    c(0, 0, 0, 1, 0, 0, 2, 0, 0),
    nrow = 3, byrow = TRUE
  )
  tangents <- matrix(
    c(1, 0, 0, 1, 0, 0, 1, 0, 0),
    nrow = 3, byrow = TRUE
  )

  atlas_centerlines <- list(
    centerlines = data.frame(label = "tract_a", stringsAsFactors = FALSE),
    tube_radius = 0.5,
    tube_segments = 4
  )
  atlas_centerlines$centerlines$points <- list(centerline)
  atlas_centerlines$centerlines$tangents <- list(tangents)

  meshes <- build_tract_meshes(
    atlas_data, "#CCCCCC",
    color_by = "colour",
    atlas_centerlines = atlas_centerlines
  )

  expect_length(meshes, 1)
  expect_equal(meshes[[1]]$name, "tract_a")
})

test_that("build_tract_meshes applies na_colour for NA colour", {
  atlas_data <- data.frame(
    label = c("tract_a"),
    colour = NA_character_,
    stringsAsFactors = FALSE
  )
  mesh <- list(
    vertices = data.frame(x = c(0, 1, 0), y = c(0, 0, 1), z = c(0, 0, 0)),
    faces = data.frame(i = 0, j = 1, k = 2)
  )
  atlas_data$mesh <- list(mesh)

  meshes <- build_tract_meshes(
    atlas_data, "#CCCCCC", color_by = "colour"
  )

  expect_equal(meshes[[1]]$colors, rep("#CCCCCC", 3))
})

test_that("build_centerline_data returns NULL when no centerlines", {
  atlas <- structure(
    list(
      data = structure(
        list(centerlines = NULL),
        class = c("ggseg_data_tract", "ggseg_atlas_data")
      )
    ),
    class = c("tract_atlas", "ggseg_atlas", "list")
  )

  expect_null(build_centerline_data(atlas))
})

test_that("build_centerline_data skips NULL points in centerlines", {
  cl_data <- data.frame(
    label = c("tract_a", "tract_b"),
    stringsAsFactors = FALSE
  )
  cl_data$points <- list(
    matrix(c(0, 0, 0, 1, 0, 0), nrow = 2, byrow = TRUE),
    NULL
  )

  atlas <- structure(
    list(
      data = structure(
        list(centerlines = cl_data),
        class = c("ggseg_data_tract", "ggseg_atlas_data")
      )
    ),
    class = c("tract_atlas", "ggseg_atlas", "list")
  )

  result <- build_centerline_data(atlas)

  expect_type(result, "list")
  expect_null(result$centerlines$points[[2]])
  expect_equal(nrow(result$centerlines$points[[1]]), 2)
})