tests/testthat/test-ggseg3d.R

In ggseg3d: Interactive 3D Brain Atlas Visualization

test_that("Check that ggseg3d is working", {
  p <- ggseg3d()
  expect_s3_class(p, c("ggseg3d", "htmlwidget"))
  expect_true("meshes" %in% names(p$x))
  expect_true("options" %in% names(p$x))
  expect_true(length(p$x$meshes) > 0)
  rm(p)

  lifecycle::expect_deprecated(
    p <- ggseg3d(atlas = "aseg")
  )
  expect_s3_class(p, c("ggseg3d", "htmlwidget"))
  expect_true(length(p$x$meshes) > 0)

  expect_error(ggseg3d(atlas = hhj), "object 'hhj")

  expect_warning(
    ggseg3d(
      .data = data.frame(
        region = c(
          "transverse tempral",
          "insula",
          "precentral",
          "superior parietal"
        ),
        p = sample(seq(0, .5, .001), 4),
        stringsAsFactors = FALSE
      ),
      colour_by = "p"
    )
  )

  some_data <- data.frame(
    region = c(
      "transverse temporal",
      "insula",
      "precentral",
      "superior parietal"
    ),
    p = sample(seq(0, .5, .001), 4),
    stringsAsFactors = FALSE
  )

  p <- ggseg3d(
    .data = some_data,
    colour_by = "p",
    text_by = "p",
    palette = c("black", "white")
  )
  expect_s3_class(p, c("ggseg3d", "htmlwidget"))

  p <- ggseg3d(
    .data = some_data,
    colour_by = "p",
    text_by = "p",
    palette = c("black", "white")
  )
  expect_s3_class(p, c("ggseg3d", "htmlwidget"))
  expect_true(!is.null(p$x$colorbar))
  expect_true(p$x$options$showLegend)

  p_hidden <- p |> set_legend(FALSE)
  expect_false(p_hidden$x$options$showLegend)

  p_sized <- ggseg3d() |> set_dimensions(width = 800, height = 600)
  expect_equal(p_sized$width, 800)
  expect_equal(p_sized$height, 600)
})

test_that("ggseg3d works with aseg subcortical atlas", {
  p <- ggseg3d(atlas = aseg())
  expect_s3_class(p, c("ggseg3d", "htmlwidget"))
  expect_true(length(p$x$meshes) > 0)
})

test_that("ggseg3d with left hemisphere only", {
  p <- ggseg3d(hemisphere = "left")
  expect_s3_class(p, c("ggseg3d", "htmlwidget"))
  expect_true(length(p$x$meshes) > 0)
})

test_that("ggseg3d with inflated surface", {
  p <- ggseg3d(hemisphere = "left", surface = "inflated")
  expect_s3_class(p, c("ggseg3d", "htmlwidget"))
})

test_that("ggseg3d handles edge_by parameter", {
  some_data <- data.frame(
    region = c(
      "transverse temporal",
      "insula",
      "precentral",
      "superior parietal"
    ),
    lobe = c("temporal", "insular", "frontal", "parietal"),
    stringsAsFactors = FALSE
  )

  p <- ggseg3d(
    .data = some_data,
    hemisphere = "left",
    edge_by = "lobe"
  )
  expect_s3_class(p, c("ggseg3d", "htmlwidget"))
})

test_that("ggseg3d default colorbar is present", {
  p <- ggseg3d()
  expect_true(!is.null(p$x$colorbar) || p$x$colorbar$type == "discrete")
})

test_that("ggseg3d with custom palette", {
  some_data <- data.frame(
    region = c("transverse temporal", "insula"),
    p = c(0.1, 0.9),
    stringsAsFactors = FALSE
  )

  p <- ggseg3d(
    .data = some_data,
    hemisphere = "left",
    colour_by = "p",
    palette = c("blue" = 0, "white" = 0.5, "red" = 1)
  )
  expect_s3_class(p, c("ggseg3d", "htmlwidget"))
  expect_equal(p$x$colorbar$type, "continuous")
})

test_that("ggseg3d with na_colour and na_alpha", {
  p <- ggseg3d(hemisphere = "left", na_colour = "red", na_alpha = 0.5)
  expect_s3_class(p, c("ggseg3d", "htmlwidget"))
})

test_that("ggseg3d with label_by parameter", {
  p <- ggseg3d(hemisphere = "left", label_by = "label")
  expect_s3_class(p, c("ggseg3d", "htmlwidget"))
})

test_that("deprecated params trigger warnings", {
  some_data <- data.frame(
    region = c("precentral", "insula"),
    p = c(0.1, 0.5),
    stringsAsFactors = FALSE
  )

  lifecycle::expect_deprecated(
    ggseg3d(hemisphere = "left", colour = "colour")
  )
  lifecycle::expect_deprecated(
    ggseg3d(hemisphere = "left", label = "label")
  )
  lifecycle::expect_deprecated(
    ggseg3d(.data = some_data, text = "p")
  )
})

test_that("ggseg3d with both hemispheres", {
  p <- ggseg3d(hemisphere = c("left", "right"))
  expect_s3_class(p, c("ggseg3d", "htmlwidget"))
  expect_true(length(p$x$meshes) >= 2)
})

test_that("ggseg3d with atlas object instead of string", {
  p <- ggseg3d(atlas = dk(), hemisphere = "left")
  expect_s3_class(p, c("ggseg3d", "htmlwidget"))
})

test_that("ggseg3d unified atlas without user data", {
  p <- ggseg3d(atlas = dk(), hemisphere = "left", .data = NULL)
  expect_s3_class(p, c("ggseg3d", "htmlwidget"))
})

test_that("ggseg3d with aseg mesh atlas", {
  p <- ggseg3d(atlas = aseg(), hemisphere = "subcort")
  expect_s3_class(p, c("ggseg3d", "htmlwidget"))
  expect_true(length(p$x$meshes) > 0)
})

test_that("ggseg3d errors on invalid atlas object", {
  expect_error(ggseg3d(atlas = list()), "ggseg_atlas")
  expect_error(ggseg3d(atlas = data.frame()), "ggseg_atlas")
})

test_that("prepare_brain_meshes handles atlas with centerlines", {
  atlas_data <- data.frame(
    label = "tract_a",
    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
  )

  cl_data <- data.frame(label = "tract_a", stringsAsFactors = FALSE)
  cl_data$points <- list(centerline)
  cl_data$tangents <- list(tangents)

  atlas <- structure(
    list(
      atlas = "test_tract",
      type = "tract",
      core = data.frame(
        label = "tract_a",
        region = "tract a",
        hemi = "subcort",
        stringsAsFactors = FALSE
      ),
      data = structure(
        list(centerlines = cl_data),
        class = c("ggseg_data_tract", "ggseg_atlas_data")
      ),
      palette = c("tract_a" = "#FF0000")
    ),
    class = c("tract_atlas", "ggseg_atlas", "list")
  )

  prepared <- prepare_brain_meshes(atlas)

  expect_type(prepared, "list")
  expect_true(length(prepared$meshes) > 0)
})

test_that("prepare_brain_meshes handles atlas$data$meshes path", {
  meshes_data <- data.frame(
    label = "Left-Caudate",
    stringsAsFactors = FALSE
  )
  meshes_data$mesh <- list(
    list(
      vertices = data.frame(x = 1:3, y = 1:3, z = 1:3),
      faces = data.frame(i = 1L, j = 2L, k = 3L)
    )
  )

  atlas <- structure(
    list(
      atlas = "test_subcort",
      type = "subcortical",
      core = data.frame(
        label = "Left-Caudate",
        region = "caudate",
        hemi = "subcort",
        stringsAsFactors = FALSE
      ),
      data = structure(
        list(meshes = meshes_data),
        class = c("ggseg_data_subcortical", "ggseg_atlas_data")
      ),
      palette = c("Left-Caudate" = "#FF0000")
    ),
    class = c("subcortical_atlas", "ggseg_atlas", "list")
  )

  prepared <- prepare_brain_meshes(atlas)

  expect_type(prepared, "list")
  expect_true(length(prepared$meshes) > 0)
})

test_that("prepare_brain_meshes uses orientation coloring for tracts", {
  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
  )

  cl_data <- data.frame(label = "tract_a", stringsAsFactors = FALSE)
  cl_data$points <- list(centerline)
  cl_data$tangents <- list(tangents)

  meshes_data <- data.frame(
    label = "tract_a",
    stringsAsFactors = FALSE
  )
  meshes_data$mesh <- list(NULL)

  atlas <- structure(
    list(
      atlas = "test_tract",
      type = "tract",
      core = data.frame(
        label = "tract_a", region = "tract a", hemi = "subcort",
        stringsAsFactors = FALSE
      ),
      data = structure(
        list(
          meshes = meshes_data,
          centerlines = cl_data
        ),
        class = c("ggseg_data_tract", "ggseg_atlas_data")
      ),
      palette = c("tract_a" = "#FF0000")
    ),
    class = c("tract_atlas", "ggseg_atlas", "list")
  )

  prepared <- prepare_brain_meshes(atlas, tract_color = "orientation")

  expect_true(length(prepared$meshes) > 0)
  expect_true(all(grepl("^#", prepared$meshes[[1]]$colors)))
})

test_that("prepare_brain_meshes handles cerebellar atlas with vertices", {
  vertices_data <- data.frame(
    label = "left_I-IV",
    stringsAsFactors = FALSE
  )
  vertices_data$vertices <- list(0L:99L)

  atlas <- structure(
    list(
      atlas = "suit_lobules",
      type = "cerebellar",
      core = data.frame(
        label = "left_I-IV",
        region = "I-IV",
        hemi = "left",
        stringsAsFactors = FALSE
      ),
      data = structure(
        list(vertices = vertices_data),
        class = c("ggseg_data_cerebellar", "ggseg_atlas_data")
      ),
      palette = c("left_I-IV" = "#FF0000")
    ),
    class = c("cerebellar_atlas", "ggseg_atlas", "list")
  )

  prepared <- prepare_brain_meshes(atlas)

  expect_type(prepared, "list")
  expect_true(length(prepared$meshes) > 0)
  expect_equal(prepared$meshes[[1]]$colorMode, "vertexcolor")
  expect_equal(prepared$meshes[[1]]$name, "cerebellum")
  expect_equal(
    length(prepared$meshes[[1]]$vertices$x),
    nrow(ggseg.formats::get_cerebellar_mesh()$vertices)
  )
})

test_that("cerebellar atlas colors correct vertices", {
  vertices_data <- data.frame(
    label = c("left_I-IV", "right_V"),
    stringsAsFactors = FALSE
  )
  vertices_data$vertices <- list(0L:4L, 100L:104L)

  atlas <- structure(
    list(
      atlas = "test_cer",
      type = "cerebellar",
      core = data.frame(
        label = c("left_I-IV", "right_V"),
        region = c("I-IV", "V"),
        hemi = c("left", "right"),
        stringsAsFactors = FALSE
      ),
      data = structure(
        list(vertices = vertices_data),
        class = c("ggseg_data_cerebellar", "ggseg_atlas_data")
      ),
      palette = c(
        "left_I-IV" = "#FF0000",
        "right_V" = "#00FF00"
      )
    ),
    class = c("cerebellar_atlas", "ggseg_atlas", "list")
  )

  prepared <- prepare_brain_meshes(atlas)
  colors <- prepared$meshes[[1]]$colors

  expect_equal(colors[1:5], rep("#FF0000", 5))
  expect_equal(colors[101:105], rep("#00FF00", 5))
  expect_equal(colors[50], "darkgrey")
})

test_that("cerebellar atlas with deep nuclei renders mixed surface + meshes", {
  vertices_data <- data.frame(
    label = "left_I-IV",
    stringsAsFactors = FALSE
  )
  vertices_data$vertices <- list(0L:4L)

  deep_meshes <- data.frame(
    label = "Left-Dentate",
    stringsAsFactors = FALSE
  )
  deep_meshes$mesh <- list(
    list(
      vertices = data.frame(x = 1:4, y = 1:4, z = 1:4),
      faces = data.frame(i = 1L, j = 2L, k = 3L)
    )
  )

  atlas <- structure(
    list(
      atlas = "suit_deep",
      type = "cerebellar",
      core = data.frame(
        label = c("left_I-IV", "Left-Dentate"),
        region = c("I-IV", "Dentate"),
        hemi = c("left", "left"),
        stringsAsFactors = FALSE
      ),
      data = structure(
        list(vertices = vertices_data, meshes = deep_meshes),
        class = c("ggseg_data_cerebellar", "ggseg_atlas_data")
      ),
      palette = c(
        "left_I-IV" = "#FF0000",
        "Left-Dentate" = "#0000FF"
      )
    ),
    class = c("cerebellar_atlas", "ggseg_atlas", "list")
  )

  prepared <- prepare_brain_meshes(atlas)

  expect_true(length(prepared$meshes) >= 2)
  surface <- prepared$meshes[[1]]
  expect_equal(surface$name, "cerebellum")
  expect_equal(surface$colorMode, "vertexcolor")
  expect_equal(surface$opacity, 0.3)

  deep <- prepared$meshes[[2]]
  expect_equal(deep$name, "Dentate")
  expect_equal(deep$colorMode, "facecolor")
})

test_that("cerebellar surface_opacity can be overridden", {
  vertices_data <- data.frame(
    label = "left_I-IV",
    stringsAsFactors = FALSE
  )
  vertices_data$vertices <- list(0L:4L)

  deep_meshes <- data.frame(
    label = "Left-Dentate",
    stringsAsFactors = FALSE
  )
  deep_meshes$mesh <- list(
    list(
      vertices = data.frame(x = 1:4, y = 1:4, z = 1:4),
      faces = data.frame(i = 1L, j = 2L, k = 3L)
    )
  )

  atlas <- structure(
    list(
      atlas = "suit_deep",
      type = "cerebellar",
      core = data.frame(
        label = c("left_I-IV", "Left-Dentate"),
        region = c("I-IV", "Dentate"),
        hemi = c("left", "left"),
        stringsAsFactors = FALSE
      ),
      data = structure(
        list(vertices = vertices_data, meshes = deep_meshes),
        class = c("ggseg_data_cerebellar", "ggseg_atlas_data")
      ),
      palette = c(
        "left_I-IV" = "#FF0000",
        "Left-Dentate" = "#0000FF"
      )
    ),
    class = c("cerebellar_atlas", "ggseg_atlas", "list")
  )

  prepared <- prepare_brain_meshes(atlas, surface_opacity = 0.5)
  expect_equal(prepared$meshes[[1]]$opacity, 0.5)
})

test_that("merge_legend_data handles NULL inputs", {
  legend <- data.frame(label = "a", colour = "#FF0000")

  expect_null(merge_legend_data(NULL, NULL))
  expect_equal(merge_legend_data(NULL, legend), legend)
  expect_equal(merge_legend_data(legend, NULL), legend)

  combined <- merge_legend_data(legend, legend)
  expect_equal(nrow(combined), 1)
})

test_that("build_cerebellar_meshes errors when mesh unavailable", {
  local_mocked_bindings(
    get_cerebellar_mesh = function(...) NULL,
    .package = "ggseg.formats"
  )
  expect_error(
    build_cerebellar_meshes(data.frame(), "darkgrey"),
    "SUIT cerebellar mesh"
  )
})

test_that("check_ggseg_meshes errors when package missing", {
  local_mocked_bindings(
    requireNamespace = function(...) FALSE,
    .package = "base"
  )
  expect_error(check_ggseg_meshes("pial"), "ggseg.meshes")
})

test_that("cerebellar atlas with text_by populates vertex texts", {
  vertices_data <- data.frame(
    label = "left_I-IV",
    stringsAsFactors = FALSE
  )
  vertices_data$vertices <- list(0L:4L)

  atlas <- structure(
    list(
      atlas = "suit_text",
      type = "cerebellar",
      core = data.frame(
        label = "left_I-IV",
        region = "I-IV",
        hemi = "left",
        score = 0.75,
        stringsAsFactors = FALSE
      ),
      data = structure(
        list(vertices = vertices_data),
        class = c("ggseg_data_cerebellar", "ggseg_atlas_data")
      ),
      palette = c("left_I-IV" = "#FF0000")
    ),
    class = c("cerebellar_atlas", "ggseg_atlas", "list")
  )

  prepared <- prepare_brain_meshes(atlas, text_by = "score")
  texts <- prepared$meshes[[1]]$vertexTexts
  expect_true(!is.null(texts))
  expect_match(texts[1], "score")
})

test_that("prepare_brain_meshes.default errors on unknown atlas class", {
  fake <- structure(list(), class = "weird_atlas")
  expect_error(prepare_brain_meshes(fake), "No method")
})

test_that("ggseg3d errors on nonexistent string atlas name", {
  expect_error(
    lifecycle::expect_deprecated(
      ggseg3d(atlas = "nonexistent_atlas_xyz")
    ),
    "Could not find atlas"
  )
})

test_that("vertices_to_text returns NA vector when column is missing", {
  atlas_data <- data.frame(
    label = "a",
    region = "r",
    stringsAsFactors = FALSE
  )
  atlas_data$vertices <- list(c(0L, 1L))

  result <- vertices_to_text(atlas_data, 3, "nonexistent")

  expect_equal(length(result), 3)
  expect_true(all(is.na(result)))
})

test_that("text_by works with subcortical atlas", {
  some_data <- data.frame(
    region = c("Thalamus", "Caudate"),
    p = c(0.1, 0.5),
    stringsAsFactors = FALSE
  )

  p <- ggseg3d(.data = some_data, atlas = aseg(), text_by = "p")
  expect_s3_class(p, c("ggseg3d", "htmlwidget"))

  hover_texts <- vapply(
    p$x$meshes,
    function(m) m$hoverText %||% "",
    character(1)
  )
  expect_true(any(grepl("p:", hover_texts)))
})

test_that("text_by works with tract atlas", {
  some_data <- data.frame(
    region = c("arcuate fasciculus", "corticospinal tract"),
    fa = c(0.45, 0.55),
    stringsAsFactors = FALSE
  )

  p <- ggseg3d(.data = some_data, atlas = tracula(), text_by = "fa")
  expect_s3_class(p, c("ggseg3d", "htmlwidget"))

  hover_texts <- vapply(
    p$x$meshes,
    function(m) m$hoverText %||% "",
    character(1)
  )
  expect_true(any(grepl("fa:", hover_texts)))
})