tests/testthat/test-centre.R

In stopmotion: Build Stop Motion Animations from Image Sequences

make_points <- function(frames, x1, y1, x2, y2) {
  data.frame(
    frame = rep(as.integer(frames), each = 2L),
    x = as.numeric(rbind(x1, x2)),
    y = as.numeric(rbind(y1, y2))
  )
}

test_that("centre() does not change frame count", {
  images <- make_film(n = 3L)
  pts <- make_points(
    frames = 1:3,
    x1 = c(2, 2, 2),
    y1 = c(2, 2, 2),
    x2 = c(8, 8, 8),
    y2 = c(8, 8, 8)
  )
  result <- suppressMessages(centre(
    images = images,
    points = pts,
    reference = 1L
  ))
  expect_equal(length(result), 3L)
})

test_that("centre() labels transformed frames as [centred]", {
  images <- make_film(n = 3L, labels = c("A", "B", "C"))
  pts <- make_points(
    frames = 1:3,
    x1 = c(2, 3, 2),
    y1 = c(2, 3, 2),
    x2 = c(8, 7, 8),
    y2 = c(8, 7, 8)
  )
  result <- suppressMessages(centre(
    images = images,
    points = pts,
    reference = 1L
  ))
  labels <- attr(result, "labels")
  expect_equal(labels[[1L]], "A")
  expect_equal(labels[[2L]], "B [centred]")
  expect_equal(labels[[3L]], "C [centred]")
})

test_that("centre() does not label or transform the reference frame", {
  images <- make_film(n = 3L, labels = c("A", "B", "C"))
  pts <- make_points(
    frames = 1:3,
    x1 = c(2, 3, 2),
    y1 = c(2, 3, 2),
    x2 = c(8, 7, 8),
    y2 = c(8, 7, 8)
  )
  result <- suppressMessages(centre(
    images = images,
    points = pts,
    reference = 2L
  ))
  labels <- attr(result, "labels")
  expect_equal(labels[[1L]], "A [centred]")
  expect_equal(labels[[2L]], "B")
  expect_equal(labels[[3L]], "C [centred]")
})

test_that("centre() frames = NULL processes all non-reference frames", {
  images <- make_film(n = 4L, labels = c("A", "B", "C", "D"))
  pts <- make_points(
    frames = 1:4,
    x1 = c(2, 3, 2, 3),
    y1 = c(2, 3, 2, 3),
    x2 = c(8, 7, 8, 7),
    y2 = c(8, 7, 8, 7)
  )
  result <- suppressMessages(centre(
    images = images,
    points = pts,
    reference = 1L
  ))
  labels <- attr(result, "labels")
  expect_equal(labels[1L], "A")
  expect_true(all(grepl("\\[centred\\]", labels[2:4])))
})

test_that("centre() with identical points leaves frame unchanged (identity warp)", {
  images <- make_film(n = 2L, labels = c("A", "B"))
  pts <- make_points(
    frames = 1:2,
    x1 = c(2, 2),
    y1 = c(2, 2),
    x2 = c(8, 8),
    y2 = c(8, 8)
  )
  result <- suppressMessages(centre(
    images = images,
    points = pts,
    reference = 1L
  ))
  expect_equal(length(result), 2L)
  expect_equal(attr(result, "labels")[[2L]], "B [centred]")
})

test_that("centre() errors when reference frame has wrong number of points", {
  images <- make_film(n = 2L)
  pts <- data.frame(frame = c(1L, 2L, 2L), x = c(2, 3, 8), y = c(2, 3, 8))
  expect_error(centre(images = images, points = pts, reference = 1L))
})

test_that("centre() errors when a non-reference frame has wrong number of points", {
  images <- make_film(n = 2L)
  pts <- data.frame(frame = c(1L, 1L, 2L), x = c(2, 8, 3), y = c(2, 8, 3))
  expect_error(centre(images = images, points = pts, reference = 1L))
})

test_that("centre() errors when points is missing required columns", {
  images <- make_film(n = 2L)
  pts <- data.frame(frame = c(1L, 1L), px = c(2, 8), py = c(2, 8))
  expect_error(centre(images = images, points = pts, reference = 1L))
})

test_that("centre() with explicit frames subset only transforms selected frames", {
  images <- make_film(n = 4L, labels = c("A", "B", "C", "D"))
  # Points provided for frames 1, 2, 4; frame 3 is intentionally excluded.
  pts <- data.frame(
    frame = c(1L, 1L, 2L, 2L, 4L, 4L),
    x = as.numeric(c(2, 2, 3, 3, 2, 2)),
    y = as.numeric(c(2, 8, 3, 7, 2, 8))
  )
  result <- suppressMessages(
    centre(
      images = images,
      points = pts,
      reference = 1L,
      frames = c(1L, 2L, 4L)
    )
  )
  labels <- attr(result, "labels")
  expect_equal(labels[[1L]], "A") # reference: unchanged
  expect_equal(labels[[2L]], "B [centred]") # transformed
  expect_equal(labels[[3L]], "C") # not in frames: untouched
  expect_equal(labels[[4L]], "D [centred]") # transformed
})

test_that("centre() messages the frame sequence", {
  images <- make_film(n = 2L)
  pts <- make_points(
    frames = 1:2,
    x1 = c(2, 3),
    y1 = c(2, 3),
    x2 = c(8, 7),
    y2 = c(8, 7)
  )
  withr::with_options(list(stopmotion.verbose = TRUE), {
    expect_message(
      centre(images = images, points = pts, reference = 1L),
      regexp = "Frame sequence after centre"
    )
  })
})