tests/testthat/test-rayshader.R

In ggseg3d: Interactive 3D Brain Atlas Visualization

options(rgl.useNULL = TRUE)

test_that("camera_preset_to_position returns correct vectors", {
  expect_equal(camera_preset_to_position("left lateral"), c(-350, 0, 0))
  expect_equal(camera_preset_to_position("right lateral"), c(350, 0, 0))
  expect_equal(camera_preset_to_position("left medial"), c(350, 0, 0))
  expect_equal(camera_preset_to_position("right medial"), c(-350, 0, 0))
  expect_equal(camera_preset_to_position("left superior"), c(-120, 0, 330))
  expect_equal(camera_preset_to_position("right inferior"), c(120, 0, -330))
  expect_equal(camera_preset_to_position("left anterior"), c(-120, 330, 0))
  expect_equal(camera_preset_to_position("right posterior"), c(120, -330, 0))
})

test_that("camera_preset_to_position accepts underscore variants", {
  expect_equal(
    camera_preset_to_position("left_lateral"),
    camera_preset_to_position("left lateral")
  )
  expect_equal(
    camera_preset_to_position("right_superior"),
    camera_preset_to_position("right superior")
  )
})

test_that("camera_preset_to_position errors on unknown preset", {
  expect_error(
    camera_preset_to_position("top down"),
    "Unknown camera preset"
  )
})

test_that("look_at_origin produces orthonormal rotation matrix", {
  m <- look_at_origin(c(-350, 0, 0))
  expect_equal(dim(m), c(4, 4))
  expect_equal(m[4, ], c(0, 0, 0, 1))
  expect_equal(m[1:3, 4], c(0, 0, 0))

  rows <- m[1:3, 1:3]
  expect_equal(rows %*% t(rows), diag(3), tolerance = 1e-10)
})

test_that("look_at_origin handles vertical eye positions", {
  m <- look_at_origin(c(0, 0, 330))
  expect_equal(dim(m), c(4, 4))

  rows <- m[1:3, 1:3]
  expect_equal(rows %*% t(rows), diag(3), tolerance = 1e-10)
})

test_that("mesh_entry_to_mesh3d converts vertex-colored mesh", {
  skip_if_not_installed("rgl")

  entry <- make_mesh_entry(
    name = "test",
    vertices = data.frame(
      x = c(0, 1, 0, 1),
      y = c(0, 0, 1, 1),
      z = c(0, 0, 0, 1)
    ),
    faces = data.frame(i = c(1L, 2L), j = c(2L, 3L), k = c(3L, 4L)),
    colors = c("#FF0000", "#00FF00", "#0000FF", "#FFFFFF"),
    color_mode = "vertexcolor",
    opacity = 0.8
  )

  mesh3d <- mesh_entry_to_mesh3d(entry)

  expect_s3_class(mesh3d, "mesh3d")
  expect_equal(ncol(mesh3d$vb), 4)
  expect_equal(ncol(mesh3d$it), 2)
  expect_equal(mesh3d$material$alpha, 0.8)
  expect_equal(length(mesh3d$material$color), 4)
  expect_equal(mesh3d$meshColor, "vertices")
})

test_that("mesh_entry_to_mesh3d handles 0-indexed faces from make_mesh_entry", {
  skip_if_not_installed("rgl")

  entry <- make_mesh_entry(
    name = "test",
    vertices = data.frame(
      x = c(0, 1, 0),
      y = c(0, 0, 1),
      z = c(0, 0, 0)
    ),
    faces = data.frame(i = 1L, j = 2L, k = 3L),
    colors = c("#FF0000", "#00FF00", "#0000FF"),
    color_mode = "vertexcolor"
  )

  expect_equal(entry$faces$i, 0L)
  expect_equal(entry$faces$j, 1L)
  expect_equal(entry$faces$k, 2L)

  mesh3d <- mesh_entry_to_mesh3d(entry)
  expect_equal(mesh3d$it[1, 1], 1L)
  expect_equal(mesh3d$it[2, 1], 2L)
  expect_equal(mesh3d$it[3, 1], 3L)
})

test_that("mesh_entry_to_mesh3d converts face-colored mesh", {
  skip_if_not_installed("rgl")

  entry <- make_mesh_entry(
    name = "test",
    vertices = data.frame(
      x = c(0, 1, 0, 1),
      y = c(0, 0, 1, 1),
      z = c(0, 0, 0, 1)
    ),
    faces = data.frame(i = c(1L, 2L), j = c(2L, 3L), k = c(3L, 4L)),
    colors = c("#FF0000", "#00FF00"),
    color_mode = "facecolor"
  )

  mesh3d <- mesh_entry_to_mesh3d(entry)
  expect_equal(mesh3d$meshColor, "faces")
  expect_equal(length(mesh3d$material$color), 2)
})

test_that("prepare_brain_meshes returns meshes and legend_data", {
  prepared <- prepare_brain_meshes(
    dk(), hemisphere = "left", surface = "inflated"
  )

  expect_type(prepared, "list")
  expect_true("meshes" %in% names(prepared))
  expect_true("legend_data" %in% names(prepared))
  expect_true(length(prepared$meshes) > 0)
})

test_that("ggsegray errors on invalid atlas", {
  skip_if_not_installed("rgl")

  expect_error(
    ggsegray(atlas = list()),
    "ggseg_atlas"
  )
})

test_that("ggsegray errors when rgl not installed", {
  local_mocked_bindings(
    check_installed = function(pkg, ...) {
      if ("rgl" %in% pkg) {
        stop("rgl is required")
      }
    },
    .package = "rlang"
  )

  expect_error(ggsegray(hemisphere = "left"), "rgl")
})

test_that("ggsegray creates rgl scene", {
  skip_if_not_installed("rgl")

  p <- ggsegray(hemisphere = "left", atlas = dk())

  expect_s3_class(p, "ggsegray")
  expect_true(is.integer(p$device))
  rgl::close3d()
})

test_that("ggsegray works with aseg atlas", {
  skip_if_not_installed("rgl")

  p <- ggsegray(atlas = aseg())

  expect_s3_class(p, "ggsegray")
  rgl::close3d()
})

test_that("pan_camera works with ggsegray", {
  skip_if_not_installed("rgl")

  p <- ggsegray(hemisphere = "left", atlas = dk()) |>
    pan_camera("left lateral")

  expect_s3_class(p, "ggsegray")
  rgl::close3d()
})

test_that("pan_camera with numeric vector works for ggsegray", {
  skip_if_not_installed("rgl")

  p <- ggsegray(hemisphere = "left", atlas = dk()) |>
    pan_camera(c(-400, 0, 0))

  expect_s3_class(p, "ggsegray")
  rgl::close3d()
})

test_that("set_background works with ggsegray", {
  skip_if_not_installed("rgl")

  p <- ggsegray(hemisphere = "left", atlas = dk()) |>
    set_background("black")

  expect_s3_class(p, "ggsegray")
  rgl::close3d()
})

test_that("add_glassbrain works with ggsegray", {
  skip_if_not_installed("rgl")

  p <- ggsegray(hemisphere = "left", atlas = dk()) |>
    add_glassbrain(hemisphere = "left")

  expect_s3_class(p, "ggsegray")
  rgl::close3d()
})

test_that("ggsegray piping chain works", {
  skip_if_not_installed("rgl")

  p <- ggsegray(atlas = aseg()) |>
    add_glassbrain(opacity = 0.15) |>
    pan_camera("right lateral") |>
    set_background("black")

  expect_s3_class(p, "ggsegray")
  rgl::close3d()
})

test_that("render_edges_rgl draws boundary edges", {
  skip_if_not_installed("rgl")

  entry <- make_mesh_entry(
    name = "test",
    vertices = data.frame(
      x = c(0, 1, 0, 1),
      y = c(0, 0, 1, 1),
      z = c(0, 0, 0, 0)
    ),
    faces = data.frame(i = c(1L, 2L), j = c(2L, 3L), k = c(3L, 4L)),
    colors = c("#FF0000", "#00FF00", "#0000FF", "#FF0000"),
    color_mode = "vertexcolor",
    boundary_edges = list(c(0L, 1L), c(1L, 2L)),
    edge_color = "#000000"
  )

  rgl::open3d()
  expect_silent(render_edges_rgl(entry))
  rgl::close3d()
})

test_that("render_edges_rgl skips when no edges", {
  entry <- make_mesh_entry(
    name = "test",
    vertices = data.frame(x = c(0, 1, 0), y = c(0, 0, 1), z = c(0, 0, 0)),
    faces = data.frame(i = 1L, j = 2L, k = 3L),
    colors = c("#FF0000", "#00FF00", "#0000FF"),
    color_mode = "vertexcolor"
  )

  expect_silent(render_edges_rgl(entry))
})

test_that("ggsegray renders edges when edge_by is set", {
  skip_if_not_installed("rgl")

  p <- ggsegray(
    atlas = dk(),
    hemisphere = "left",
    edge_by = "region"
  )

  expect_s3_class(p, "ggsegray")
  rgl::close3d()
})

test_that("check_ggsegray rejects non-ggsegray objects", {
  expect_error(check_ggsegray(list()), "ggsegray")
  expect_error(check_ggsegray("not a scene"), "ggsegray")
})

test_that("ggsegray errors on non-unified atlas", {
  skip_if_not_installed("rgl")

  fake_atlas <- structure(
    list(
      core = data.frame(label = "a", region = "r", hemi = "left"),
      data = structure(list(), class = "ggseg_atlas_data")
    ),
    class = "ggseg_atlas"
  )

  expect_error(ggsegray(atlas = fake_atlas), "no 3D data")
})

test_that("pan_camera rejects bad type for ggsegray", {
  skip_if_not_installed("rgl")

  p <- ggsegray(hemisphere = "left", atlas = dk())

  expect_error(
    pan_camera(p, list(x = 1)),
    "character string or numeric"
  )
  rgl::close3d()
})

test_that("set_legend works with ggsegray", {
  skip_if_not_installed("rgl")

  p <- ggsegray(hemisphere = "left", atlas = dk())
  result <- set_legend(p)
  expect_s3_class(result, "ggsegray")
  rgl::close3d()
})

test_that("set_edges works with ggsegray", {
  skip_if_not_installed("rgl")

  p <- ggsegray(
    atlas = dk(),
    hemisphere = "left",
    edge_by = "region"
  )

  p2 <- set_edges(p, "red", width = 2)
  expect_s3_class(p2, "ggsegray")

  p3 <- set_edges(p2, NULL)
  expect_s3_class(p3, "ggsegray")
  expect_equal(length(p3$edge_ids), 0)

  rgl::close3d()
})

test_that("ggsegray stores meshes and edge_ids", {
  skip_if_not_installed("rgl")

  p <- ggsegray(hemisphere = "left", atlas = dk())
  expect_true("meshes" %in% names(p))
  expect_true("edge_ids" %in% names(p))
  rgl::close3d()
})

test_that("print.ggsegray returns rglwidget", {
  skip_if_not_installed("rgl")

  p <- ggsegray(hemisphere = "left", atlas = dk())
  widget <- print(p)
  expect_s3_class(widget, "htmlwidget")
  rgl::close3d()
})


test_that("set_legend renders continuous legend for numeric data", {
  skip_if_not_installed("rgl")

  some_data <- dplyr::tibble(
    region = c("precentral", "postcentral"),
    p = c(0.1, 0.5)
  )

  p <- ggsegray(
    .data = some_data,
    atlas = dk(),
    colour_by = "p",
    hemisphere = "left"
  )
  expect_equal(p$legend_data$type, "continuous")
  result <- set_legend(p)
  expect_s3_class(result, "ggsegray")
  rgl::close3d()
})

test_that("ggsegray deprecated params trigger warnings", {
  skip_if_not_installed("rgl")

  lifecycle::expect_deprecated(
    p <- ggsegray(hemisphere = "left", atlas = dk(), colour = "colour")
  )
  rgl::close3d()

  lifecycle::expect_deprecated(
    p <- ggsegray(hemisphere = "left", atlas = dk(), label = "label")
  )
  rgl::close3d()

  some_data <- data.frame(
    region = c("precentral", "insula"),
    p = c(0.1, 0.5),
    stringsAsFactors = FALSE
  )
  lifecycle::expect_deprecated(
    p <- ggsegray(.data = some_data, atlas = dk(), text = "p")
  )
  rgl::close3d()
})