From d0998b768f323e1d27b89733d48cc6dd0421c7d9 Mon Sep 17 00:00:00 2001
From: Josh Errickson <josh@errickson.net>
Date: Wed, 10 Jul 2019 20:30:50 -0400
Subject: [PATCH] #175; expanded tests and fixed subproblemSuccess/matchfailed

---
 R/fullmatch.R                  | 10 ++----
 R/matchfailed.R                |  4 ++-
 tests/testthat/test.Optmatch.R | 61 ++++++++++++++++++++++++++++++++--
 3 files changed, 64 insertions(+), 11 deletions(-)

diff --git a/R/fullmatch.R b/R/fullmatch.R
index cf43347c..a8d9a9fd 100644
--- a/R/fullmatch.R
+++ b/R/fullmatch.R
@@ -593,17 +593,11 @@ fullmatch.matrix <- function(x,
   attr(mout, "call") <- cl
 
 
-  ### Due to a bug in `subproblemSuccess` (#175) we need
-  ### to manually check for failure here.
-  #if (all(isFALSE(subproblemSuccess(mout)))) {
-  grps <- attr(mout, "subproblem")
-  failed <- sapply(split(mout, grps), function(x) { all(is.na(x) | grepl("\\.NA$", x)) })
-  if (all(failed)) {
+  if (all(subproblemSuccess(mout) == FALSE)) {
     warning(paste("Matching failed.",
                   "(Restrictions impossible to meet?)\n",
                   "Enter ?matchfailed for more info."))
-  #} else if (any(isFALSE(subproblemSuccess(mout)))) {
-  } else if (any(failed)) {
+  } else if (any(subproblemSuccess(mout) == FALSE)) {
     warning(paste("At least one subproblem matching failed.\n",
                   "(Restrictions impossible to meet?)\n",
                   "Enter ?matchfailed for more info."))
diff --git a/R/matchfailed.R b/R/matchfailed.R
index dda26017..c958777e 100644
--- a/R/matchfailed.R
+++ b/R/matchfailed.R
@@ -20,6 +20,8 @@ matchfailed <- function(x) {
 #' @keywords internal
 subproblemSuccess <- function(x) {
   grps <- attr(x, "subproblem")
-  failed <- sapply(split(x, grps), function(x) { all(is.na(x)) })
+  failed <- sapply(split(x, grps), function(x) {
+    all(is.na(x) | grepl("\\.NA$", x))
+  })
   return(!failed)
 }
diff --git a/tests/testthat/test.Optmatch.R b/tests/testthat/test.Optmatch.R
index 7998a171..25db6bf9 100644
--- a/tests/testthat/test.Optmatch.R
+++ b/tests/testthat/test.Optmatch.R
@@ -182,8 +182,65 @@ test_that("Indicating failing subproblems", {
   names(Z) <- names(B) <- letters[1:16]
   match <- pairmatch(exactMatch(Z ~ B), data = Z) # assure data order by passing Z
 
-  expect_equal(sum(subproblemSuccess(match)), 2)
-  expect_true(all(names(subproblemSuccess(match)) %in%  c("1", "2")))
+  spS <- subproblemSuccess(match)
+  mf <- matchfailed(match)
+  expect_equal(sum(spS), 2)
+  expect_true(all(names(spS) %in%  c("1", "2")))
+  expect_is(mf, "logical")
+  expect_length(mf, length(B))
+  expect_true(all(mf == FALSE))
+
+  Z[1] <- 1
+  match <- pairmatch(exactMatch(Z ~ B), data = Z)
+
+  spS <- subproblemSuccess(match)
+  mf <- matchfailed(match)
+  expect_equal(sum(spS), 2)
+  expect_true(all(names(spS) %in%  c("1", "2")))
+  expect_is(mf, "logical")
+  expect_length(mf, length(B))
+  expect_true(all(mf == FALSE))
+
+
+  data(nuclearplants)
+  expect_warning(f1 <- fullmatch(pr ~ t1, data = nuclearplants,
+                                 min = 5, max = 5))
+
+  spS <- subproblemSuccess(f1)
+  mf <- matchfailed(f1)
+  expect_true(all(spS == FALSE))
+  expect_equal(names(spS), "1")
+  expect_is(mf, "logical")
+  expect_length(mf, nrow(nuclearplants))
+  expect_true(all(mf == TRUE))
+
+  expect_warning(f2 <-
+                   fullmatch(pr ~ t1, data = nuclearplants,
+                             min = 5, max = 5,
+                             within =
+                               exactMatch(pr ~ pt,
+                                          data = nuclearplants)))
+
+  spS <- subproblemSuccess(f2)
+  mf <- matchfailed(f2)
+  expect_true(all(spS == FALSE))
+  expect_is(mf, "logical")
+  expect_length(mf, nrow(nuclearplants))
+  expect_true(all(mf == TRUE))
+
+  expect_warning(f3 <-
+                   fullmatch(pr ~ cost, data = nuclearplants,
+                             min = 60, max = 60,
+                             within =
+                               exactMatch(pr ~ pt,
+                                          data = nuclearplants)))
+
+  spS <- subproblemSuccess(f3)
+  mf <- matchfailed(f3)
+  expect_true(all(spS == FALSE))
+  expect_is(mf, "logical")
+  expect_length(mf, nrow(nuclearplants))
+  expect_true(all(mf == TRUE))
 })
 
 test_that("optmatch_restrictions", {