tests/testthat/test-triplesIP.R

In triplesmatch: Match Triples Consisting of Two Controls and a Treated Unit or Vice Versa

test_that("triplesIP gives same results as triples when all triples 2:1", {
  skip_if_not_installed("gurobi")
  set.seed(10)
  n <- 15
  x <- rnorm(n, 0, 1)
  nt <- floor(n * 0.8)
  nc <- n - nt
  z <- c(rep(1, nt), rep(0, nc))
  dist <- dist_mahal(data.frame(x = x), z, rep(1, n))[[1]]
  expect_warning({triplesm <- triples_st(cost = dist, z = z)}, "6 treated will not be matched")
  mIP <- triplesIP(z = z, cost = dist, mt = 6, mc = 3, time_limit = 60, threads = 1, verbose = 0)
  # Total cost matches the triples algo
  expect_equal(triplesm$obj, sum(mIP$match$costStep1) + sum(mIP$match$costStep2))
  # Total cost matches the stated objective value
  expect_equal(mIP$opt_info$objval, sum(mIP$match$costStep1) + sum(mIP$match$costStep2))
  # Stated objective value matches objective bound
  expect_equal(mIP$opt_info$objval, mIP$opt_info$objbound)
})

test_that("triplesIP gives same results as triples when all triples 1:2", {
  skip_if_not_installed("gurobi")
  set.seed(1)
  n <- 15
  x <- rnorm(n, 0, 1)
  nt <- floor(n * 0.2)
  nc <- n - nt
  z <- c(rep(1, nt), rep(0, nc))
  dist <- dist_mahal(data.frame(x = x), z, rep(1, n))[[1]]
  triplesm <- triples_st(cost = dist, z = z)

  mIP <- triplesIP(z = z, cost = dist, mt = 3, mc = 6, time_limit = 60, threads = 1, verbose = 0)
  # Total cost matches the triples algo
  expect_equal(triplesm$obj, sum(mIP$match$costStep1) + sum(mIP$match$costStep2))
  # Total cost matches the stated objective value
  expect_equal(mIP$opt_info$objval, sum(mIP$match$costStep1) + sum(mIP$match$costStep2))
  # Stated objective value matches objective bound
  expect_equal(mIP$opt_info$objval, mIP$opt_info$objbound)
})



test_that("triplesIP does better when it finishes", {
  skip_if_not_installed("gurobi")
  set.seed(6)
  n <- 30
  x <- rnorm(n, 0, 1)
  nt <- floor(n * 0.4)
  nc <- n - nt
  z <- c(rep(1, nt), rep(0, nc))
  dist <- dist_mahal(data.frame(x = x), z, rep(1, n))[[1]]
  triplesm <- triples_st(cost = dist, z = z)

  mt <- sum(triplesm$m$nOfTreated)
  mc <- nrow(triplesm$m) * 3 - mt
  mIP <- triplesIP(z = z, cost = dist, mt = mt, mc = mc, time_limit = 60, threads = 1, verbose = 0)
  # Objective beats the triples algo
  expect_true(mIP$opt_info$objval < triplesm$obj)
  # Stated objective value matches objective bound
  expect_equal(mIP$opt_info$objval, mIP$opt_info$objbound)
  # Objective exceeds lower bound of triples algo
  expect_true(mIP$opt_info$objval > triplesm$bound)
})