tests/testthat/test.summary.optmatch.old.R

In optmatch: Functions for Optimal Matching

context('summary optmatch old')

test_that("summary.optmatch", {
  data(plantdist)
  expect_warning(s1 <- summary(f1 <- fullmatch(1 * (plantdist < 10)))) # a zero-1 matrix
  expect_true(all.equal(s1$thematch, f1))
  expect_true(is.null(s1$matching.failed))
  #expect_true(all.equal(as.vector(s1$matched.set.structures), c(5,1,1)))
  #expect_equal(s1$effective.sample.size, 8.1794871)
  #expect_equal(s1$total.distance, 0)
  #expect_equal(s1$total.tolerances, .0054166666)
  #expect_equal(sum(s1$matched.dist.quantiles), 0)


  # Mtching doesn't fail everywhere
  #expect_error(summary(pairmatch(plantdist + caliper(plantdist, 1)))) # Matching fails everywhere

  data(nuclearplants)
  psm <- glm(pr~.-(pr+cost), family=binomial(), data=nuclearplants)
  psd <- match_on(psm, standardization.scale = sd) # backwards compatible to 0.7-2
  psfm <- fullmatch(psd + caliper(psd, 0.25), data = nuclearplants)
  summary(psfm) #!

  # Matching fails in a subgroup
  expect_warning(pspm <- pairmatch(caliper(match_on(psm, standarization.scale = sd,
                                     within = exactMatch(pr ~ pt, data = nuclearplants)),
                            width=2),
                    data=nuclearplants))

  expect_true(!is.null(summary(pspm)$matching.failed))
  psd[1,] <- psd[1,] + rep(100,22)

  # due to slight differences in the match on different platforms, just check that the
  # total.distances remain the same
  #expect_equal(summary(pairmatch(psd, controls=2, data = nuclearplants))$total.distance, 225.83338)

  # RItools is loaded directly, so this occasion can not happen
  # without PEBKAC.
  ## if ("RItools" %in% loadedNamespaces()) {
  ##   detach(package:RItools, unload=TRUE)
  ## }
  ## s2 <- summary(psfm, propensity.model=psm)
  ## expect_true(!is.null(s2$warnings))
  if (requireNamespace("RItools", quietly = TRUE)) {
    require('RItools')
    s3 <- summary(psfm, propensity.model='foo')
    expect_true(!is.null(s3$warnings))
    s4 <- summary(psfm, propensity.model=psm)
    expect_true(is.null(s4$warnings))
    s5 <- summary(psfm, psm)
    expect_true(is.null(s5$warnings))


    #expect_equal(s2$thematch, s3$thematch)
    #expect_equal(s2$thematch, s4$thematch)
    #expect_equal(s2$thematch, s5$thematch)


    psm2 <- glm(pr~ cut(date, c(67, 69.5, 72)) +
                  t1 + t2 + cap + ne + ct + bw + cum.n + pt,
                family=binomial, data=nuclearplants)
    psd2 <- match_on(psm2, standardization.scale = sd)
    psd2summary <- summary(pairmatch(psd2, data = nuclearplants), propensity.model=psm2)

    # due to slight differences in the match on different platforms, just check that the
    # total.distances are the same and that the chi-squared value is 9.5 +- 0.5

    #expect_equal(psd2summary$total.distance, 7.5621504)
    chisquared.value <- psd2summary$balance$overall$chisquare
    #expect_true(abs(9.5 - chisquared.value) < 0.5)
    # 6/6/22 - above test fails after nodepricing branch merge. Too old to fix
  }
})