tests/testthat/test-merges_spatial.R

In lidR: Airborne LiDAR Data Manipulation and Visualization for Forestry Applications

context("merge_spatial")

las     <- decimate_points(megaplot, highest(7))
sflakes <- sf::st_read(system.file("extdata", "", package="lidR"), "lake_polygons_UTM17", quiet = TRUE)
sf::st_agr(sflakes) <- "constant"
sflakes <- sf::st_crop(sflakes, st_bbox(las))
sflakes$ID <- 1L

zmean   <- pixel_metrics(las, ~mean(Z))
rgb     <- stars::st_as_stars(st_bbox(las), dx = 10, dy = 10, nz = 3L, values = runif(300, 0, 255))
rgbi    <- stars::st_as_stars(st_bbox(las), dx = 20, dy = 20, nz = 4L, values = 10)

test_that("merge_spatial works with SpatialPolygonsDataFrame", {

  skip_if_not_installed("sp")
  splakes <- sf::as_Spatial(sflakes)

  las <- merge_spatial(las, splakes, "inlakes")
  cn <- names(las)

  expect_true("inlakes" %in% cn)
  expect_true(is.logical(las$inlakes))
  expect_equivalent(as.numeric(table(las$inlakes)), c(966, 216))

  las <- merge_spatial(las, splakes, "LAKENAME_1")
  cn <- names(las)

  expect_true("LAKENAME_1" %in% cn)
  expect_equal(typeof(las$LAKENAME_1), typeof(splakes$LAKENAME_1))
  expect_equivalent(as.numeric(table(las$LAKENAME_1)), c(216))

  las <- merge_spatial(las, splakes)
  cn <- names(las)

  expect_true("id" %in% cn)
  expect_true(is.integer(las$id))
  expect_equivalent(as.numeric(table(las$id)), c(216))
})

test_that("merge_spatial works with sf", {

  las <- merge_spatial(las, sflakes, "inlakes")
  cn  <- names(las)

  expect_true("inlakes" %in% cn)
  expect_true(is.logical(las$inlakes))
  expect_equivalent(as.numeric(table(las$inlakes)), c(966, 216))

  las <- merge_spatial(las, sflakes, "LAKENAME_1")
  cn <- names(las)

  expect_true("LAKENAME_1" %in% cn)
  expect_equal(typeof(las$LAKENAME_1), typeof(sflakes$LAKENAME_1))
  expect_equivalent(as.numeric(table(las$LAKENAME_1)), c(216))

  las <- merge_spatial(las, sflakes)
  cn <- names(las)

  expect_true("id" %in% cn)
  expect_true(is.integer(las$id))
  expect_equivalent(as.numeric(table(las$id)), c(216))
})

test_that("merge_spatial preserve storage mode", {

  las <- merge_spatial(las, sflakes, "ID")
  cn  <- names(las)

  expect_equal(storage.mode(las$ID), storage.mode(sflakes$ID))
})


# test_that("merge_spatial works with SpatialPolygons", {
#   skip_if_not_installed("sp")
#   lakes <- as(sflakes, "SpatialPolygons")
#
#   las <- merge_spatial(las, lakes)
#   cn <- names(las)
#
#   expect_true("id" %in% cn)
#   expect_true(is.integer(las$id))
#   expect_equivalent(as.numeric(table(las$id)), c(216))
# })

test_that("merge_spatial works with sfc", {

  las <- merge_spatial(las, sf::st_geometry(sflakes), "inlakes")
  cn <- names(las)

  expect_true("inlakes" %in% cn)
  expect_true(is.logical(las$inlakes))
  expect_equivalent(as.numeric(table(las$inlakes)), c(966, 216))

  las <- merge_spatial(las, sf::st_geometry(sflakes))
  cn <- names(las)

  expect_true("id" %in% cn)
  expect_true(is.integer(las$id))
  expect_equivalent(as.numeric(table(las$id)), c(216))
})

test_that("merge_spatial does not fail if no polygon encompass the points", {

  shift <- sf::st_sfc(sf::st_point(c(2000,200)), crs = sf::st_crs(sflakes))
  lakes <- sf::st_geometry(sflakes) + shift

  las <- merge_spatial(las, lakes)
  cn  <- names(las)

  expect_true("id" %in% cn)
  expect_true(is.integer(las$id))
  expect_true(all(is.na(las$id)))
})

test_that("merge_spatial works with raster", {
  skip_if_not_installed("raster")
  las <- merge_spatial(las, as(zmean, "Raster"), "Zmean")
  cn  <- names(las)

  expect_true("Zmean" %in% cn)
  expect_true(is.numeric(las$Zmean))
  expect_equal(mean(las$Zmean), 17.9, tol = 0.01)
})

test_that("merge_spatial works with stars", {

  las <- merge_spatial(las, zmean, "Zmean")
  cn  <- names(las)

  expect_true("Zmean" %in% cn)
  expect_true(is.numeric(las$Zmean))
  expect_equal(mean(las$Zmean), 17.9, tol = 0.01)
})

test_that("merge_spatial works a RGB RasterBrick", {
  skip_if_not_installed("raster")
  las <- merge_spatial(las, as(rgb, "Raster"))
  cn  <- names(las)

  expect_true(all(c("R", "G", "B") %in% cn))
  expect_true(is.integer(las$R))
  expect_equal(las[["Point Data Format ID"]], 3L)
})

test_that("merge_spatial works a RGB stars", {

  las <- merge_spatial(las, rgb)
  cn  <- names(las)

  expect_true(all(c("R", "G", "B") %in% cn))
  expect_true(is.integer(las$R))
  expect_equal(las[["Point Data Format ID"]], 3L)
})

test_that("merge_spatial works a RGB SpatRaster", {

  las <- merge_spatial(las, as(rgb, "SpatRaster"))
  cn  <- names(las)

  expect_true(all(c("R", "G", "B") %in% cn))
  expect_true(is.integer(las$R))
  expect_equal(las[["Point Data Format ID"]], 3L)
})


test_that("merge_spatial fails with too much bands", {

  expect_error(merge_spatial(las, rgbi), "rasters must have 1 or 3 bands")
})

test_that("merge_spatial fails with unknown input type", {

  expect_error(merge_spatial(las, 4), "No method for this source format")
})

test_that("merge_spatial do not fail with 1 point (#347)", {

  one_in <- filter_poi(las, Intensity == 105)

  res1 <- merge_spatial(one_in, sflakes)
  #res2 <- merge_spatial(one_in, splakes)
  res3 <- merge_spatial(one_in, sf::st_geometry(sflakes))

  expect_equal(res1$id, 1L)
  #expect_equal(res2$id, 1L)
  expect_equal(res3$id, 1L)
})