tests/testthat/test-input_creation.R

In gen3sis: General Engine for Eco-Evolutionary Simulations

test_that("create_directories overwrite protection works", {
  skip("can't mock file.exists")
  # mocking base functions is no longer feasible, overwrite is not tested as it calls "unlink"
  new_dirs <- list()
  local_mock(dir.create = function(new_dir, ...){ new_dirs <<- append(new_dirs, new_dir)} )
  # test overwrite protection
  local_mock(file.exists = function(...){ return(TRUE)} )
  expect_error(create_directories("test", overwrite = FALSE, full_matrices = FALSE),
               "output directory already exists", fixed = TRUE)
})


test_that("create_directories works", {
  # mocking base functions is no longer feasible, overwrite is not tested as it calls "unlink"
  new_dirs <- list()
  local_mock(dir.create = function(new_dir, ...){ new_dirs <<- append(new_dirs, new_dir)} )

  create_directories("test", overwrite = FALSE, full_matrices = FALSE)
  expect_true("test" %in% new_dirs)
  expect_true(!("test/distances_full" %in% new_dirs))

  # create directory for full matrices
  new_dirs <- list()
  create_directories("test", overwrite = FALSE, full_matrices = TRUE)
  expect_true("test" %in% new_dirs)
  expect_true("test/distances_local" %in% new_dirs)
  expect_true("test/distances_full" %in% new_dirs)

})


test_that("stack_landscapes from raster objects works", {
  # create rasters
  r11 <- raster(nrows = 5, ncols = 5, vals = runif(25))
  r12 <- raster(nrows = 5, ncols = 5, vals = runif(25))
  r21 <- raster(nrows = 5, ncols = 5, vals = runif(25))
  r22 <- raster(nrows = 5, ncols = 5, vals = runif(25))
  landscapes = list(l1 = c(r11, r12) , l2 = c(r21, r22))

  # check "time-step 1"
  stacked <- stack_landscapes(landscapes, 1)
  expect_true(all(names(stacked) == c("l1", "l2")))
  expect_true(all.equal(r11, stacked[["l1"]]))
  expect_true(all.equal(r21, stacked[["l2"]]))

  # check "time-step 2"
  stacked <- stack_landscapes(landscapes, 2)
  expect_true(all(names(stacked) == c("l1", "l2")))
  expect_true(all.equal(r12, stacked[["l1"]]))
  expect_true(all.equal(r22, stacked[["l2"]]))
})


test_that("habitability_mask works" , {
  r1 <- raster(nrows = 5, ncols = 5, vals = runif(25))
  h1 <- runif(25) > 0.2
  r1[!h1] <- NA
  r2 <- raster(nrows = 5, ncols = 5, vals = runif(25))
  h2 <- runif(25) > 0.2
  r2[!h2] <- NA
  h <- raster(nrows = 5, ncols = 5, vals = runif(25) < 0.2)

  # get landscapes
  landscapes = list(l1 = list(r1), l2 = list(r2))
  landscape_stack <- stack_landscapes(landscapes , 1)

  # habitability mask
  mask1 <- get_habitable_mask(list(h), landscape_stack, 1)
  expect_true(all.equal(mask1, h))

  # calculate habitability mask
  mask2 <- get_habitable_mask(NULL, landscape_stack, 1)
  expect_true(all.equal(mask2[], h1 & h2))
})


test_that("compile_landscapes works", {  # create rasters
  r11 <- raster(nrows = 5, ncols = 5, vals = runif(25))
  r12 <- raster(nrows = 5, ncols = 5, vals = runif(25))
  r21 <- raster(nrows = 5, ncols = 5, vals = runif(25))
  r22 <- raster(nrows = 5, ncols = 5, vals = runif(25))

  landscapes = list(l1 = c(r11, r12) , l2 = c(r21, r22))
  timesteps <- c(1,2)

  compiled_landscapes <- compile_landscapes(landscapes = landscapes,
                                            timesteps = timesteps,
                                            habitability_masks = NULL)

  expect_true(all.equal(names(compiled_landscapes), c("l1", "l2")))
  expect_true(all.equal(colnames(compiled_landscapes[["l1"]]), c("x", "y",  timesteps)))
  expect_true(all.equal(colnames(compiled_landscapes[["l2"]]), c("x", "y",  timesteps)))
  expect_true(all.equal(r11, rasterFromXYZ(compiled_landscapes[["l1"]][, c("x", "y", 1)])))
  expect_true(all.equal(r12, rasterFromXYZ(compiled_landscapes[["l1"]][, c("x", "y", 2)])))
  expect_true(all.equal(r21, rasterFromXYZ(compiled_landscapes[["l2"]][, c("x", "y", 1)])))
  expect_true(all.equal(r22, rasterFromXYZ(compiled_landscapes[["l2"]][, c("x", "y", 2)])))
  expect_true(all.equal(rownames(compiled_landscapes[["l1"]]),
                        rownames(compiled_landscapes[["l2"]]),
                        as.character(1:25)))
})


test_that("get_local_distances works", {
  crs <- NULL
  directions <- 8
  d <- 5
  cost_function <- function(src, habitable_src, dest, habitable_dest){
    return(src[1])
  }

  r1 <- raster(nrows = d, ncols = d, vals = runif(d*d))
  r2 <- raster(nrows = d, ncols = d, vals = runif(d*d))

  landscapes = list(l1 = list(r1) , l2 = list(r2))
  timesteps <- c(1)

  landscape_stack <- stack_landscapes(landscapes, 1)
  habitable_mask <- get_habitable_mask(habitability_masks = NULL, landscape_stack, 1)

  distance_local <- get_local_distances(landscape_stack, habitable_mask, cost_function, directions, crs)

  tr <- transition(r1, function(x){1/x[1]}, 8, symm = FALSE)
  co <- geoCorrection(tr, "c", multpl = TRUE)

  # the gdistance transition is in transition[src, dest] format
  # for efficiency reasons the local distances are in distnace_local[dest, src] format
  # for the comparison we transpose the transistion matrix
  # we take the reciprocal of the transition amtrix as it contains conductance values
  # while we use cost/resistance values in the local distances
  local_tr <- t((tr*co)@transitionMatrix)
  local_tr@x <- 1 / local_tr@x

  # correct input is produced
  expect_true(isTRUE(all.equal(unname(distance_local), local_tr)))

  # check row/colnames
  expect_true(identical(rownames(distance_local), as.character(1:(d*d))))
  expect_true(identical(colnames(distance_local), as.character(1:(d*d))))
})