sensor type detection

r-lidar · Oct 24, 2024 · 6026828 · 6026828
1 parent d7f83b9
commit 6026828
Show file tree

Hide file tree

Showing 4 changed files with 59 additions and 18 deletions.
diff --git a/R/io_readLAScatalog.R b/R/io_readLAScatalog.R
@@ -152,6 +152,8 @@ readLAScatalog <- function(folder, progress = TRUE, select = "*", filter = "", c
   xmax <- headers$Max.X
   ymin <- headers$Min.Y
   ymax <- headers$Max.Y
+  zmin <- headers$Min.Z
+  zmax <- headers$Max.Z
   ids  <- as.character(seq_along(files))
 
   geom <- lapply(seq_along(ids), function(xi) {
@@ -172,6 +174,31 @@ readLAScatalog <- function(folder, progress = TRUE, select = "*", filter = "", c
   opt_chunk_buffer(res) <- chunk_buffer
   opt_progress(res) <- progress
 
+  xrange = xmax - xmin
+  yrange = ymax - ymin
+  zrange = zmax - zmin
+  area = sum(xrange*yrange)
+  if (area > 0)
+  {
+    n = sum(res$Number.of.point.records)
+    density = n/area
+    zratio = min(zrange/xrange, zrange/yrange)
+  }
+  else
+  {
+    zratio = 0
+    density = 0
+  }
+
+  if (zratio < 10/100)
+    res@index <- LIDRALSINDEX
+  else if ((zratio >= 10/100 & density > 100) || density > 1000)
+    res@index <- LIDRTLSINDEX
+  else
+    res@index <- LIDRALSINDEX
+
+
+
   if (is.overlapping(res))
     message("Be careful, some tiles seem to overlap each other. lidR may return incorrect outputs with edge artifacts when processing this catalog.")
 

diff --git a/R/methods-LAS.R b/R/methods-LAS.R
@@ -174,9 +174,17 @@ LAS <- function(data, header = list(), crs = sf::NA_crs_, check = TRUE, index =
     yrange = header[["Max Y"]] - header[["Min Y"]]
     zrange = header[["Max Z"]] - header[["Min Z"]]
     area = xrange*yrange
-    n = nrow(data)
-    density = n/area
-    zratio = min(zrange/xrange, zrange/yrange)
+    if (area > 0)
+    {
+      n = nrow(data)
+      density = n/area
+      zratio = min(zrange/xrange, zrange/yrange)
+    }
+    else
+    {
+      zratio = 0
+      density = 0
+    }
 
     if (zratio < 10/100)
       index <- LIDRALSINDEX

diff --git a/R/print.R b/R/print.R
@@ -154,11 +154,11 @@ setMethod("show", "LAS", function(object)
   format    <- phb[["Point Data Format ID"]]
   units     <- st_crs(object)$units
   units     <- if (is.null(units) || is.na(units)) "units" else units
-  type      <- sensor(las)
-  if (type == TLSLAS) type = "Terrestrial"
-  else if (type == ALSLAS) type = "Airborne"
-  else if (type == UKNLAS) type = "Unknown"
-  else type = "Unknown"
+  type      <- sensor(object)
+  if (type == TLSLAS) type = "terrestrial"
+  else if (type == ALSLAS) type = "airborne"
+  else if (type == UKNLAS) type = "unknown"
+  else type = "unknown"
 
   areaprefix  <- ""
   pointprefix <- ""
@@ -222,6 +222,11 @@ setMethod("show", "LAScatalog", function(object)
   density     <- round(npoints/area, 1)
   if (is.nan(density)) density <- 0
   dpulse      <- round(npulse/area, 1)
+  type      <- sensor(object)
+  if (type == TLSLAS) type = "terrestrial"
+  else if (type == ALSLAS) type = "airborne"
+  else if (type == UKNLAS) type = "unknown"
+  else type = "unknown"
 
   if (area > 1000*1000/2)
   {
@@ -255,6 +260,7 @@ setMethod("show", "LAScatalog", function(object)
   cat("coord. ref. :", st_crs(object)$Name, "\n")
   cat("area        : ", area.h, " ", areaprefix, units, "\u00B2\n", sep = "")
   cat("points      : ", npoints.h, " ", pointprefix, " points\n", sep = "")
+  cat("type        : ", type, "\n", sep = "")
   cat("density     : ", density, " points/", units, "\u00B2\n", sep = "")
   if (dpulse > 0)
     cat("density     : ", round(dpulse, 2), " pulses/", units, "\u00B2\n", sep = "")

diff --git a/tests/testthat/test-spatialindex.R b/tests/testthat/test-spatialindex.R
@@ -6,35 +6,35 @@ test_that("read*LAS work", {
 
   las = readLAS(LASfile)
 
-  expect_equal(las@index$sensor, 0L)
+  expect_equal(las@index$sensor, lidR:::ALSLAS)
   expect_equal(las@index$index, 0L)
 
   las = readALSLAS(LASfile)
 
-  expect_equal(las@index$sensor, 1L)
+  expect_equal(las@index$sensor, lidR:::ALSLAS)
   expect_equal(las@index$index, 0L)
 
   las = readTLSLAS(LASfile)
 
-  expect_equal(las@index$sensor, 2L)
+  expect_equal(las@index$sensor, lidR:::TLSLAS)
   expect_equal(las@index$index, 0L)
 })
 
 test_that("read*LAScatalog work", {
 
   las = readLAScatalog(LASfile)
 
-  expect_equal(las@index$sensor, 0L)
+  expect_equal(las@index$sensor, lidR:::ALSLAS)
   expect_equal(las@index$index, 0L)
 
   las = readALSLAScatalog(LASfile)
 
-  expect_equal(las@index$sensor, 1L)
+  expect_equal(las@index$sensor, lidR:::ALSLAS)
   expect_equal(las@index$index, 0L)
 
   las = readTLSLAScatalog(LASfile)
 
-  expect_equal(las@index$sensor, 2L)
+  expect_equal(las@index$sensor, lidR:::TLSLAS)
   expect_equal(las@index$index, 0L)
 })
 
@@ -61,15 +61,15 @@ test_that("sensor works", {
 
   las = readLAS(LASfile)
 
-  expect_equal(sensor(las), 0L)
+  expect_equal(sensor(las),lidR:::ALSLAS)
 
-  sensor(las) <- 2
+  sensor(las) <- lidR:::TLSLAS
 
-  expect_equal(sensor(las), 2L)
+  expect_equal(sensor(las), lidR:::TLSLAS)
 
   sensor(las) <- "tls"
 
-  expect_equal(sensor(las), 2L)
+  expect_equal(sensor(las), lidR:::TLSLAS)
   expect_equal(sensor(las, h = TRUE), "TLS")
 
   expect_error(sensor(las) <- "plop")