Nothing
##
## test-hypervolume.r - Hypervolume tests
##
context("hypervolume")
## Predeclare some simple test fronts:
simpleFront <- matrix(c(0.0, 1.0, 0.5,
1.0, 0.0, 0.5),
ncol=3, byrow=TRUE)
infFront <- simpleFront
infFront[,2] <- Inf
naFront <- simpleFront
naFront[,2] <- NA
nanFront <- simpleFront
nanFront[,2] <- NaN
test_that("dominated_hypervolume", {
expect_equal(dominated_hypervolume(simpleFront), 0.5^2)
expect_equal(dominated_hypervolume(simpleFront, c(1.0, 1.0)), 0.5^2)
## OME: FIXME should ignore outer points?
## expect_equal(dominated_hypervolume(simpleFront, c(0.8, 0.8)), 0.3^2)
expect_equal(dominated_hypervolume(simpleFront, c(2.0, 2.0)), 3.25)
expect_equal(dominated_hypervolume(simpleFront, c(0.0, 0.0)), 0)
expect_equal(dominated_hypervolume(simpleFront, c(0.5, 0.5)), 0)
suppressWarnings(expect_equal(dominated_hypervolume(simpleFront, c(NaN, NaN)),
NaN))
expect_warning(dominated_hypervolume(simpleFront, c(NaN, NaN)))
})
test_that("bad_front", {
## OME: Should probably also return NaN instead of NA
suppressWarnings(expect_equal(is.na(dominated_hypervolume(naFront)), TRUE))
suppressWarnings(expect_equal(dominated_hypervolume(nanFront), NaN))
expect_warning(is.na(dominated_hypervolume(naFront)))
expect_warning(dominated_hypervolume(nanFront))
})
test_that("inf_front", {
## OME: These should probably be reworked to return 'saner' values.
suppressWarnings(expect_equal(dominated_hypervolume(infFront), NaN))
expect_warning(dominated_hypervolume(infFront))
suppressWarnings(expect_equal(dominated_hypervolume(infFront, ref=c(1, 1)), NaN))
expect_warning(dominated_hypervolume(infFront, ref=c(1, 1)))
suppressWarnings(expect_equal(dominated_hypervolume(simpleFront, ref=c(Inf, Inf)), NaN))
expect_warning(dominated_hypervolume(simpleFront, ref=c(Inf, Inf)))
})
test.badInput <- function() {
expect_error(dominated_hypervolume(1:10))
expect_error(dominated_hypervolume("abc"))
expect_error(dominated_hypervolume(simpleFront, 1:3))
expect_error(dominated_hypervolume(simpleFront, 1))
}
test.dhv3d <- function() {
## Built with Lego. Hurra!
m3 <- structure(c(5, 2, 0, 4, 3, 0, 4, 2, 1, 4, 1, 2, 3, 2, 2, 2, 3,
2, 4, 0, 3, 3, 1, 3, 2, 2, 3, 3, 0, 4, 2, 1, 4, 1,
2, 4, 0, 3, 4, 0, 2, 5), .Dim = c(3L, 14L))
m3_dhv <- c(1, 1,
1,
2, 1, 1,
2, 1, 1,
2, 2, 1, 1,
1)
expect_equal(hypervolume_contribution(m3, c(6, 4, 6)), m3_dhv)
}
## Regression test for the permutation bug (missing duplicate()).
test.regress_perm <- function() {
## Built with Lego. Hurra!
m3 <- structure(c(5, 2, 0, 4, 3, 0, 4, 2, 1, 4, 1, 2, 3, 2, 2, 2, 3,
2, 4, 0, 3, 3, 1, 3, 2, 2, 3, 3, 0, 4, 2, 1, 4, 1,
2, 4, 0, 3, 4, 0, 2, 5), .Dim = c(3L, 14L))
o3 <- structure(c(5, 2, 0, 4, 3, 0, 4, 2, 1, 4, 1, 2, 3, 2, 2, 2, 3,
2, 4, 0, 3, 3, 1, 3, 2, 2, 3, 3, 0, 4, 2, 1, 4, 1,
2, 4, 0, 3, 4, 0, 2, 5), .Dim = c(3L, 14L))
hypervolume_contribution(m3)
expect_equal(m3, o3)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.