Fix #549

NEWS.md

@@ -31,7 +31,8 @@ las@data[1:10]              # Full decompression
 - Enhance: `locate_trees()` throws an informative error if called with an on-disk raster. The former error was cryptic. If the raster is small enough it is loaded on the fly.
 - Fix: `merge_spatial()` with RGB and `SpatRaster` was not working properly [#545](https://github.com/r-lidar/lidR/issues/545)
 - Enhance: `st_area()` better estimates the area of small point clouds and is faster
-- Fix [#548](https://github.com/r-lidar/lidR/issues/548)
+- Fix: [#548](https://github.com/r-lidar/lidR/issues/548)
+- Enhance: Scale factors are better estimated in `fwf_interpreter`  [#549](https://github.com/r-lidar/lidR/issues/549). 
 
 ## lidR v4.0.0 (Release date: 2022-02-17)
 

R/fullwaveform.R

@@ -24,14 +24,27 @@ interpret_waveform <- function(las)
   if (utils::packageVersion("rlas") <= package_version("1.4.0"))
     stop("Package rlas > 1.4.0 is required for this function")
 
+  # The temporal spacing is in picosecond. The light travels 300 mm per nanosecond. For a temporal
+  # spacing of 1 ns two points emitted at one degree off nadir (worst case considered) are separated
+  # by 300*sin(pi/180) = 5.2 mm. We need a resolution of 1 mm to store distinguishable values. With
+  # a scale factor of 0.001 we are good. We use a 10th of this to be sure.
+  temporal_spacing <- header(las)@VLR[["Full WaveForm Description"]][["Full WaveForm"]][["Temporal Spacing"]]
+  one_picosecond_light <- 0.0003 # 0.3 mm
+  distance_between_two_samples <- temporal_spacing * one_picosecond_light
+  minimum_distance_at_one_degree_off_nadir <- distance_between_two_samples * pi/180
+  s <- 10^(0:7)
+  valid <- sort(c(1/s, 0.5/s))
+  i <- which(valid < minimum_distance_at_one_degree_off_nadir)
+  scale_factor <- valid[max(i)]/10
+
   header <- as.list(las@header)
   data <- las@data
   fwf <- rlas::fwf_interpreter(header, data)
   fwf <- data.table::rbindlist(fwf)
   fwfheader <- rlas::header_create(fwf)
-  fwfheader[["X scale factor"]] <- 1e-6
-  fwfheader[["Y scale factor"]] <- 1e-6
-  fwfheader[["Z scale factor"]] <- 1e-6
+  fwfheader[["X scale factor"]] <- scale_factor
+  fwfheader[["Y scale factor"]] <- scale_factor
+  fwfheader[["Z scale factor"]] <- scale_factor
   fwf <- LAS(fwf, fwfheader, crs = st_crs(las), check = FALSE)
   las_quantize(fwf, by_reference = TRUE)
   fwf <- las_update(fwf)