remove buffer after binding 2 (points) dataframe

[jerB73]

Hello,
I'm trying to build a function (test) in order to normalize ALS soil points from reference points (coming from a raster produce with an home made function SoilRef). When I'm applying this test function to a LAScatalog, it's working well without using the line witch remove buffer (before returning las2).
But this line (remove buffer) could not be used as far as there is no buffer information on data.frame (Pts1), and then on las2 file.

How can I integrate buffer information, when I'm binding the 2 data.frames Pts1 and las ?
Best regards.
JB

here is the code

test=function(las,...) {
  UseMethod("test",las)
}


test.LAScluster<-function(las)
{
  las=readLAS(las)
  if (is.empty(las)) return(NULL)
  las<-filter_ground(las)

  #making reference soil
  SoilRef=SoilRef_function(las,...)

  #transforme raster SoilRef to data.frame
  Pts1=as.data.frame(SolP95, xy=T)
  names(Pts1)=c("X","Y","Z")
  Pts1=Pts1[!is.na(Pts1$Z),]

  #convert dataframe (points) to LAS
  Pts1=LAS(Pts1)

  #define Pts1 as (reference) point soil
  Pts1@data$Classification=2
  
  #convert las point soil as vegetation soil (in order to use normalize_height function with knidw() interpolation)
  las@data$Classification=4

  #bind to dataframe Pts1 (reference points soil) and las (other soil points transforme into vegetation)
  las2=rbind(las@data[,c(1:3,10)],Pts1@data)
  las2$Classification=as.integer(las2$Classification)

  #convert data.frame to LAS object
  las2=LAS(las2, las@header)

  #normalize points height with reference soil points
  las2=normalize_height(las2, knnidw())

  #remove buffer and return new lasfile
  las2=filter_poi(las2,buffer==0)
  return(las2)
}

test.LAScatalog=function(las)
{
  catalog_apply(las,test, MatriceFocal=MatriceFocal, .options=opt)
}

#define options
ctg <- readLAScatalog(ws)
lidR:::catalog_laxindex(ctg) # Build index

opt_chunk_buffer(ctg) <- 10
opt_chunk_size(ctg)   <- 500
opt <- list(need_buffer = TRUE) # catalog_apply will throw an error if buffer = 0
opt_output_files(ctg) <- ""

#apply function
output<-test(ctg)

[Jean-Romain]

Something like that (did not test)

test=function(las, MatriceFocal) {
  UseMethod("test",las)
}


test.LAScluster<-function(las, MatriceFocal)
{
  # Get the bbox of the chunk 
  # (it is the bbox without the buffer)
  ext <- st_bbox(las)
  ybottom <- ext$ymin
  ytop    <- ext$ymax
  xleft   <- ext$xmin
  xright  <- ext$xmax
  
  # Read the chunks
  las <- readLAS(las)
  if (is.empty(las)) return(NULL)
  
  # Keep only the ground.
  # (I don't know why but it is you method)
  las <- filter_ground(las)
  
  # Remove the buffer which anyway is going to be lost
  las$buffer = NULL
  
  # Making reference soil from ground points
  SoilRef <- SoilRef_function(las, MatriceFocal)
  
  # Transforms raster SoilRef to data.frame
  # (because we want make a point cloud out of it)
  Pts1 <- as.data.frame(SolP95, xy=T)
  names(Pts1) <- c("X","Y","Z")
  Pts1 <- Pts1[!is.na(Pts1$Z),]
  
  # Define Pts1 as (reference) point soil
  Pts1$Classification <- 2L
  
  # Convert dataframe (points) to LAS
  Pts1 <- LAS(Pts1, header(las))
  
  # Convert original ground point as vegetation 
  # (in order to use normalize_height function with knidw() interpolation)
  las$Classification <- 4L
  
  # bind to the two point clouds 
  # (reference points soil) and las (other soil points transforme into vegetation)
  las2 <- rbind(las, Pts1)
  
  # normalize points height with reference soil points
  las2=normalize_height(las2, knnidw())
  
  # remove buffer and return new lasfile but we do not have buffer info
  # so we recompute it from the bbox
  las2@data[["buffer"]] <- 0L
  las2@data[Y < ybottom, buffer := 1L]
  las2@data[X < xleft,   buffer := 1L]
  las2@data[Y >= ytop,    buffer := 1L]
  las2@data[X >= xright,  buffer := 1L]
  las2 = filter_poi(las2,buffer == 0L)

  return(las2)
}

test.LAScatalog=function(las, MatriceFocal)
{
  opt <- list(need_buffer = TRUE) 
  catalog_apply(las,test, MatriceFocal = MatriceFocal, .options=opt)
}

#define options
ctg <- readLAScatalog(ws, select = "xyzc")

opt_chunk_buffer(ctg) <- 10
opt_chunk_size(ctg)   <- 500
opt_output_files(ctg) <- ""

output <- test(ctg)

[jerB73]

It seems to work well !!
I have made a little modification, by binding 2 dataframes (in order 2 las points clouds), and convert them to las file, due to problem "X[[X scale factor]].

This script allows me to vizualise and quantify skidders prints on soil ...

[jerB73]

thanks !

[Jean-Romain]

Btw I'd write that

test.LAScatalog=function(las, MatriceFocal)
{
  opt <- list(need_buffer = TRUE) 
  opt_select(las) = "xyzc"
  opt_filter(las) = "-keep_class 2"
  catalog_apply(las,test, MatriceFocal = MatriceFocal, .options=opt)
}

and remove filter_ground()