tests/testthat/test_hv.R

In jakobbossek/ecr3vis: Evolutionary Computation in R - Version 3

context("Hypervolume (contribution)")

test_that("calculation of dominated hypervolume works as expected", {
  # here all the points in the approximation are located on a line
  # |
  # |               o (6,6)
  # |  o  (1,5)
  # |    o (2,4)
  # |      o (3,3)
  # |        o (4,2)
  # |          o (5,1)
  # __________________
  # The correct/expected dominated hypervolume value is 15 in this test case
  hv.exp = 15
  points = matrix(
    c(1, 5,
      2, 4,
      3, 3,
      4, 2,
      5, 1),
    nrow = 2L)
  r = c(6, 6)

  # HV with passed reference point
  hv = hv(points, r)
  expect_true(is.numeric(hv))
  expect_equal(hv, hv.exp)

  # HV with self computed reference point
  hv = hv(points)
  expect_true(is.numeric(hv))

  # Unequal dimensions
  expect_error(hv(points, r[-1L]))

  # check for warnings on infinite values
  points2 = points
  points2[1L, 1L] = Inf
  expect_warning(hv(points2, r), "point", ignore.case = TRUE)
  expect_true(suppressWarnings(is.nan(hv(points2, r))))

  r2 = r
  r2[2L] = Inf
  expect_warning(hv(points, r2), "Reference point", ignore.case = TRUE)
  expect_true(suppressWarnings(is.nan(hv(points, r2))))

  # now check the hypervolume contributions
  hv.contribs = hv_contr(points, r)
  expect_true(all(hv.contribs == 1))
  # the computed reference point should be equal to (6,6) too
  hv.contribs = hv_contr(points)
  expect_true(all(hv.contribs == 1))
})

test_that("assertions on hypervolume (contribution)", {
  n.points = 100L
  n.reps = 5L
  r = c(11, 11)
  for (i in seq(n.reps)) {
    # generate set of points
    x = matrix(runif(n.points * 2L, min = 0, max = 10), nrow = 2L)

    # Here we do naive nondominated sorting (later replace that with the fast
    # non-dominated sorting algorithm)
    # first non-dominanted front
    nondom.idx = which_nondominated(x)
    x1 = x[, nondom.idx, drop = FALSE]
    x = x[, -nondom.idx, drop = FALSE]

    # second non-dominanted front
    nondom.idx = which_nondominated(x)
    x2 = x[, nondom.idx, drop = FALSE]

    hv1 = hv(x1, r)
    hv2 = hv(x2, r)

    expect_true(hv1 >= 0)
    expect_true(hv2 >= 0)
    expect_true(hv1 > hv2, info = "HV of first non-dominanted front should be
      larger than the dominated HV of the second.")
    hvctrb1 = hv_contr(x1, r)
    hvctrb2 = hv_contr(x2, r)
    expect_true(all(hvctrb1 >= 0))
    expect_true(all(hvctrb2 >= 0))
  }
})