# test getLandingsFromTarget works for different scenarios demoScen <- prepExData(demoScen) lndsDenTest <- list(1, 0.5, 0.25, 0.1, 0.01, 0.001) lndPoly <- demoScen[[1]]$landings.poly %>% sf::st_as_sf() %>% sf::st_set_agr("constant") test_that("sf input polygons work", { # replicate because some errors only happened with specific samples outsReg <- replicate(20, {lapply(lndsDenTest, function(x){ getLandingsFromTarget(lndPoly, landingDens = x, sampleType = "regular") }) }, simplify = FALSE) expect_type(outsReg, "list") if(interactive()){ plot(lndPoly %>% sf::st_geometry()) plot(outsReg[[1]][[4]], col = "red", add = T) } }) test_that("sf input polygons work for random", { # replicate because some errors only happened with specific samples outsRand <- replicate(20, {lapply(lndsDenTest, function(x){ getLandingsFromTarget(lndPoly, landingDens = x, sampleType = "random") }) }, simplify = FALSE) expect_type(outsRand, "list") if(interactive()){ plot(lndPoly %>% sf::st_geometry()) plot(outsRand[[1]][[4]], col = "red", add = T) } }) test_that("sf polygon input works for centroid",{ outCent <- getLandingsFromTarget(demoScen[[1]]$landings.poly %>% sf::st_set_agr("constant")) expect_type(outCent, "list") if(interactive()){ plot(sf::st_geometry(demoScen[[1]]$landings.poly)) plot(outCent, col = "red", add = T) } }) test_that("raster no clumps input works",{ outRast1 <- getLandingsFromTarget(demoScen[[1]]$landings.stack[[1]]) expect_warning(getLandingsFromTarget(demoScen[[1]]$landings.stack[[1]], 0.5, sampleType = "regular"), "landingDens is ignored") if(interactive()){ plot(sf::st_geometry(demoScen[[1]]$landings.stack[[1]])) plot(outRast1, col = "red", add = T) } }) test_that("raster with clumps input works no ID",{ rast <- demoScen[[1]]$landings.poly %>% terra::rasterize(demoScen[[1]]$cost.rast) %>% terra::`crs<-`(value = "EPSG:5070") # make sure that a single celled harvest block will work with clumps rast[10,10] <- 6 # Show effect of ID rast[78:88, 4:5] <- 7 outRastCent <- getLandingsFromTarget(rast > 0) outRastRand <- getLandingsFromTarget(rast > 0, landingDens = 0.1, sampleType = "random") outRastReg <- getLandingsFromTarget(rast > 0, landingDens = 0.1, sampleType = "regular") expect_type(outRastCent, "list") if(interactive()){ terra::plot(rast) plot(outRastCent, col = "red", add = T) terra::plot(rast) plot(outRastRand, col = "red", add = T) terra::plot(rast) plot(outRastReg, col = "red", add = T) } }) test_that("raster with clumps input works with ID",{ rst <- demoScen[[1]]$landings.poly %>% terra::vect() %>% terra::rasterize(demoScen[[1]]$cost.rast, field = "ID") %>% terra::`crs<-`(value = "EPSG:5070") # make sure that a single celled harvest block will work with clumps rst[10,10] <- 20 # Show effect of ID and check for ID not sequential rst[78:88, 4:5] <- 30 rst[is.na(rst)] <- 0 outRastCent <- getLandingsFromTarget(rst) outRastRand <- getLandingsFromTarget(rst, landingDens = 0.1, sampleType = "random") outRastReg <- getLandingsFromTarget(rst, landingDens = 0.1, sampleType = "regular") land_vals <- terra::extract(rst, terra::vect(outRastCent), ID = FALSE) %>% pull(ID) # all unique raster values represented in landings expect_length(setdiff(land_vals, terra::unique(rst) %>% pull(ID)), 0) expect_type(outRastCent, "list") if(interactive()){ terra::plot(rast) plot(outRastCent, col = "red", add = T) terra::plot(rast) plot(outRastRand, col = "red", add = T) terra::plot(rast) plot(outRastReg, col = "red", add = T) } # compare to supplying raster to projectRoads prRastCent <- projectRoads(rst, demoScen[[1]]$cost.rast, demoScen[[1]]$road.line) expect_equal(prRastCent$landings, outRastCent) }) test_that("Works with GEOMETRY input", { lndPoly[6, 2] <- lndPoly[6, 2] %>% sf::st_cast("MULTIPOLYGON") outCent <- getLandingsFromTarget(lndPoly) expect_type(outCent, "list") outRand <- getLandingsFromTarget(lndPoly, sampleType = "random", landingDens = 0.00001) expect_type(outRand, "list") outReg <- getLandingsFromTarget(lndPoly, sampleType = "regular", landingDens = 0.00001) expect_type(outReg, "list") })