tests/testthat/test-morph-tiling-extended.R

In couplr: Optimal Pairing and Matching via Linear Assignment

# ==============================================================================
# Extended tests for morph_tiling.R
# ==============================================================================

# ------------------------------------------------------------------------------
# .generate_square_tiles tests
# ------------------------------------------------------------------------------

test_that(".generate_square_tiles handles basic case", {
  tiles <- couplr:::.generate_square_tiles(6, 6, P = 3)

  # Should have 4 tiles (2x2 grid of 3x3 tiles)
  expect_equal(length(tiles), 4)

  # All tiles should be 3x3
  for (tile in tiles) {
    expect_equal(tile$size, 3)
  }
})

test_that(".generate_square_tiles handles P larger than image", {
  # P > min(W, H) should result in 1x1 tiles
  tiles <- couplr:::.generate_square_tiles(3, 3, P = 5)

  # Should have 9 tiles (3x3 pixels, each as a separate tile)
  expect_equal(length(tiles), 9)

  # All tiles should be 1x1
  for (tile in tiles) {
    expect_equal(tile$size, 1)
  }
})

test_that(".generate_square_tiles handles non-square image", {
  tiles <- couplr:::.generate_square_tiles(8, 6, P = 3)

  # All tiles should be <= 3
  for (tile in tiles) {
    expect_lte(tile$size, 3)
  }

  # Total pixels covered should equal image size
  total_pixels <- sum(sapply(tiles, function(t) t$size^2))
  expect_equal(total_pixels, 8 * 6)
})

test_that(".generate_square_tiles handles remainder strips", {
  # 7x7 with P=3: 2x2 core of 3x3 tiles + remainder strips
  tiles <- couplr:::.generate_square_tiles(7, 7, P = 3)

  # Check total coverage
  total_pixels <- sum(sapply(tiles, function(t) t$size^2))
  expect_equal(total_pixels, 7 * 7)
})

# ------------------------------------------------------------------------------
# .solve_tile_lap tests
# ------------------------------------------------------------------------------

test_that(".solve_tile_lap solves basic tile", {
  # Create simple 4x4 planar images
  A_planar <- matrix(runif(16 * 3, 0, 255), nrow = 16, ncol = 3)
  B_planar <- matrix(runif(16 * 3, 0, 255), nrow = 16, ncol = 3)

  tile <- list(x0 = 0, y0 = 0, size = 2)
  result <- couplr:::.solve_tile_lap(tile, A_planar, B_planar, H = 4, W = 4,
                                     method = "jv")

  # Returns vector of B indices
  expect_true(is.vector(result))
  expect_length(result, 4)  # 2x2 tile = 4 pixels
})

# ------------------------------------------------------------------------------
# .square_tiling_solver tests
# ------------------------------------------------------------------------------

test_that(".square_tiling_solver runs without error", {
  # Create simple 6x6 planar images
  A_planar <- matrix(runif(36 * 3, 0, 255), nrow = 36, ncol = 3)
  B_planar <- matrix(runif(36 * 3, 0, 255), nrow = 36, ncol = 3)

  result <- couplr:::.square_tiling_solver(A_planar, B_planar, H = 6, W = 6,
                                           max_tile_size = 3, method = "jv")

  # Should return assignment of length 36
  expect_length(result, 36)
})

# ------------------------------------------------------------------------------
# .analyze_tiling tests
# ------------------------------------------------------------------------------

test_that(".analyze_tiling returns expected structure", {
  result <- couplr:::.analyze_tiling(10, 8, P = 3)

  expect_type(result, "list")
  expect_true("tiles" %in% names(result))
  expect_true("n_tiles" %in% names(result))
})

test_that(".analyze_tiling handles edge case dimensions", {
  # Very small image
  result <- couplr:::.analyze_tiling(2, 2, P = 3)
  expect_true(result$n_tiles > 0)

  # P = 1 (should create one tile per pixel)
  result <- couplr:::.analyze_tiling(5, 5, P = 1)
  expect_equal(result$n_tiles, 25)
})

# ------------------------------------------------------------------------------
# .visualize_tiling tests
# ------------------------------------------------------------------------------

test_that(".visualize_tiling returns matrix", {
  skip_if_not_installed("graphics")

  result <- couplr:::.visualize_tiling(6, 6, P = 3)

  expect_true(is.matrix(result))
  expect_equal(dim(result), c(6, 6))
})

# ------------------------------------------------------------------------------
# Morph utils tests
# ------------------------------------------------------------------------------

test_that(".assemble_assignment handles basic case", {
  i_idx <- c(1, 2, 3)
  j_idx <- c(2, 3, 1)

  assign <- couplr:::.assemble_assignment(N = 3, i_idx, j_idx)

  expect_equal(assign[1], 2)
  expect_equal(assign[2], 3)
  expect_equal(assign[3], 1)
})

test_that(".assemble_assignment handles partial assignment", {
  i_idx <- c(1, 3)
  j_idx <- c(2, 4)

  assign <- couplr:::.assemble_assignment(N = 5, i_idx, j_idx)

  expect_equal(assign[1], 2)
  expect_equal(assign[3], 4)
})

test_that(".lap_assign solves assignment problem", {
  cost <- matrix(c(1, 5, 5, 1), 2, 2)
  result <- couplr:::.lap_assign(cost, method = "jv")

  expect_length(result, 2)
  # Should find optimal: 1->1, 2->2 or 1->2, 2->1
  expect_true(all(result %in% 0:1))  # 0-based
})

test_that(".clamp_rgb clamps values", {
  result <- couplr:::.clamp_rgb(c(-10, 100, 300))
  expect_equal(result, c(0, 100, 255))
})

test_that(".gif_delay_from_fps calculates correctly", {
  # 10 fps = 100ms delay = 10 centiseconds
  expect_equal(couplr:::.gif_delay_from_fps(10), 10)

  # 20 fps = 50ms delay = 5 centiseconds
  expect_equal(couplr:::.gif_delay_from_fps(20), 5)
})