# ============================================================================== # Tests for CSA (Cost Scaling Algorithm) solver # ============================================================================== # The CSA solver is the Goldberg-Kennedy cost-scaling algorithm, # which is often fastest for medium-large problems. # ------------------------------------------------------------------------------ # Basic functionality tests # ------------------------------------------------------------------------------ test_that("assignment with method='csa' works on simple problem", { cost <- matrix(c(1, 5, 5, 1), 2, 2) result <- assignment(cost, method = "csa") expect_s3_class(result, "lap_solve_result") expect_equal(length(result$match), 2) expect_equal(result$status, "optimal") expect_equal(result$method_used, "csa") }) test_that("csa finds optimal assignment for 3x3 problem", { cost <- matrix(c( 1, 2, 3, 4, 5, 6, 7, 8, 9 ), nrow = 3, byrow = TRUE) result <- assignment(cost, method = "csa") # Optimal assignment: (1,1), (2,2), (3,3) or (1,3), (2,2), (3,1) expect_equal(result$total_cost, 15) # 1 + 5 + 9 = 15 expect_equal(result$status, "optimal") }) test_that("csa handles rectangular matrices (more cols)", { cost <- matrix(c( 1, 2, 3, 4, 5, 6, 7, 8 ), nrow = 2, byrow = TRUE) result <- assignment(cost, method = "csa") expect_equal(length(result$match), 2) expect_true(result$total_cost <= 3 + 8) # At most col 1 + col 4 }) test_that("csa handles rectangular matrices (more rows)", { cost <- matrix(c( 1, 2, 3, 4, 5, 6 ), nrow = 3, byrow = TRUE) result <- assignment(cost, method = "csa") # With auto-transpose, should work expect_equal(length(result$match), 3) }) # ------------------------------------------------------------------------------ # Maximization tests # ------------------------------------------------------------------------------ test_that("csa works with maximize=TRUE", { cost <- matrix(c(1, 5, 5, 1), 2, 2) result <- assignment(cost, method = "csa", maximize = TRUE) expect_equal(result$total_cost, 10) # 5 + 5 }) test_that("csa maximization finds correct assignment", { cost <- matrix(c( 1, 9, 3, 4, 2, 6, 7, 5, 8 ), nrow = 3, byrow = TRUE) result <- assignment(cost, method = "csa", maximize = TRUE) # Maximum: 9 + 6 + 7 = 22 or similar expect_true(result$total_cost >= 20) expect_equal(result$status, "optimal") }) # ------------------------------------------------------------------------------ # Edge cases # ------------------------------------------------------------------------------ test_that("csa handles 1x1 matrix", { cost <- matrix(5, 1, 1) result <- assignment(cost, method = "csa") expect_equal(result$match, 1L) expect_equal(result$total_cost, 5) }) test_that("csa handles identity cost matrix", { n <- 4 cost <- diag(n) # Identity: diagonal = 1, off-diagonal = 0 result <- assignment(cost, method = "csa") # Optimal is to avoid the diagonal (all zeros) expect_equal(result$total_cost, 0) }) test_that("csa handles uniform cost matrix", { cost <- matrix(5, 3, 3) result <- assignment(cost, method = "csa") expect_equal(result$total_cost, 15) # 3 * 5 }) test_that("csa handles NA (forbidden) entries", { cost <- matrix(c( 1, NA, 3, 4, 5, NA, NA, 8, 9 ), nrow = 3, byrow = TRUE) result <- assignment(cost, method = "csa") # Should find valid assignment avoiding NAs expect_equal(result$status, "optimal") }) test_that("csa handles Inf (forbidden) entries", { cost <- matrix(c( 1, Inf, 3, 4, 5, Inf, Inf, 8, 9 ), nrow = 3, byrow = TRUE) result <- assignment(cost, method = "csa") # Should find valid assignment avoiding Infs expect_equal(result$status, "optimal") }) # ------------------------------------------------------------------------------ # Larger problem tests # ------------------------------------------------------------------------------ test_that("csa handles medium-size problems efficiently", { skip_on_cran() # Skip time-sensitive tests on CRAN set.seed(123) n <- 50 cost <- matrix(runif(n * n), n, n) result <- assignment(cost, method = "csa") expect_equal(length(result$match), n) expect_equal(result$status, "optimal") # Should be a valid permutation expect_equal(sort(result$match), 1:n) }) test_that("csa produces valid permutation", { set.seed(456) n <- 20 cost <- matrix(runif(n * n), n, n) result <- assignment(cost, method = "csa") # Match should be a permutation (each column assigned exactly once) expect_equal(sort(result$match), 1:n) }) # ------------------------------------------------------------------------------ # Comparison with other solvers # ------------------------------------------------------------------------------ # NOTE - We don't assume identical solutions from different solvers # as tie-breaking can differ. But optimal costs should match. test_that("csa matches hungarian solver on optimal cost", { set.seed(789) cost <- matrix(runif(16), 4, 4) result_csa <- assignment(cost, method = "csa") result_hun <- assignment(cost, method = "hungarian") # Optimal costs should be equal (or very close due to floating point) expect_equal(result_csa$total_cost, result_hun$total_cost, tolerance = 1e-9) }) test_that("csa matches jv solver on optimal cost", { set.seed(101) cost <- matrix(runif(25), 5, 5) result_csa <- assignment(cost, method = "csa") result_jv <- assignment(cost, method = "jv") expect_equal(result_csa$total_cost, result_jv$total_cost, tolerance = 1e-9) }) # ------------------------------------------------------------------------------ # Stress tests # ------------------------------------------------------------------------------ test_that("csa handles sparse matrix (many forbidden entries)", { n <- 10 cost <- matrix(Inf, n, n) # Create a valid assignment path for (i in 1:n) { cost[i, i] <- runif(1) cost[i, (i %% n) + 1] <- runif(1) } result <- assignment(cost, method = "csa") expect_equal(result$status, "optimal") expect_true(is.finite(result$total_cost)) }) test_that("csa handles wide value range", { cost <- matrix(c( 1e-6, 1e6, 1e6, 1e-6 ), 2, 2) result <- assignment(cost, method = "csa") expect_equal(result$total_cost, 2e-6, tolerance = 1e-12) }) # ------------------------------------------------------------------------------ # Via lap_solve interface # ------------------------------------------------------------------------------ test_that("lap_solve works with csa method", { cost <- matrix(c(1, 5, 5, 1), 2, 2) result <- lap_solve(cost, method = "csa") expect_s3_class(result, "lap_solve_result") expect_equal(nrow(result), 2) expect_true("cost" %in% names(result)) })