closes #26 issue when landings contain mixture of polygons and multip…

…olygons
LandSciTech · Jun 26, 2024 · 8c97acd · 8c97acd
1 parent 2fb52ba
commit 8c97acd
Show file tree

Hide file tree

Showing 4 changed files with 30 additions and 4 deletions.
diff --git a/R/buildSimList.R b/R/buildSimList.R
@@ -105,8 +105,8 @@ buildSimList <- function(roads, weightRaster, roadMethod, landings, roadsInWeigh
     }
   }
 
-  if(sf::st_geometry_type(landings, by_geometry = FALSE) %in% 
-     c("POLYGON", "MULTIPOLYGON")){
+  if(all(sf::st_geometry_type(landings, by_geometry = TRUE) %in% 
+     c("POLYGON", "MULTIPOLYGON"))){
     # Use point on surface not centroid to ensure point is inside irregular polygons
     landings <- sf::st_point_on_surface(sf::st_set_agr(landings, "constant")) %>% 
       sf::st_set_agr("constant")

diff --git a/R/getLandingsFromTarget.R b/R/getLandingsFromTarget.R
@@ -159,8 +159,8 @@ getLandingsFromTarget <- function(harvest,
 
     }
   }
-  if(sf::st_geometry_type(harvest, by_geometry = FALSE) %in%
-     c("POLYGON", "MULTIPOLYGON")){
+  if(all(sf::st_geometry_type(harvest, by_geometry = TRUE) %in%
+     c("POLYGON", "MULTIPOLYGON"))){
     if(sampleType == "centroid"){
       # Use point on surface not centroid to ensure point is inside irregular
       # polygons
@@ -203,6 +203,9 @@ getLandingsFromTarget <- function(harvest,
       return(sf::st_sf(landings))
     }
 
+  } else {
+    stop("harvest contains geometries other than POLYGON and MULTIPOLYGON.",
+         "\nPlease supply only polygons")
   }
 }
 

diff --git a/tests/testthat/test-getLandingsFromTarget.R b/tests/testthat/test-getLandingsFromTarget.R
@@ -144,3 +144,18 @@ test_that("raster with clumps input works with ID",{
 
 })
 
+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")
+})
diff --git a/tests/testthat/test-projectRoads.R b/tests/testthat/test-projectRoads.R
@@ -164,6 +164,14 @@ test_that("landings on road or multiple landings in same cell work", {
 
 })
 
+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,