Add error message when the dimensions of custom terrain and generated…

… landscape don't match
dimitri-justeau · May 22, 2024 · 5172d1a · 5172d1a
1 parent 00bb49b
commit 5172d1a
Show file tree

Hide file tree

Showing 4 changed files with 74 additions and 2 deletions.
diff --git a/.github/workflows/R-CMD-check-macos.yaml b/.github/workflows/R-CMD-check-macos.yaml
@@ -94,7 +94,7 @@ jobs:
 
       - name: Check
         run: |
-          rcmdcheck::rcmdcheck(args = c("--no-manual", "--as-cran", "--no-build-vignettes"), error_on = "warning", check_dir = "check")
+          rcmdcheck::rcmdcheck(args = c("--no-manual", "--as-cran", "--no-build-vignettes", "--no-multiarch"), error_on = "warning", check_dir = "check")
         shell: Rscript {0}
 
       - name: Show testthat output

diff --git a/.github/workflows/R-CMD-check-ubuntu.yaml b/.github/workflows/R-CMD-check-ubuntu.yaml
@@ -103,7 +103,7 @@ jobs:
 
       - name: Check
         run: |
-          rcmdcheck::rcmdcheck(args = c("--no-manual", "--as-cran", "--no-build-vignettes"), error_on = "warning", check_dir = "check")
+          rcmdcheck::rcmdcheck(args = c("--no-manual", "--as-cran", "--no-build-vignettes", "--no-multiarch"), error_on = "warning", check_dir = "check")
         shell: Rscript {0}
 
       - name: Upload check results

diff --git a/R/flsgen_generate.R b/R/flsgen_generate.R
@@ -163,6 +163,10 @@ flsgen_generate <- function(structure_str, structure_file, terrain_file=NULL,
     if (!inherits(terrain_file, "SpatRaster")) {
       terrain_raster <- terra::rast(terrain_file)
     }
+    if (ncol(terrain_raster) != nb_cols || nrow(terrain_raster) != nb_rows) {
+      cat(paste(ncol(terrain_raster), nb_cols, " // ", nrow(terrain_raster), nb_rows), "\n")
+      stop("The dimensions of the terrain raster must match with the dimensions of the landscape to generate")
+    }
     terrain_data <- values(terrain_raster)
     .jcall(terrain, "V", "loadFromData", .jarray(as.double(as.vector(terrain_data))))
   }

diff --git a/tests/testthat/test-generate.R b/tests/testthat/test-generate.R
@@ -36,3 +36,71 @@ test_that("flsgen_generate", {
   landscapes <- flsgen_generate(structure[[1]], min_distance = 3, connectivity = 8)
   testthat::expect_s4_class(landscapes, class = "SpatRaster")
 })
+
+test_that("flsgen_generate_from_existing", {
+  path <- system.file("extdata",
+                      "copernicus_nc_grande_terre_closed_and_open_forests_200m.tif",
+                      package = "rflsgen")
+  existing_landscape <- rast(path)
+  struct <- flsgen_extract_structure_from_raster(path, c(0, 1),
+                                                 connectivity = 8)
+  dem_path <- system.file("extdata",
+                          "dem_nc_grande_terre_200m.tif",
+                          package = "rflsgen")
+  r <- flsgen_generate(struct, terrain_file = dem_path, terrain_dependency = 0.9,
+                       epsg = "EPSG:3163", connectivity=8,
+                       resolution_x = 105.4308639672429422,
+                       resolution_y = 105.4037645741556588,
+                       x = 159615, y = 467655)
+  testthat::expect_s4_class(r, class = "SpatRaster")
+  dem <- rast(dem_path)
+  values(dem) <- -values(dem)
+  r <- flsgen_generate(struct, terrain_file = dem, terrain_dependency = 0.9,
+                       epsg = "EPSG:3163", connectivity=8,
+                       resolution_x = 105.4308639672429422,
+                       resolution_y = 105.4037645741556588,
+                       x = 159615, y = 467655)
+  testthat::expect_s4_class(r, class = "SpatRaster")
+})
+
+test_that("flsgen_generate_from_existing_wrong_dimensions", {
+  path <- system.file("extdata",
+                      "copernicus_nc_grande_terre_closed_and_open_forests_200m.tif",
+                      package = "rflsgen")
+  json <- "{
+    \"nbRows\" : 200,
+    \"nbCols\" : 200,
+    \"classes\" : [
+      {
+        \"name\" : \"Class A\",
+        \"NP\" : [1, 10],
+        \"AREA\" : [300, 4000],
+        \"CA\" : [1000, 5000],
+        \"MESH\" : [225, 225]
+      },
+      {
+        \"name\" : \"Class B\",
+        \"NP\" : [2, 8],
+        \"AREA\" : [200, 4000],
+        \"PLAND\" : [40, 40]
+      },
+      {
+        \"name\" : \"Class C\",
+        \"NP\" : [5, 7],
+        \"AREA\" : [800, 1200]
+      }
+    ]
+  }"
+  structure <- rflsgen::flsgen_structure(targets_str = json, nb_solutions = 1)
+  dem_path <- system.file("extdata",
+                          "dem_nc_grande_terre_200m.tif",
+                          package = "rflsgen")
+  testthat::expect_error(
+    r <- flsgen_generate(struct, terrain_file = dem_path, terrain_dependency = 0.9,
+                         epsg = "EPSG:3163", connectivity=8,
+                         resolution_x = 105.4308639672429422,
+                         resolution_y = 105.4037645741556588,
+                         x = 159615, y = 467655)
+  )
+})
+