tests/testthat/test-various.R

In magclass: Data Class and Tools for Handling Spatial-Temporal Data

a <- maxample("animal")
attr(a, "Metadata") <- NULL  # nolint: object_name_linter
p <- maxample("pop")
attr(p, "Metadata") <- NULL  # nolint: object_name_linter


test_that("getComment works", {
  x <- as.magpie(1)
  expect_silent(getComment(x) <- "this is a comment")
  expect_identical(getComment(x), "this is a comment")
  expect_identical(getComment(setComment(x, "new comment")), "new comment")
})

test_that("is-methods work", {
  tf <- as.magpie(c(TRUE, FALSE))
  expect_identical(is.nan(as.magpie(c(NaN, 2))), tf)
  expect_identical(is.na(as.magpie(c(NA, 2))), tf)
  expect_identical(is.infinite(as.magpie(c(-Inf, 2))), tf)
  expect_identical(is.finite(as.magpie(c(2, Inf))), tf)
})

test_that("Incorrect inputs are properly detected", {
  expect_error(maxample("nothere"), "Unknown data set")
  expect_warning(magclass:::.duplicates_check(getCoords(a)[c(1, 1, 2:5), ]), "Duplicate entries")
})

test_that("magpiesort works", {
  expect_error(magpiesort(1), "not a MAgPIE object")
  expect_identical(magpiesort(a[, dim(a)[2]:1, ]), magpiesort(a)) # nolint: seq_linter
  expect_identical(getItems(magpiesort(a), dim = 1),
                   getItems(magpiesort(a[, , NULL]), dim = 1))
  expect_identical(getItems(magpiesort(a[1, , ]), dim = 2),
                   getItems(magpiesort(a[NULL, , ]), dim = 2))
  expect_identical(magpiesort(p), magpiesort(p[dim(p)[1]:1, , ])) # nolint: seq_linter
})

test_that("(un)wrap works", {
  x <- as.magpie(array(1:6, c(3, 2), list(c("bla", "blub", "ble"), c("up", "down"))))
  ref <- structure(1:6, .Dim = c(1L, 1L, 3L, 2L),
                   .Dimnames = list("GLO", NULL, c("bla", "blub", "ble"), c("up", "down")))
  expect_identical(unwrap(x), ref)
  expect_warning(unwrap(x, sep = ":"), "not supported anymore")
  expect_error(unwrap(1), "not a MAgPIE object")
  expect_error(unwrap(x[, , c(1, 1)]), "Duplicated names detected")
  expect_error(unwrap(a), "needs to be complete")
  p0 <- p[, , 1]
  getItems(p0, dim = 3) <- NULL
  a0 <- as.array(p0)
  names(dimnames(a0)) <- NULL
  expect_identical(unwrap(p0), a0)
  expect_error(wrap(1), "not an array")
  expect_error(wrap(p0, map = 1), "not a list")
  expect_error(wrap(p0, map = list(1, 1)), "duplicated dimension indices")
  expect_error(wrap(p0, map = list(1:4)), "non-existing dimension")
  expect_error(wrap(p0, map = list(1)), "miss some dimensions")
  ref <- new("magpie", .Data = structure(c(AFR.y1995. = 553, CPA.y1995. = 1281),
                                         .Dim = 2L, .Dimnames = list(i.t.d3 = c("AFR.y1995.", "CPA.y1995."))))
  expect_identical(wrap(round(p0[1:2, 1, 1]), map = list(1:3)), ref)
  expect_identical(wrap(p0[1:2, 1, NULL]), new("magpie", .Data = structure(numeric(0), .Dim = 0L)))
})

test_that("head and tail work", {
  expect_identical(head(a, n2 = 2), a[1:3, 1:2, 1:2])
  expect_identical(tail(a, n2 = 2), a[dim(a)[1] - 2:0, dim(a)[2] - 1:0, dim(a)[3] - 1:0])
  expect_identical(tail(a[1, 1, 1]), a[1, 1, 1])
  expect_identical(head(a[1, 1, 1]), a[1, 1, 1])
})

test_that("getCells works", {
  expect_error(getCells(p) <- 12, "Wrong number of cell names supplied")
  p0a <- p0b <- p[NULL, , ]
  expect_silent(getCells(p0a) <- NULL)
  expect_identical(p0a, p0b)
})

test_that("getRegions works", {
  a <- collapseDim(a, dim = c("x", "y"))
  expect_identical(getRegions(a), c("NLD", "BEL", "LUX")) # nolint: undesirable_function_linter
  expect_warning(getRegions(a) <- rep("BLA", ncells(a)), "deprecated") # nolint: undesirable_function_linter
  expect_identical(getRegions(a), "BLA") # nolint: undesirable_function_linter
  a0 <- dimSums(a, dim = 1)
  expect_null(getRegions(a0)) # nolint: undesirable_function_linter
  expect_equal(nregions(a0), 1) # nolint: undesirable_function_linter
})

test_that("getRegionList works", {
  a <- collapseDim(a, dim = c("x", "y"))
  expect_warning(rl <- getRegionList(a), "deprecated") # nolint: undesirable_function_linter
  expect_identical(rl, as.factor(getItems(a, dim = "country", full = TRUE)))
  expect_error(suppressWarnings(getRegionList(a) <- "GLO"), "Lengths of RegionLists do not agree") # nolint: undesirable_function_linter
  expect_warning(getRegionList(a) <- rep("GLO", dim(a)[1]), "deprecated") # nolint: undesirable_function_linter
  expect_identical(suppressWarnings(getRegionList(a)), as.factor(rep("GLO", dim(a)[1]))) # nolint: undesirable_function_linter
})

test_that("rounding works", {
  ref <- new("magpie", .Data = structure(c(552.67, 1280.64), .Dim = c(2L, 1L, 1L),
                                         .Dimnames = list(i = c("AFR", "CPA"), t = "y1995", scenario = "A2")))
  expect_identical(round(p[1:2, 1, 1], 2), ref)
})

test_that("isYear works", {
  expect_true(all(isYear(getYears(p, as.integer = TRUE), with_y = FALSE)))
  expect_true(all(isYear(getYears(p), with_y = TRUE)))
  expect_false(isYear("yabcd"))
  expect_false(isYear("y12345"))
  expect_false(isYear("abcd", with_y = FALSE))
  expect_false(isYear("12345", with_y = FALSE))
  expect_error(isYear(p), "is no Vector")
})

test_that("getYear works", {
  expect_error(getYears(p) <- 1999, "Wrong number of years")
  expect_silent(getYears(p[, -(1:nyears(p)), ]) <- NULL) # nolint
  p1 <- p[, 1, ]
  expect_silent(getYears(p1) <- NULL)
  expect_null(getYears(p1))
  expect_error(getYears(p) <- NULL, "Setting years to NULL is not possible")
  expect_error(getYears(p1) <- "x1000", "Wrong year format")
})

test_that("sizeCheck works", {
  limit <- getOption("magclass_sizeLimit")
  withr::defer(options(magclass_sizeLimit = limit))

  # passing magpie objects instead of magpie object dimensions
  expect_error(magclass:::sizeCheck(p),
               "Numeric vector of dimension sizes expected.")

  # passing magpie object dimensions
  expect_null(magclass:::sizeCheck(dim(p)))

  # passing too large magpie object dimensions
  options(magclass_sizeLimit = 1)
  expect_error(magclass:::sizeCheck(dim(p)),
               "magclass object size .* exceeds limit")
})

test_that("log methods work", {
  expect_identical(as.vector(logb(as.magpie(10), 10)), 1)
  expect_identical(as.vector(log(as.magpie(10), 10)), 1)
})