tests/testthat/test-lap-solve-batch-coverage-3.R

In couplr: Optimal Pairing and Matching via Linear Assignment

# ==============================================================================
# Additional tests for lap_solve_batch.R coverage (parallel execution and edges)
# ==============================================================================

# ------------------------------------------------------------------------------
# Parallel execution tests (with n_threads > 1 and n_problems >= 4)
# ------------------------------------------------------------------------------

test_that("lap_solve_batch parallel execution with matrices", {
  skip_if_not_installed("parallel")

  # Need at least 4 problems to trigger parallel path
  costs <- lapply(1:5, function(i) matrix(runif(9), 3, 3))

  result <- lap_solve_batch(costs, n_threads = 2)

  expect_s3_class(result, "lap_solve_batch_result")
  expect_equal(length(unique(result$problem_id)), 5)
  expect_true(all(result$total_cost >= 0))
})

test_that("lap_solve_batch with n_threads = NULL uses all cores", {
  skip_if_not_installed("parallel")
  skip_on_cran()
  skip_if(nzchar(Sys.getenv("_R_CHECK_LIMIT_CORES_")),
          "parallel tests limited in check environments")

  costs <- lapply(1:5, function(i) matrix(runif(4), 2, 2))

  # Should not error when n_threads = NULL
  result <- lap_solve_batch(costs, n_threads = NULL)

  expect_s3_class(result, "lap_solve_batch_result")
})

test_that("lap_solve_batch parallel with grouped df", {
  skip_if_not_installed("parallel")

  df <- tibble::tibble(
    sim = rep(1:6, each = 9),
    source = rep(1:3, times = 18),
    target = rep(1:3, each = 3, times = 6),
    cost = runif(54, 1, 10)
  )

  grouped_df <- dplyr::group_by(df, sim)

  result <- lap_solve_batch(grouped_df, source, target, cost, n_threads = 2)

  expect_s3_class(result, "lap_solve_batch_result")
  expect_equal(length(unique(result$sim)), 6)
})

# ------------------------------------------------------------------------------
# Error path: grouped df missing all three columns
# ------------------------------------------------------------------------------

test_that("lap_solve_batch_grouped errors on missing all column specs", {
  df <- tibble::tibble(
    grp = rep(1:2, each = 4),
    src = rep(1:2, times = 4),
    tgt = rep(1:2, each = 2, times = 2),
    val = runif(8)
  )

  grouped_df <- dplyr::group_by(df, grp)

  # Missing all three columns
  expect_error(
    lap_solve_batch(grouped_df),
    "must specify"
  )

  # Missing target
  expect_error(
    lap_solve_batch(grouped_df, source = src, cost = val),
    "must specify"
  )

  # Missing cost
  expect_error(
    lap_solve_batch(grouped_df, source = src, target = tgt),
    "must specify"
  )
})

# ------------------------------------------------------------------------------
# Edge cases: empty results (no matched pairs) - triggers branch in map_dfr
# ------------------------------------------------------------------------------

test_that("lap_solve_batch errors on matrices with all forbidden", {
  # Matrix with all Inf (forbidden) - should error
  costs <- list(
    matrix(Inf, 2, 2),
    matrix(c(1, 2, 3, 4), 2, 2)
  )

  expect_error(
    lap_solve_batch(costs),
    "Infeasible|forbidden"
  )
})

# ------------------------------------------------------------------------------
# Print method edge cases
# ------------------------------------------------------------------------------

test_that("print.lap_solve_batch_result handles missing columns gracefully", {
  # Create a result with minimal columns
  costs <- list(matrix(c(1, 2, 3, 4), 2, 2))
  result <- lap_solve_batch(costs)

  # Normal print
  output <- capture.output(print(result))
  expect_true(any(grepl("Batch Assignment", output)))

  # Remove problem_id column to test edge case
  result_no_problem <- result
  result_no_problem$problem_id <- NULL
  class(result_no_problem) <- c("lap_solve_batch_result", class(result_no_problem))

  output2 <- capture.output(print(result_no_problem))
  expect_true(any(grepl("Batch Assignment", output2)))
})

test_that("print.lap_solve_batch_result handles empty total_cost", {
  # Result without total_cost column
  result <- tibble::tibble(
    problem_id = 1,
    source = 1L,
    target = 1L,
    cost = 1.0
  )
  class(result) <- c("lap_solve_batch_result", class(result))

  output <- capture.output(print(result))
  expect_true(any(grepl("Batch Assignment", output)))
})

# ------------------------------------------------------------------------------
# Method variations in batch
# ------------------------------------------------------------------------------

test_that("lap_solve_batch works with various methods", {
  costs <- lapply(1:4, function(i) matrix(runif(9), 3, 3))

  for (m in c("auto", "jv", "hungarian")) {
    result <- lap_solve_batch(costs, method = m)
    expect_s3_class(result, "lap_solve_batch_result")
    expect_true(all(result$method_used != ""))
  }
})

# ------------------------------------------------------------------------------
# 3D array dimension variations
# ------------------------------------------------------------------------------

test_that("lap_solve_batch handles 3D array with rectangular slices", {
  # 2x3 slices
  arr <- array(runif(6 * 4), dim = c(2, 3, 4))

  result <- lap_solve_batch(arr)

  expect_s3_class(result, "lap_solve_batch_result")
  expect_equal(length(unique(result$problem_id)), 4)
})

test_that("lap_solve_batch handles 3D array with single slice", {
  arr <- array(runif(4), dim = c(2, 2, 1))

  result <- lap_solve_batch(arr)

  expect_s3_class(result, "lap_solve_batch_result")
  expect_equal(length(unique(result$problem_id)), 1)
})

# ------------------------------------------------------------------------------
# Grouped df with different methods
# ------------------------------------------------------------------------------

test_that("lap_solve_batch grouped with different methods", {
  df <- tibble::tibble(
    grp = rep(1:2, each = 4),
    src = rep(1:2, times = 4),
    tgt = rep(1:2, each = 2, times = 2),
    val = runif(8, 1, 10)
  )

  grouped_df <- dplyr::group_by(df, grp)

  for (m in c("auto", "jv", "hungarian")) {
    result <- lap_solve_batch(grouped_df, src, tgt, val, method = m)
    expect_s3_class(result, "lap_solve_batch_result")
  }
})

# ------------------------------------------------------------------------------
# maximize = TRUE in batch
# ------------------------------------------------------------------------------

test_that("lap_solve_batch maximize with grouped df", {
  df <- tibble::tibble(
    grp = rep(1:3, each = 4),
    src = rep(1:2, times = 6),
    tgt = rep(1:2, each = 2, times = 3),
    val = runif(12, 1, 10)
  )

  grouped_df <- dplyr::group_by(df, grp)

  result_min <- lap_solve_batch(grouped_df, src, tgt, val, maximize = FALSE)
  result_max <- lap_solve_batch(grouped_df, src, tgt, val, maximize = TRUE)

  expect_s3_class(result_max, "lap_solve_batch_result")
  # Maximized total cost should be >= minimized
  expect_true(sum(result_max$total_cost) >= sum(result_min$total_cost))
})