tests/testthat/test-apply_ondisk.R

context("catalog_apply writemode")

ctg <- random_2files_250points

test <- function(cluster) {
  las <- readLAS(cluster)
  if (is.empty(las)) return(NULL)
  head(lidR:::coordinates3D(las))
}

test_that("catalog_apply respects ORIGINALFILENAME template", {

  opt_output_files(ctg) <- paste0(tempdir(), "/{ORIGINALFILENAME}_{ID}")
  o <- catalog_apply(ctg, test)
  o <- unlist(o)

  ifiles <- paste0(tools::file_path_sans_ext(basename(ctg$filename)), "_", 1:2)
  ofiles <- tools::file_path_sans_ext(basename(o))

  expect_equal(ifiles, ofiles)
})

test_that("catalog_apply fails with ORIGINALFILENAME template if chunks != files", {

  opt_chunk_size(ctg) <- 75
  opt_output_files(ctg) <- paste0(tempdir(), "/{ORIGINALFILENAME}_{lidR:::uuid()}")

  expect_error(catalog_apply(ctg, test))
})

test_that("catalog_apply respects COORDINATES template", {

  opt_chunk_size(ctg) <- 75
  opt_output_files(ctg) <- paste0(tempdir(), "/{XLEFT}_{YBOTTOM}")
  o <- catalog_apply(ctg, test)
  o <- unlist(o)

  i <- c("0_0", "75_0", "0_75", "75_75", "0_150", "75_150")
  o <- tools::file_path_sans_ext(basename(o))

  expect_equal(i, o)
})

test_that("catalog_apply can write with custom drivers", {

  test <- function(cluster) {
    las <- readLAS(cluster)
    if (is.empty(las)) return(NULL)
    return(list(0))
  }

  opt_output_files(ctg) <- paste0(tempdir(), "/{ID}")

  expect_error(catalog_apply(ctg, test), "write an object of class list")

  ctg@output_options$drivers$list <- list(
    write     = base::saveRDS,
    object    = "object",
    path      = "file",
    extension = ".rds",
    param     = list(compress = TRUE))

  req <- catalog_apply(ctg, test)
  req <- unlist(req)

  expect_equal(basename(req), paste0(1:2, ".rds"))
  expect_true(all(file.exists(req)))
})

test_that("catalog_apply can create missing directories", {

 opt_output_files(ctg) <- paste0(tempdir(), "/subfolder/{ID}")

 req <- catalog_apply(ctg, test)

 expect_true(dir.exists(paste0(tempdir(), "/subfolder/")))
})

Try the lidR package in your browser

Any scripts or data that you put into this service are public.

lidR documentation built on Sept. 11, 2024, 5:21 p.m.