context("10-RapData") test_that("RapData", { # preliminary processing pu_coords <- suppressWarnings(sf::st_coordinates(sf::st_centroid(cs_pus))) attribute.spaces <- AttributeSpaces(list( AttributeSpace( planning.unit.points = PlanningUnitPoints(pu_coords[1:10, ], 1:10), demand.points = make.DemandPoints( randomPoints(cs_spp[[1]], n = 100, prob = TRUE) ), species = 1L )), name = "test_space" ) pu.species.probabilities <- calcSpeciesAverageInPus( cs_pus[1:10, ], cs_spp[[1]] ) polygons <- convert2PolySet(cs_pus[1:10, ]) boundary <- calcBoundaryData(cs_pus[1:10, ]) # create object x <- RapData( pu = cs_pus[1:10, ], species = data.frame(name = "spp1"), targets = data.frame(species = 1L, target = c(0L, 1L), proportion = 0.2), pu.species.probabilities = pu.species.probabilities, attribute.spaces = list(attribute.spaces), polygons = polygons, boundary = boundary ) # tests are implicit in the validity method when creating the object # execute basic methods x suppressMessages(print(x)) expect_true(methods::validObject(x, test = FALSE)) }) test_that("make.RapData (single species)", { # create object x <- make.RapData( cs_pus[1:10, ], cs_spp[[1]], cs_space, include.geographic.space = TRUE ) # check correct data is generated expect_equal(length(x@attribute.spaces), 2) expect_equal(x@attribute.spaces[[2]]@name, "geographic") expect_equal(length(x@attribute.spaces[[1]]@spaces), 1) for (i in seq_along(x@attribute.spaces[[1]]@spaces)) { expect_equal( nrow(x@attribute.spaces[[1]]@spaces[[i]]@demand.points@coords), 100 ) expect_equal( nrow(x@attribute.spaces[[1]]@spaces[[i]]@planning.unit.points@coords), 10 ) } expect_equal(nrow(x@targets), 3) expect_equal(x@targets$species, c(1L, 1L, 1L)) expect_equal(x@targets$target, 0:2) expect_equal(x@targets$proportion, c(0.2, 0.2, 0.2)) }) test_that("make.RapData (multiple species)", { # create RapUnsolved object set.seed(500) pus <- sim.pus(225L) spp <- lapply( c("uniform", "normal", "bimodal"), sim.species, n = 1, res = 1, x = pus ) expect_warning({ x <- make.RapData( pus, terra::rast(spp), NULL, include.geographic.space = TRUE, n.demand.points = 200L, amount.target = 0.1, space.target = -10 ) }) # check correct data is generated expect_equal(length(x@attribute.spaces), 1) expect_equal(x@attribute.spaces[[1]]@name, "geographic") for (i in seq_along(x@attribute.spaces)) { a <- x@attribute.spaces[[i]] expect_equal(length(a@spaces), 3) for (j in seq_along(a@spaces)) { b <- a@spaces[[j]] expect_equal(nrow(b@demand.points@coords), 200) expect_equal(nrow(b@planning.unit.points@coords), 225) } } expect_equal(nrow(x@targets), 6) expect_equal(x@targets$species, rep(1:3, 2)) expect_equal(x@targets$target, rep(0:1, each = 3)) expect_equal(x@targets$proportion, rep(c(0.1, -10), each = 3)) }) test_that("pu.subset.RapData", { # create RapUnsolved object set.seed(500) data(sim_ru) rd <- sim_ru@data rd2 <- pu.subset(rd, 21:30) # tests expect_equal(nrow(rd2@pu), 10) expect_true(all(rd2@pu.species.probabilities$pu %in% 1:10)) expect_true(all(rd2@boundary$id1 %in% 1:10)) expect_true(all(rd2@boundary$id2 %in% 1:10)) expect_true(all(rd2@polygons$PID %in% 1:10)) expect_equal( nrow(rd2@attribute.spaces[[1]]@spaces[[1]]@planning.unit.points@coords), 10 ) expect_equal( rd2@attribute.spaces[[1]]@spaces[[1]]@planning.unit.points@ids, 1:10 ) }) test_that("spp.subset.RapData", { # create RapUnsolved object data(sim_ru) rd <- sim_ru@data rd2 <- spp.subset(rd, 1) rd3 <- spp.subset(rd, "uniform") rd4 <- spp.subset(rd, 3) # tests expect_true(validObject(rd2, test = FALSE)) expect_equal(nrow(rd2@species), 1) expect_true(all(rd2@pu.species.probabilities$species == 1L)) expect_equal(length(rd2@attribute.spaces[[1]]@spaces), 1) expect_true(all(rd2@targets$species == 1L)) expect_equal(nrow(rd2@targets), 2) expect_equal( rd@attribute.spaces[[1]]@spaces[[1]]@planning.unit.points, rd2@attribute.spaces[[1]]@spaces[[1]]@planning.unit.points ) expect_equal( rd@attribute.spaces[[1]]@spaces[[1]]@demand.points, rd2@attribute.spaces[[1]]@spaces[[1]]@demand.points ) expect_true(validObject(rd3, test = FALSE)) expect_equal(nrow(rd3@species), 1) expect_true(all(rd3@pu.species.probabilities$species == 1L)) expect_equal(length(rd3@attribute.spaces[[1]]@spaces), 1) expect_true(all(rd3@targets$species == 1L)) expect_equal(nrow(rd3@targets), 2) expect_equal( rd@attribute.spaces[[1]]@spaces[[1]]@planning.unit.points, rd3@attribute.spaces[[1]]@spaces[[1]]@planning.unit.points ) expect_equal( rd@attribute.spaces[[1]]@spaces[[1]]@demand.points, rd3@attribute.spaces[[1]]@spaces[[1]]@demand.points ) expect_true(validObject(rd4, test = FALSE)) expect_equal(nrow(rd4@species), 1) expect_true(all(rd4@pu.species.probabilities$species == 1L)) expect_equal(length(rd4@attribute.spaces[[1]]@spaces), 1) expect_true(all(rd4@targets$species == 1L)) expect_equal(nrow(rd4@targets), 2) expect_equal( rd@attribute.spaces[[1]]@spaces[[3]]@planning.unit.points, rd4@attribute.spaces[[1]]@spaces[[1]]@planning.unit.points ) expect_equal( rd@attribute.spaces[[1]]@spaces[[3]]@demand.points, rd4@attribute.spaces[[1]]@spaces[[1]]@demand.points ) }) test_that("spp.subset.RapData (sparse occupancy)", { rd <- sim_ru@data curr_pos <- sample( seq_along(rd@attribute.spaces[[1]]@spaces[[1]]@planning.unit.points@ids), ceiling(nrow(rd@pu) * 0.7)) rd@attribute.spaces[[1]]@spaces[[1]] <- AttributeSpace( planning.unit.points = PlanningUnitPoints( coords = rd@attribute.spaces[[1]]@spaces[[1]]@planning.unit.points@ coords[curr_pos,, drop = FALSE], ids = rd@attribute.spaces[[1]]@spaces[[1]]@planning.unit.points@ ids[curr_pos] ), demand.points = rd@attribute.spaces[[1]]@spaces[[1]]@demand.points, species = rd@attribute.spaces[[1]]@spaces[[1]]@species ) rd2 <- spp.subset(rd, 2) # tests expect_true(validObject(rd2, test = FALSE)) expect_equal(nrow(rd2@species), 1) expect_true(all(rd2@pu.species.probabilities$species == 1L)) expect_equal(length(rd2@attribute.spaces[[1]]@spaces), 1) expect_true(all(rd2@targets$species == 1L)) expect_equal(nrow(rd2@targets), 2) expect_equal( rd@attribute.spaces[[1]]@spaces[[2]]@planning.unit.points, rd2@attribute.spaces[[1]]@spaces[[1]]@planning.unit.points ) expect_equal( rd@attribute.spaces[[1]]@spaces[[2]]@demand.points, rd2@attribute.spaces[[1]]@spaces[[1]]@demand.points ) }) test_that("dp.subset.RapData", { # create RapUnsolved object data(sim_ru) rd <- sim_ru@data rd2 <- dp.subset(rd, 1, 1, 1:10) # tests expect_equal( rd@attribute.spaces[[1]]@spaces[[1]]@demand.points@coords[1:10, ], rd2@attribute.spaces[[1]]@spaces[[1]]@demand.points@coords ) expect_equal( rd@attribute.spaces[[1]]@spaces[[1]]@demand.points@weights[1:10], rd2@attribute.spaces[[1]]@spaces[[1]]@demand.points@weights ) }) test_that("prob.subset.RapData", { # create RapUnsolved object data(sim_ru) rd <- sim_ru@data rd2 <- prob.subset(rd, 1:3, c(0.1, 0.2, 0.7)) # tests expect_true(all(rd2@pu.species.probabilities[[3]][ which(rd2@pu.species.probabilities[[1]] == 1)] > 0.1) ) expect_true(sum(rd2@pu.species.probabilities[[3]][ which(rd2@pu.species.probabilities[[1]] == 1)] < 0.7) > 1 ) expect_true(all(rd2@pu.species.probabilities[[3]][ which(rd2@pu.species.probabilities[[1]] == 2)] > 0.2) ) expect_true(sum(rd2@pu.species.probabilities[[3]][ which(rd2@pu.species.probabilities[[1]] == 2)] < 0.7) > 1 ) expect_true(all(rd2@pu.species.probabilities[[3]][ which(rd2@pu.species.probabilities[[1]] == 3)] > 0.7) ) }) test_that("update.RapData", { # generate objects data(sim_ru) x <- sim_ru@data y <- update( x, name = c("a", "b", "c"), amount.target = c(0.1, 0.2, 0.3), space.target = c(0.4, 0.5, 0.6) ) z <- update( y, species = 1, name = "a1", amount.target = 0.9, space.target = 0.8 ) # y tests expect_equal(y@species$name, c("a", "b", "c")) expect_equal( y@targets$proportion[which(y@targets$target == 0)], c(0.1, 0.2, 0.3) ) expect_equal( y@targets$proportion[which(y@targets$target == 1)], c(0.4, 0.5, 0.6) ) # z tests expect_equal(z@species$name, c("a1", "b", "c")) expect_equal( z@targets$proportion[which(z@targets$target == 0)], c(0.9, 0.2, 0.3) ) expect_equal( z@targets$proportion[which(z@targets$target == 1)], c(0.8, 0.5, 0.6) ) }) test_that("amount.target.RapData", { data(sim_ru) expect_equal(unname(amount.target(sim_ru@data)), rep(0.2, 3)) expect_equal(unname(amount.target(sim_ru@data, 1)), 0.2) }) test_that("amount.target<-.RapData", { data(sim_ru) sim_rd <- sim_ru@data amount.target(sim_rd) <- 0.3 expect_equal(unname(amount.target(sim_rd)), rep(0.3, 3)) amount.target(sim_rd, 1) <- 0.5 expect_equal(unname(amount.target(sim_rd)), c(0.5, 0.3, 0.3)) }) test_that("space.target.RapData", { data(sim_ru) expect_equal(unname(space.target(sim_ru@data)[, 1]), rep(0.85, 3)) expect_equal(unname(space.target(sim_ru@data, species = 1)[, 1]), 0.85) expect_equal(unname(space.target(sim_ru@data, space = 1)[, 1]), rep(0.85, 3)) expect_equal( unname(space.target(sim_ru@data, species = 1, space = 1)[, 1]), 0.85 ) }) test_that("space.target<-.RapData", { data(sim_ru) sim_rd <- sim_ru@data space.target(sim_rd) <- 0.3 expect_equal(unname(space.target(sim_rd)[, 1]), rep(0.3, 3)) space.target(sim_rd, 1) <- 0.5 expect_equal(unname(space.target(sim_rd)[, 1]), c(0.5, 0.3, 0.3)) }) test_that("names.RapData", { data(sim_ru) expect_equal(names(sim_ru@data), sim_ru@data@species$names) }) test_that("names<-.RapData", { data(sim_ru) sim_rd <- sim_ru@data names(sim_rd) <- c("spp1", "spp2", "spp3") expect_equal(names(sim_rd), c("spp1", "spp2", "spp3")) }) test_that("spp.plot.RapData", { data(sim_ru) spp.plot(sim_ru@data, 1) spp.plot(sim_ru@data, "uniform") expect_true(TRUE) }) test_that("space.plot.RapData", { data(sim_ru) space.plot(sim_ru@data, 1, 1) space.plot(sim_ru@data, "normal", 1) expect_true(TRUE) })