tests/testthat/test-projectRoads.R

In LandSciTech/roads: Road Network Projection

# options:
## ROADS
# 0/1 raster
# 0 < raster
# sp lines
# sf lines
## COST
# raster with 0 for existing roads
# raster with no zeros
## LANDINGS
# raster (currently only 1 layer allowed)
# clumped raster
# sp points
# sp polygons
# sf points
# sf polygons
demoScen <- prepExData(demoScen)
scen <- demoScen[[1]]
doPlot <- interactive()
test_that("cost and road options work", {
  
  # 0/1 raster
  out <- projectRoads(scen$landings.points, scen$cost.rast,
               scen$road.rast, plotRoads = doPlot)
  
  expect_s4_class(out$roads, "SpatRaster")
  
  # 0< raster 
  roadInt <- scen$road.rast
  roadInt[roadInt == 1] <- 1:nrow(roadInt[roadInt == 1])
  
  costNo0 <- scen$cost.rast
  costNo0[costNo0 == 0] <- 10
  
  projectRoads(scen$landings.points, scen$cost.rast,
               roadInt, plotRoads = doPlot)
  
  # try with no 0 in cost in case that compensated for roads
  expect_warning(projectRoads(scen$landings.points, costNo0,
                              roadInt, plotRoads = doPlot),
                 "No 0s detected")
  
  # all input roads should be included in output
  out2 <- projectRoads(scen$landings.points, costNo0,
               roadInt, plotRoads = doPlot, roadsInWeight = FALSE)
  
  inrd <- terra::cells(terra::rast(roadInt), 1:100)
  
  expect_true(all(terra::extract(out2$roads, inrd[[1]])[1] == 1))
  
  # sp lines
  out2 <- projectRoads(scen$landings.points, scen$cost.rast,
               scen$road.line %>% sf::as_Spatial(), plotRoads = doPlot)
  expect_s3_class(out2$roads, "sf")
  
  # sf lines
  projectRoads(scen$landings.points, scen$cost.rast,
               scen$road.line, plotRoads = doPlot)
  
  # burn in roads as 0 when cost raster has no 0
  expect_message(projectRoads(scen$landings.points, costNo0,
                              scen$road.line, plotRoads = doPlot, 
                              roadsInWeight = FALSE),
                 "Burning in roads")
})

test_that("landings options work", {
  # raster (currently only 1 layer allowed)
  projectRoads(scen$landings.stack[[1]], scen$cost.rast,
               scen$road.line, plotRoads = doPlot)
  
  expect_error(projectRoads(scen$landings.stack, scen$cost.rast,
                            scen$road.line, plotRoads = doPlot),
               "single layer")
  
  # clumped raster
  projectRoads(terra::rasterize(scen$landings.poly, scen$cost.rast), 
               scen$cost.rast,
               scen$road.line, plotRoads = doPlot)
  
  # sp points
  projectRoads(scen$landings.points %>% sf::as_Spatial(), scen$cost.rast,
               scen$road.line, plotRoads = doPlot)
  
  # sp polygons
  projectRoads(scen$landings.poly, scen$cost.rast,
               scen$road.line, plotRoads = doPlot)

  # sf points
  projectRoads(scen$landings.points, scen$cost.rast,
               scen$road.line, plotRoads = doPlot)
  
  # sf polygons
  projectRoads(scen$landings.poly, scen$cost.rast,
               scen$road.line, plotRoads = doPlot)
  
  # matrix
  projectRoads(sf::st_coordinates(scen$landings.poly), scen$cost.rast,
               scen$road.line, plotRoads = doPlot)
})

test_that("sim list input works", {
  simList <- projectRoads(scen$landings.poly, scen$cost.rast,
                          scen$road.line, plotRoads = doPlot)
  lnd2 <- scen$landings.points %>% filter(set == 2)
  expect_type(projectRoads(sim = simList, landings = lnd2, plotRoads = doPlot), 
              "list")
  
})

test_that("input types are tested", {
  expect_error(projectRoads("string", scen$cost.rast,
               scen$road.line, plotRoads = doPlot),
               "must be either")
  expect_error(projectRoads(scen$landings.points, "sting",
                            scen$road.line, plotRoads = doPlot),
               "must be .* RasterLayer")
  expect_error(projectRoads(scen$landings.points, scen$cost.rast,
                            "string", plotRoads = doPlot),
               "must be either")
})

test_that("duplicate roads are not created", {
  res <- projectRoads(scen$landings.points, scen$cost.rast,
                      scen$road.line, plotRoads = doPlot, roadsInWeight = FALSE)
  
  #useful to visualize need to load fun from RoadsPaper
  # dens <- res$roads %>% rasterizeLineDensity(r = res$weightRaster)
  
  res_mst <- projectRoads(scen$landings.points, scen$cost.rast,
                      scen$road.line, plotRoads = doPlot, roadMethod = "mst")
  
  # dens_mst <- res_mst$roads %>% rasterizeLineDensity(r = res_mst$weightRaster)
  
  expect_equal(sf::st_union(res$roads) %>% sf::st_length(), sf::st_length(res$roads) %>% sum())
  
  # expect_equal(sf::st_union(res_mst$roads) %>% sf::st_length(), sf::st_length(res_mst$roads) %>% sum())
  # # draw extent to get problem tiny line created
  # plot(scen$cost.rast)
  # plot(scen$landings.points, add = TRUE)
  # ext <- terra::draw()
  # 
  # lnds <- sf::st_crop(scen$landings.points, ext)
  # cst <- terra::crop(scen$cost.rast, ext)
  # rds <- sf::st_crop(scen$road.line, ext)
  # 
  # projectRoads(lnds, cst, rds, plotRoads = doPlot, roadsInWeight = FALSE)
  
})

test_that("landings on road or multiple landings in same cell work", {
  CLUSexample <- prepExData(CLUSexample)
  
  CLUSexample$landings <- bind_rows(CLUSexample$landings, 
                                    list(sf::st_point(c(1.5, 4.2)), sf::st_point(c(1.5, 0.6))) %>% 
                                      sf::st_as_sfc() %>%
                                      sf::st_as_sf(crs = sf::st_crs(CLUSexample$landings)) %>%
                                      rename(geometry = x))
  expect_type(
    projectRoads(CLUSexample$landings, CLUSexample$cost, CLUSexample$roads, 
                 roadMethod = "mst"),
    "list")
  
  
})

test_that("Works with GEOMETRY input", {
  lndPoly <- demoScen[[1]]$landings.poly %>% sf::st_as_sf() %>% 
    sf::st_set_agr("constant")
  lndPoly[6, 2] <- lndPoly[6, 2] %>% sf::st_cast("MULTIPOLYGON")
  expect_type(projectRoads(lndPoly, scen$cost.rast, scen$road.line), "list")
})


if(FALSE){
  # checking memory allocations
  bm1 <- bench::mark(projectRoads(scen$landings.points, scen$cost.rast,
                                  scen$road.line, plotRoads = doPlot))
  
  # change sim to an env
  bm2 <- bench::mark(projectRoads(scen$landings.points, scen$cost.rast,
                                  scen$road.line, plotRoads = doPlot))
  
  # look at top memory allocs
  bm1$memory[[1]] %>% as.data.frame() %>% slice_max(bytes, n = 5)
  bm2$memory[[1]] %>% as.data.frame() %>% slice_max(bytes, n = 5)
  
  # was able to reduce so only copies graph once in each iteration of iterativeShortestPAth
  
}