From 60268287e1923cf46a9accbd3591a65e1c482f26 Mon Sep 17 00:00:00 2001 From: Jean-Romain Date: Thu, 24 Oct 2024 13:42:34 -0400 Subject: [PATCH] sensor type detection --- R/io_readLAScatalog.R | 27 +++++++++++++++++++++++++++ R/methods-LAS.R | 14 +++++++++++--- R/print.R | 16 +++++++++++----- tests/testthat/test-spatialindex.R | 20 ++++++++++---------- 4 files changed, 59 insertions(+), 18 deletions(-) diff --git a/R/io_readLAScatalog.R b/R/io_readLAScatalog.R index 4d4bd210..9465a3e5 100644 --- 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 index 65d62901..55560736 100644 --- 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 index 4431fbda..611623d0 100644 --- 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 index 682cfec7..75938f27 100644 --- a/tests/testthat/test-spatialindex.R +++ b/tests/testthat/test-spatialindex.R @@ -6,17 +6,17 @@ 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) }) @@ -24,17 +24,17 @@ 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")