Unit test work wihtout sp and raster

NEWS.md

@@ -4,6 +4,8 @@ If you are viewing this file on CRAN, please check [the latest news on GitHub](h
 
 Fix: `readLAScatalog()` was not working if package `raster` was not installed.
 Fix: regression of the `stars` package makes `rasterize_terrain()` extremely slow and blow up the RAM memory
+New: `catalog_intersects()` support a `SpatExtent`
+Fix: `lidR` can fully works without `raster` ans `sp`
 
 ## lidR v4.1.0 (Release date: 2024-01-31)
 

R/catalog_intersect.R

@@ -15,6 +15,12 @@ catalog_intersect = function(ctg, y, ..., subset = c("subset", "flag_unprocessed
     sf::st_crs(y) <- st_crs(ctg)
   }
 
+  if (is(y, "SpatExtent"))
+  {
+    y <- sf::st_bbox(y)
+    sf::st_crs(y) <- st_crs(ctg)
+  }
+
   if (is_raster(y))
     y <- raster_bbox(y)
 

R/generate_las.R

@@ -20,7 +20,7 @@ generate_las <- function(n, seeds = 1) {
   header[["Y offset"]] <- 0
   header[["Z offset"]] <- 0
   las <- suppressMessages(suppressWarnings(LAS(data, header, check = FALSE)))
-  projection(las) <- 26917
+  st_crs(las) <- 26917
   return(las)
 }
 

R/locate_localmaxima.R

@@ -41,7 +41,7 @@ locate_localmaxima = function(las, w, filter = NULL)
 
   if (no_maxima) maxima <- las@data[1,]
 
-  output <- sf::st_as_sf(maxima, coords = c("X", "Y"), crs = sf::st_crs(lidR::crs(las)))
+  output <- sf::st_as_sf(maxima, coords = c("X", "Y"), crs = sf::st_crs(las))
 
   if (no_maxima) output <- output[0,]
 

R/rasterize_terrain.R

@@ -61,12 +61,12 @@ rasterize_terrain.LAS = function(las, res = 1, algorithm = tin(), use_class = c(
     else
       hull <- st_convex_hull(las)
 
-    shape <- sf::st_buffer(hull, dist = raster_res(layout)[1])
+    shape <- sf::st_buffer(hull, dist = raster_res(layout)[1]/2)
   }
 
   if (is(shape, "sfc"))
   {
-    shape = terra::vect(shape)
+    shape <- terra::vect(shape)
     layout <- terra::mask(layout, shape)
   }
 

R/st_crs.R

@@ -114,11 +114,11 @@ NULL
   x <- las_v3_repair(x)
 
   all   <- all_crs_formats(value)
-  CRS   <- all[["CRS"]]
+  #CRS   <- all[["CRS"]]
   crs   <- all[["crs"]]
   wkt   <- all[["wkt"]]
   epsg  <- all[["epsg"]]
-  proj4 <- all[["proj4"]]
+  #proj4 <- all[["proj4"]]
 
   if (is.na(crs)) stop("Invalid CRS as input", call. = FALSE)
 
@@ -386,36 +386,37 @@ all_crs_formats = function(value)
 
   if (is(value, "CRS"))
   {
-    proj4 <- value@projargs
-    CRS <- as(crs, "CRS")
+    #proj4 <- value@projargs
+    #CRS <- as(crs, "CRS")
     wkt <- crs$wkt
     epsg <- crs$epsg
   }
   else if (is(value, "crs"))
   {
     wkt <- value$wkt
-    CRS <- as(value, "CRS")
-    proj4 <- CRS@projargs
+    #CRS <- as(value, "CRS")
+    #proj4 <- CRS@projargs
     epsg <- crs$epsg
   }
   else if (is.character(value))
   {
-    CRS <- as(crs, "CRS")
-    proj4 <- CRS@projargs
+    #CRS <- as(crs, "CRS")
+    #proj4 <- CRS@projargs
     wkt <- crs$wkt
     epsg <- crs$epsg
   }
   else if (is.numeric(value))
   {
     epsg <- value
-    CRS <- as(crs, "CRS")
-    proj4 <- CRS@projargs
+    #CRS <- as(crs, "CRS")
+    #proj4 <- CRS@projargs
     wkt <- crs$wkt
   }
   else
     stop("'value' is not a CRS, a crs or a string or a number.", call. = FALSE)
 
-  return(list(epsg = epsg, CRS = CRS, crs = crs, proj4 = proj4, wkt = wkt))
+  return(list(epsg = epsg, crs = crs, wkt = wkt))
+  #return(list(epsg = epsg, CRS = CRS, crs = crs, proj4 = proj4, wkt = wkt))
 }
 
 epsg2crs <- function(epsg, fail = FALSE)

R/utils_raster.R

@@ -326,7 +326,7 @@ raster_is_supported <- function(raster)
 raster_build_vrt = function(file_list, vrt)
 {
   file_list <- unlist(file_list)
-  layers    <- names(raster::stack(file_list[1]))
+  layers    <- names(terra::rast(file_list[1]))
   folder    <- dirname(file_list[1])
   file      <- paste0("/", vrt, ".vrt")
   vrt       <- paste0(folder, file)

tests/testthat/test-LAS.R

@@ -242,6 +242,7 @@ test_that("LAS operator[[ and $ throw error for not storable coordinates", {
 
 
 test_that("LAS conversion to SpatialPointsDataFrame works", {
+  skip_if_not_installed("sp")
   las <- random_10_points
   splas <- as.spatial(las)
 

tests/testthat/test-LAScatalog.R

@@ -24,7 +24,7 @@ test_that("LAScatalog redefined behavior of $, [, and [[", {
 })
 
 test_that("LAScatalog conversion to SpatialPolygonsDataFrame works", {
-
+  skip_if_not_installed("sp")
   spctg <- as.spatial(ctg)
 
   expect_true(is(spctg, "SpatialPolygonsDataFrame"))

tests/testthat/test-apply_automerge.R

@@ -76,6 +76,8 @@ terratest <- function(cluster, DataFrame = FALSE) {
 expected_bbox <- sf::st_bbox(c(xmin = 0,xmax = 100, ymin =  0, ymax = 200))
 
 test_that("catalog_apply automerge works with in memory RasterLayer", {
+  skip_if_not_installed("raster")
+
   # No automerge option
   req1 <- catalog_apply(ctg, rtest)
 
@@ -93,7 +95,7 @@ test_that("catalog_apply automerge works with in memory RasterLayer", {
 })
 
 test_that("catalog_apply automerge works with in memory RastersBrick", {
-
+  skip_if_not_installed("raster")
   skip_on_cran()
 
   # No automerge option
@@ -112,6 +114,7 @@ test_that("catalog_apply automerge works with in memory RastersBrick", {
 })
 
 test_that("catalog_apply automerge works with on disk rasters as Raster* (VRT)", {
+    skip_if_not_installed("raster")
 
     opt_output_files(ctg) <- paste0(tempdir(), "/{ORIGINALFILENAME}_{lidR:::uuid()}")
     option <- list(automerge = T)
@@ -156,7 +159,7 @@ test_that("catalog_apply automerge works with on disk rasters as stars (VRT)", {
 })
 
 test_that("catalog_apply automerge works with in memory SpatialPoints*", {
-
+  skip_if_not_installed("sp")
   skip_on_cran()
 
   option <- list(automerge = TRUE)
@@ -176,6 +179,7 @@ test_that("catalog_apply automerge works with in memory SpatialPoints*", {
 
 test_that("catalog_apply automerge works with on disk SpatialPoints*", {
 
+  skip_if_not_installed("sp")
   skip_on_cran()
 
   opt_output_files(ctg) <- paste0(tempdir(), "/{ORIGINALFILENAME}_{lidR:::uuid()}")
@@ -312,6 +316,7 @@ test_that("catalog_apply automerge does not fail with unsupported objects output
 
 test_that("catalog_sapply is the same than apply with automerge", {
 
+  skip_if_not_installed("raster")
   skip_on_cran()
 
   option <- list(automerge = FALSE)
@@ -326,6 +331,7 @@ test_that("catalog_sapply is the same than apply with automerge", {
 
 test_that("catalog_apply automerge disabled with opt_merge = FALSE", {
 
+  skip_if_not_installed("raster")
   skip_on_cran()
 
   opt_merge(ctg) <- FALSE

tests/testthat/test-apply_autoread.R

@@ -6,8 +6,7 @@ test_that("catalog_apply autoread works", {
   opt_progress(ctg) = FALSE
 
   test <- function(las, bbox, layers = 1L) {
-    sp <- as.spatial(las[1:10])
-    sf <- sf::st_as_sf(sp)
+    sf <- sf::st_as_sf(las[1:10])
     sf::st_agr(sf) <- "constant"
     sp <- sf::st_crop(sf, bbox)
     return(sp)

tests/testthat/test-apply_generic.R

@@ -68,7 +68,7 @@ test_that("catalog_apply fixes chunk alignment even by file", {
   {
     las <- readLAS(cluster)
     if (is.empty(las)) return(NULL)
-    r = grid_metrics(las, ~max(Z), res, align)
+    r = pixel_metrics(las, ~max(Z), res, align)
     return(r)
   }
 
@@ -79,7 +79,7 @@ test_that("catalog_apply fixes chunk alignment even by file", {
   las = readLAS(ctg)
 
   # Reference
-  R0 = grid_metrics(las, ~max(Z), res = res, start = sta)
+  R0 = pixel_metrics(las, ~max(Z), res = res, start = sta)
 
   # Without option
   R1 <- catalog_sapply(ctg, test, res = res, align = sta)

tests/testthat/test-apply_independent.R

@@ -16,8 +16,8 @@ test_that("opt_independent_files built several DTMs without error", {
   opt_merge(ctg) <- FALSE
   opt_output_files(ctg) <- ""
 
-  dtms = grid_terrain(ctg, 1, tin())
+  dtms = rasterize_terrain(ctg, 1, tin())
 
   expect_true(is.list(dtms))
-  expect_true(is(dtms[[1]], "RasterLayer"))
+  expect_true(is(dtms[[1]], "SpatRaster"))
 })

tests/testthat/test-apply_restart.R

@@ -18,7 +18,7 @@ test_that("catalog drops some chunk", {
 test_that("catalog engine returns a valid output", {
 
   ctg@chunk_options$drop = 1:3
-  m = grid_metrics(ctg, ~mean(Z), 20)
+  m = pixel_metrics(ctg, ~mean(Z), 20)
 
   expect_equivalent(st_bbox(m), st_bbox(c(xmin = 0, xmax = 100,ymin = 60,ymax = 200)))
   expect_equal(sum(is.na(m[])), 9)

tests/testthat/test-catalog_intersect.R

@@ -54,8 +54,8 @@ polygon <- sf::st_geometry(polygon)
 polygon <- sf::st_set_crs(polygon, st_crs(ctg))
 
 # Build a Raster
-r <- raster::raster(raster::extent(sf::st_bbox(polygon)))
-projection(r) <- projection(ctg)
+r <- terra::rast(terra::ext(sf::st_bbox(polygon)))
+terra::crs(r) <- st_crs(ctg)$wkt
 
 # Build a SpatialPoints
 pts <- structure(
@@ -81,7 +81,7 @@ test_that("catalog_intersect extract the tiles that lie in a SpatialPolygons", {
 test_that("catalog_intersect extracts the tiles that lie in the bbox of a Raster", {
 
   ctg2 <- suppressWarnings(catalog_intersect(ctg, r))
-  ctg22 <- suppressWarnings(catalog_intersect(ctg, raster::extent(r)))
+  ctg22 <- suppressWarnings(catalog_intersect(ctg, terra::ext(r)))
 
   expect_equal(ctg2$filename, c("abc11", "abc12", "abc15", "abc17", "abc18", "abc19", "abc20", "abc21", "abc23"))
   expect_equal(ctg2, ctg22)

tests/testthat/test-clip.R

@@ -93,6 +93,8 @@ test_that("clip_roi clips multipolygon with hole", {
 
 test_that("clip_roi clips polygon works from sp polygons both on a LAS and LAScatalog", {
 
+  skip_if_not_installed("sp")
+
   wkt1 <- "MULTIPOLYGON (((339010.5 5248000, 339012 5248000, 339010.5 5248002, 339010.5 5248000)), ((339008 5248000, 339010 5248000, 339010 5248002, 339008 5248000), (339008.5 5248000.2, 339009.5 5248000.2, 339009.5 5248001, 339008.5 5248000.2)))"
   wkt2 <- "POLYGON ((339008 5248000, 339010 5248000, 339010 5248002, 339008 5248000))"
 
@@ -121,16 +123,16 @@ test_that("clip_roi clips point with SpatialPoints and sfc on LAS and LAScatalog
   p <- sf::st_as_sf(xy, coords = c("X", "Y"))
   p <- sf::st_geometry(p)
 
-  discs1 <- clip_roi(las, sf::as_Spatial(p), radius = r)
+  #discs1 <- clip_roi(las, sf::as_Spatial(p), radius = r)
   discs2 <- clip_roi(las, p, radius = r)
   discs3 <- clip_roi(ctg, p, radius = r)
   discs4 <- clip_roi(ctg, p, radius = c(r,2))
 
-  expect_is(discs1, "list")
-  expect_equal(length(discs1), 2L)
-  expect_equal(discs1, discs2)
-  expect_equal(discs1, discs3)
-  expect_equal(discs1, discs4)
+  expect_is(discs2, "list")
+  expect_equal(length(discs2), 2L)
+  #expect_equal(discs1, discs2)
+  expect_equal(discs2, discs3)
+  expect_equal(discs2, discs4)
 })
 
 test_that("clip_transect clips a transect on LAS and LAScatalog", {

tests/testthat/test-decimate_points.R

@@ -5,21 +5,21 @@ ctg = megaplot_ctg
 
 test_that("decimate_points homogenize algorithm works", {
   lasdec = decimate_points(las, homogenize(0.5,5))
-  xdec = grid_density(lasdec, res = 5)
+  xdec = rasterize_density(lasdec, res = 5)
 
   expect_true(data.table::between(median(xdec[], na.rm = TRUE), 0.5-sd(xdec[], na.rm = TRUE), 0.5+sd(xdec[], na.rm = TRUE) ))
 })
 
 test_that("decimate_points random algorithm works", {
   lasdec = decimate_points(las, random(0.5))
-  xdec = grid_density(lasdec, res = 5)
+  xdec = rasterize_density(lasdec, res = 5)
 
   expect_true(data.table::between(median(xdec[], na.rm = TRUE), 0.5-sd(xdec[], na.rm = TRUE), 0.5+sd(xdec[], na.rm = TRUE) ))
 })
 
 test_that("decimate_points highest algorithm works", {
   lasdec = decimate_points(las, highest(2))
-  xdec = grid_density(lasdec, res = 5)
+  xdec = rasterize_density(lasdec, res = 5)
   zmean = mean(lasdec$Z)
 
   expect_true(data.table::between(median(xdec[], na.rm = TRUE), 0.23, 0.25))
@@ -28,7 +28,7 @@ test_that("decimate_points highest algorithm works", {
 
 test_that("decimate_points lowest algorithm works", {
   lasdec = decimate_points(las, lowest(2))
-  xdec = grid_density(lasdec, res = 5)
+  xdec = rasterize_density(lasdec, res = 5)
   zmean = mean(lasdec$Z)
 
   expect_true(data.table::between(median(xdec[], na.rm = TRUE), 0.23, 0.25))
@@ -49,3 +49,4 @@ test_that("decimate_points works with a LAScatalog", {
   expect_is(ctg2, "LAScatalog")
   expect_gt(npoints(ctg), npoints(ctg2))
 })
+

tests/testthat/test-locate_trees.R

@@ -27,6 +27,7 @@ test_that("locate_trees LMF works with a LAS", {
 })
 
 test_that("find_trees is backward compatible", {
+  skip_if_not_installed("sp")
 
   ttops = find_trees(las, lmf(5))
 
@@ -46,7 +47,7 @@ test_that("find_trees is backward compatible", {
 
 
 test_that("locate_trees LMF works with a RasterLayer ", {
-
+  skip_if_not_installed("raster")
   chm = grid_canopy(las, 1, p2r(0.15))
 
   ttops = locate_trees(chm, lmf(5))
@@ -107,3 +108,4 @@ test_that("locate_trees supports different unicity strategies", {
   expect_true(is.double(ttops$treeID))
   expect_equal(mean(ttops$treeID), 2.067186e17, tolerance = 1e-5)
 })
+