tests/testthat/test-LAS.R

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

context("LAS")

las  <- megaplot
data <- data.frame(X = runif(10), Y = runif(10), Z = runif(10))
outs <- data.frame(x = runif(10), Y = runif(10), z = runif(10), pointsourceid = 1:10)

test_that("Print a LAS object works", {

  sink(tempfile())
  expect_error(print(las), NA)
  expect_error(summary(las), NA)
  sink(NULL)
})

test_that("LAS builds a LAS 1.2 prf 0 object from basic data", {

  las2 <- LAS(data)

  expect_is(las2, "LAS")
  expect_equal(las2@header@PHB$`Version Minor`, 2L)
  expect_equal(las2@header@PHB$`Point Data Format ID`, 0L)
  expect_equal(las2@header@PHB$`Min X`, min(data$X))
  expect_equal(las2@header@PHB$`Min Y`, min(data$Y))
  expect_equal(las2@header@PHB$`Min Z`, min(data$Z))
  expect_equal(las2@header@PHB$`Max X`, max(data$X))
  expect_equal(las2@header@PHB$`Max Y`, max(data$Y))
  expect_equal(las2@header@PHB$`Max Z`, max(data$Z))
})

test_that("LAS builds a LAS 1.2 prf 1 object from time data", {

  data$gpstime   <- runif(10, 0, 100)
  data$Intensity <- as.integer(runif(10, 0, 100))
  las2 <- LAS(data)

  expect_is(las2, "LAS")
  expect_equal(las2@header@PHB$`Version Minor`, 2L)
  expect_equal(las2@header@PHB$`Point Data Format ID`, 1L)
  expect_equal(las2@header@PHB$`Min X`, min(data$X))
  expect_equal(las2@header@PHB$`Min Y`, min(data$Y))
  expect_equal(las2@header@PHB$`Min Z`, min(data$Z))
  expect_equal(las2@header@PHB$`Max X`, max(data$X))
  expect_equal(las2@header@PHB$`Max Y`, max(data$Y))
  expect_equal(las2@header@PHB$`Max Z`, max(data$Z))
})

test_that("LAS builds a LAS 1.2 prf 3 object from RGB data", {

  data$gpstime   <- runif(10, 0, 100)
  data$Intensity <- as.integer(runif(10, 0, 100))
  data$R         <- as.integer(runif(10, 0, 2^16))
  data$G         <- as.integer(runif(10, 0, 2^16))
  data$B         <- as.integer(runif(10, 0, 2^16))
  las2 <- LAS(data)

  expect_is(las2, "LAS")
  expect_equal(las2@header@PHB$`Version Minor`, 2L)
  expect_equal(las2@header@PHB$`Point Data Format ID`, 3L)
})

test_that("LAS builds a LAS object respecting a header", {

  las2 <- LAS(data, las@header, check = FALSE)

  expect_is(las2, "LAS")
  expect_equal(las2@header@PHB$`Version Minor`, las@header@PHB$`Version Minor`)
  expect_equal(las2@header@PHB$`Point Data Format ID`, las@header@PHB$`Point Data Format ID`)
  expect_equal(las2@header@PHB$`Min X`, min(data$X))
  expect_equal(las2@header@PHB$`Min Y`, min(data$Y))
  expect_equal(las2@header@PHB$`Min Z`, min(data$Z))
  expect_equal(las2@header@PHB$`Max X`, max(data$X))
  expect_equal(las2@header@PHB$`Max Y`, max(data$Y))
  expect_equal(las2@header@PHB$`Max Z`, max(data$Z))
})

test_that("LAS builds a LAS object with a CRS", {

  las2 <- LAS(data)

  expect_true(is.na(las2@crs))
  expect_equal(epsg(las2), 0)

  las2 <- LAS(data, las@header, check = FALSE)

  expect_equal(st_crs(las2), st_crs(las))
  expect_equal(epsg(las2), 26917)

  las2 <- LAS(data, crs = las@crs)

  expect_equal(st_crs(las2), st_crs(las))
  #expect_equal(epsg(las2), 26917)
})

test_that("LAS throws a warning/error if building an invalid LAS", {

  # Invalid point format

  data$R <- as.integer(runif(10, 0, 2^16))
  data$G <- as.integer(runif(10, 0, 2^16))
  data$B <- as.integer(runif(10, 0, 2^16))

  expect_warning(LAS(data, las@header), "point data format")

  # Invalid scale factor

  header <- las@header
  header@PHB$`Point Data Format ID` <- 3L
  header@PHB$`X scale factor` <- 0.412

  expect_warning(LAS(data, header), "X scale factor")

  # Invalid RGB

  data$R <- as.integer(runif(10, 0, 2^8))
  data$G <- as.integer(runif(10, 0, 2^8))
  data$B <- as.integer(runif(10, 0, 2^8))

  header <- las@header
  header@PHB$`Point Data Format ID` <- 3L

  expect_warning(LAS(data, header), "8 bits")

  # Invalid coordinates

  data$X <- as.integer(runif(10, 1, 100))
  expect_error(LAS(data), "double")

  data$X <- NULL
  expect_error(LAS(data), "coordinates")

  # Invalid ReturnNumber

  data$X <- runif(10)
  data$R <- NULL
  data$G <- NULL
  data$B <- NULL
  data$ReturnNumber <- as.integer(rep(1, 10L))
  data$ReturnNumber[5] <- 0L

  expect_warning(LAS(data), "return number")

  # Invalid NumberOfReturns

  set.seed(0)
  data$ReturnNumber <- as.integer(sample(1:3, 10, replace = TRUE))
  set.seed(1)
  data$NumberOfReturns <- as.integer(sample(1:3, 10, replace = TRUE))

  expect_warning(LAS(data), "number of returns")

  # Invalid Version

  header <- las@header
  header@PHB$`Version Minor` <- NULL
  data <- data.frame(X = runif(10), Y = runif(10), Z = runif(10))

  expect_error(LAS(data, header), "Version")

  # Non quantized coordinates

  header@PHB$`Version Minor` <- 1L
  expect_warning(LAS(data, header), "quantization errors")
})

test_that("LAS redefined behavior of $, [, and [[", {

  las <- random_10_points

  expect_true(is.numeric(las$Z))
  expect_equal(length(las$Z), 10)

  expect_true(is.null(las$U))

  expect_error(las$Z <- 1:10, "replace data of type double")
  expect_error(las$U <- 1:10, "Addition of a new column")

  expect_true(is.numeric(las[["Z"]]))
  expect_equal(length(las[["Z"]]), 10)

  expect_true(is.null(las[["U"]]))

  expect_error(las[["Z"]] <- 1:10, "replace data of type double")
  expect_error(las[["U"]] <- 1:10, "Addition of a new column")
})

test_that("LAS operator $ quantize on the fly and update header", {

  las <- random_10_points

  x = runif(10)
  y = runif(10)
  z = runif(10)

  las$X <- x
  las$Y <- y
  las$Z <- z

  expect_equal(las$X, quantize(x, 0.001, 0, FALSE))
  expect_equal(las$Y, quantize(y, 0.001, 0, FALSE))
  expect_equal(las$Z, quantize(z, 0.001, 0, FALSE))

  xbbox = range(quantize(x, 0.001, 0, FALSE))
  ybbox = range(quantize(y, 0.001, 0, FALSE))

  expect_equal(las@header@PHB[["Min X"]], xbbox[1])
  expect_equal(las@header@PHB[["Min Y"]], ybbox[1])
})

test_that("LAS operator [[ quantize on the fly and update header", {

  las <- random_10_points

  x = runif(10)
  y = runif(10)
  z = runif(10)

  las[["X"]] <- x
  las[["Y"]] <- y
  las[["Z"]] <- z

  expect_equal(las$X, quantize(x, 0.001, 0, FALSE))
  expect_equal(las$Y, quantize(y, 0.001, 0, FALSE))
  expect_equal(las$Z, quantize(z, 0.001, 0, FALSE))

  xbbox = range(quantize(x, 0.001, 0, FALSE))
  ybbox = range(quantize(y, 0.001, 0, FALSE))

  expect_equal(las@header@PHB[["Min X"]], xbbox[1])
  expect_equal(las@header@PHB[["Min Y"]], ybbox[1])
})

test_that("LAS operator[[ and $ throw error for not storable coordinates", {
  las <- random_10_points
  x <- round(runif(10),2)
  x[5] <- 21474836.47

  expect_error(las$X <- x, "Trying to store values ranging in")
  expect_error(las$Y <- x, "Trying to store values ranging in")
  expect_error(las[["X"]] <- x, "Trying to store values ranging in")
  expect_error(las[["Y"]] <- x, "Trying to store values ranging in")
})


test_that("LAS conversion to SpatialPointsDataFrame works", {
  skip_if_not_installed("sp")
  las <- random_10_points
  splas <- as.spatial(las)

  expect_true(is(splas, "SpatialPointsDataFrame"))
})

test_that("LAS build an empty point cloud with no header (#314)", {
  las = LAS(data.frame(X = numeric(0), Y = numeric(0), Z = numeric(0)))
  expect_equal(npoints(las), 0L)
  expect_equal(names(las), c("X", "Y", "Z"))
})

test_that("LAS rename the attribute", {
  x <- outs[["x"]]
  las = LAS(outs)
  expect_equal(names(las), c("X", "Y", "Z", "PointSourceID"))
  expect_reference(las@data[["X"]], x)
})