# test whether two matches are the same. Uses all.equal on exceedances
# to ignore errors below some tolerance. After checking those, strips
# attributes that may differ but not break `identical` status.
# prices are often not the name, so it is often useful to ignore those
# other arguments passed to expect_equal
match_equal <- function(match1, match2, ignore.solver = TRUE, ignore.prices = TRUE, ...) {
expect_true(all.equal(attr(match1, "exceedances"),
attr(match2, "exceedances")))
attr(match1, "hashed.distance") <- NULL
attr(match2, "hashed.distance") <- NULL
attr(match1, "exceedances") <- NULL
attr(match2, "exceedances") <- NULL
attr(match1, "call") <- NULL
attr(match2, "call") <- NULL
if (!ignore.solver) {
attr(match1, "solver") <- NULL
attr(match2, "solver") <- NULL
}
if (ignore.prices) {
attr(match1, "MCFSolutions")@nodes$price <- NULL
attr(match2, "MCFSolutions")@nodes$price <- NULL
}
expect_equal(match1, match2, ...)
}
#' Similar to match_equal, but doesn't care about differences
#' among labels of matched sets.
match_equivalent <- function(match1, match2) {
expect_true(all.equal(attr(match1, "exceedances"),
attr(match2, "exceedances")))
attr(match1, "hashed.distance") <- NULL
attr(match2, "hashed.distance") <- NULL
attr(match1, "exceedances") <- NULL
attr(match2, "exceedances") <- NULL
attr(match1, "call") <- NULL
attr(match2, "call") <- NULL
m1labs <- as.character(match1[!is.na(match1) & !duplicated(match1)])
levels(match1)[match(m1labs, levels(match1))] <- m1labs
match1 <- factor(match1)
m2labs <- as.character(match2[!is.na(match2) & !duplicated(match2)])
levels(match2)[match(m2labs, levels(match2))] <- m2labs
match2 <- factor(match2)
expect_true(identical(match1, match2))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.