tests/testthat/test-assign.R

In couplr: Optimal Pairing and Matching via Linear Assignment

# Test suite for assignR modern API
# Functions are loaded from the package being tested

test_that("lap_solve() works with simple matrix input", {
  cost <- matrix(c(4, 2, 5,
                   3, 3, 6,
                   7, 5, 4), nrow = 3)
  
  result <- lap_solve(cost)
  
  expect_s3_class(result, "lap_solve_result")
  expect_s3_class(result, "tbl_df")
  expect_equal(nrow(result), 3)
  expect_equal(ncol(result), 3)
  expect_true(all(c("source", "target", "cost") %in% names(result)))
  expect_equal(attr(result, "total_cost"), 9)
})

test_that("lap_solve() handles rectangular matrices", {
  cost <- matrix(1:15, nrow = 3, ncol = 5)
  
  result <- lap_solve(cost)
  
  expect_s3_class(result, "lap_solve_result")
  expect_equal(nrow(result), 3)
  expect_true(all(result$source %in% 1:3))
  expect_true(all(result$target %in% 1:5))
})

test_that("lap_solve() respects NA masking", {
  cost <- matrix(c(4, 2, NA,
                   3, NA, 6,
                   NA, 5, 4), nrow = 3)
  
  result <- lap_solve(cost)
  
  expect_s3_class(result, "lap_solve_result")
  expect_true(all(!is.na(result$cost)))
})

test_that("lap_solve() works with maximize = TRUE", {
  profit <- matrix(c(5, 3, 7,
                     4, 6, 2,
                     8, 4, 5), nrow = 3)
  
  result <- lap_solve(profit, maximize = TRUE)
  
  expect_s3_class(result, "lap_solve_result")
  expect_gt(attr(result, "total_cost"), 10)
})

# Test lap_solve() with data frames ----

test_that("lap_solve() works with data frame input", {
  df <- tibble::tibble(
    source = rep(1:3, each = 3),
    target = rep(1:3, times = 3),
    cost = c(4, 2, 5, 3, 3, 6, 7, 5, 4)
  )
  
  result <- lap_solve(df, source, target, cost)
  
  expect_s3_class(result, "lap_solve_result")
  expect_equal(nrow(result), 3)
  expect_true(all(c("source", "target", "cost") %in% names(result)))
})

test_that("lap_solve() requires all columns for data frame input", {
  df <- tibble::tibble(
    source = 1:3,
    target = 1:3
  )
  
  expect_error(
    lap_solve(df, source, target, cost),
    "must specify"
  )
})

test_that("lap_solve() works with non-sequential indices", {
  df <- tibble::tibble(
    source = c(10, 10, 10, 20, 20, 20, 30, 30, 30),
    target = c(100, 200, 300, 100, 200, 300, 100, 200, 300),
    cost = c(4, 2, 5, 3, 3, 6, 7, 5, 4)
  )
  
  result <- lap_solve(df, source, target, cost)
  
  expect_equal(sort(unique(result$source)), c(10, 20, 30))
  expect_equal(sort(unique(result$target)), c(100, 200, 300))
})

# Test lap_solve() with grouped data ----

test_that("lap_solve() works with grouped data frames", {
  df <- tibble::tibble(
    sim = rep(1:2, each = 9),
    source = rep(1:3, times = 6),
    target = rep(1:3, each = 3, times = 2),
    cost = c(4, 2, 5, 3, 3, 6, 7, 5, 4,
             1, 2, 3, 4, 3, 2, 5, 4, 1)
  )
  
  result <- df |>
    dplyr::group_by(sim) |>
    lap_solve(source, target, cost)
  
  expect_true("sim" %in% names(result))
  expect_equal(length(unique(result$sim)), 2)
  expect_equal(nrow(result), 6)  # 3 assignments per sim
})

test_that("lap_solve() preserves multiple grouping variables", {
  df <- tibble::tibble(
    scenario = rep(c("A", "B"), each = 9),
    iteration = rep(1:3, each = 6),
    source = rep(1:3, times = 6),
    target = rep(1:3, each = 3, times = 2),
    cost = runif(18, 1, 10)
  )
  
  result <- df |>
    dplyr::group_by(scenario, iteration) |>
    lap_solve(source, target, cost)
  
  expect_true(all(c("scenario", "iteration") %in% names(result)))
})

# Test lap_solve_batch() ----

test_that("lap_solve_batch() works with list of matrices", {
  costs <- list(
    matrix(c(1, 2, 3, 4), 2, 2),
    matrix(c(5, 6, 7, 8), 2, 2)
  )
  
  result <- lap_solve_batch(costs)
  
  expect_s3_class(result, "lap_solve_batch_result")
  expect_true("problem_id" %in% names(result))
  expect_equal(length(unique(result$problem_id)), 2)
})

test_that("lap_solve_batch() works with 3D array", {
  arr <- array(c(1:8), dim = c(2, 2, 2))
  
  result <- lap_solve_batch(arr)
  
  expect_s3_class(result, "lap_solve_batch_result")
  expect_equal(length(unique(result$problem_id)), 2)
})

test_that("lap_solve_batch() works with grouped data frames", {
  df <- tibble::tibble(
    sim = rep(1:3, each = 4),
    source = rep(1:2, times = 6),
    target = rep(1:2, each = 2, times = 3),
    cost = runif(12, 1, 10)
  )
  
  result <- df |>
    dplyr::group_by(sim) |>
    lap_solve_batch(source, target, cost)
  
  expect_s3_class(result, "lap_solve_batch_result")
  expect_true("sim" %in% names(result))
  expect_equal(length(unique(result$sim)), 3)
})

# Test lap_solve_kbest() ----

test_that("lap_solve_kbest() returns k solutions", {
  cost <- matrix(c(4, 2, 5,
                   3, 3, 6,
                   7, 5, 4), nrow = 3)
  
  result <- lap_solve_kbest(cost, k = 3)
  
  expect_s3_class(result, "lap_solve_kbest_result")
  expect_true("rank" %in% names(result))
  expect_true("solution_id" %in% names(result))
  expect_lte(max(result$rank), 3)
})

test_that("lap_solve_kbest() solutions are ordered by cost", {
  cost <- matrix(c(1, 2, 3,
                   4, 3, 2,
                   5, 4, 1), nrow = 3)
  
  result <- lap_solve_kbest(cost, k = 5)
  
  costs_by_rank <- result |>
    dplyr::group_by(rank, total_cost) |>
    dplyr::summarise(n = dplyr::n(), .groups = "drop") |>
    dplyr::arrange(rank)
  
  expect_equal(costs_by_rank$total_cost, sort(costs_by_rank$total_cost))
})

test_that("lap_solve_kbest() works with data frames", {
  df <- tibble::tibble(
    source = rep(1:3, each = 3),
    target = rep(1:3, times = 3),
    cost = c(4, 2, 5, 3, 3, 6, 7, 5, 4)
  )
  
  result <- lap_solve_kbest(df, k = 3, source, target, cost)
  
  expect_s3_class(result, "lap_solve_kbest_result")
  expect_lte(max(result$rank), 3)
})

# Test utility functions ----

test_that("is_lap_solve_result() works correctly", {
  cost <- matrix(1:9, 3, 3)
  result <- lap_solve(cost)
  
  expect_true(is_lap_solve_result(result))
  expect_false(is_lap_solve_result(cost))
  expect_false(is_lap_solve_result(tibble(x = 1)))
})

test_that("get_total_cost() extracts cost correctly", {
  cost <- matrix(c(1, 2, 3, 4), 2, 2)
  result <- lap_solve(cost)
  
  total <- get_total_cost(result)
  expect_type(total, "double")
  expect_equal(total, attr(result, "total_cost"))
})

test_that("as_assignment_matrix() converts back to matrix", {
  cost <- matrix(c(1, 2, 3, 4), 2, 2)
  result <- lap_solve(cost)
  
  mat <- as_assignment_matrix(result)
  
  expect_true(is.matrix(mat))
  expect_equal(dim(mat), c(2, 2))
  expect_true(all(mat %in% c(0, 1)))
  expect_equal(sum(mat), 2)  # Should have 2 assignments
})

# Test print methods ----

test_that("print.lap_solve_result() works", {
  cost <- matrix(c(1, 2, 3, 4), 2, 2)
  result <- lap_solve(cost)
  
  expect_output(print(result), "Assignment Result")
  expect_output(print(result), "Total cost")
})

test_that("summary.lap_solve_kbest_result() works", {
  cost <- matrix(c(1, 2, 3,
                   4, 3, 2,
                   5, 4, 1), nrow = 3)
  result <- lap_solve_kbest(cost, k = 3)
  
  summ <- summary(result)
  
  expect_s3_class(summ, "tbl_df")
  expect_true(all(c("rank", "total_cost", "n_assignments") %in% names(summ)))
})

# Test edge cases ----

test_that("lap_solve() handles empty results gracefully", {
  cost <- matrix(NA, 2, 2)
  
  expect_error(lap_solve(cost))  # Should error on all-NA matrix
})

test_that("lap_solve() handles single element matrix", {
  cost <- matrix(5, 1, 1)
  
  result <- lap_solve(cost)
  
  expect_equal(nrow(result), 1)
  expect_equal(result$cost[1], 5)
})

test_that("lap_solve_batch() handles empty list", {
  expect_error(lap_solve_batch(list()))
})

# Test example data ----

test_that("example_costs work correctly", {
  expect_type(example_costs, "list")
  expect_true("simple_3x3" %in% names(example_costs))
  
  result <- lap_solve(example_costs$simple_3x3)
  expect_s3_class(result, "lap_solve_result")
})

test_that("example_df works correctly", {
  expect_s3_class(example_df, "tbl_df")
  expect_true(all(c("sim", "source", "target", "cost") %in% names(example_df)))
  
  result <- example_df |>
    dplyr::group_by(sim) |>
    lap_solve(source, target, cost)
  
  expect_equal(length(unique(result$sim)), 2)
})