The hardware and bandwidth for this mirror is donated by dogado GmbH, the Webhosting and Full Service-Cloud Provider. Check out our Wordpress Tutorial.
If you wish to report a bug, or if you are interested in having us mirror your free-software or open-source project, please feel free to contact us at mirror[@]dogado.de.

CrownScorchTLS Workflow

Jeffery Cannon

2025-12-09

Introduction

This vignette demonstrates the main workflows in the CrownScorchTLS package for estimating crown scorch from terrestrial lidar scans collected with a RIEGL vz400i, following Cannon et al. 2025.

Workflow Part 1: Predict Scorch with Default Model

Load Individual Tree

library(CrownScorchTLS)
library(lidR)
# Download external file to a temporary .las/.laz file from data repo
url = "https://raw.githubusercontent.com/jbcannon/CrownScorchTLS-data/main/data/manual-clip-trees/D-03-10867_post.laz"
las_file <- tempfile(fileext = paste0(".", tools::file_ext(url)))
download.file(url, las_file, mode = "wb", quiet = TRUE)
las <- readLAS(las_file)
#plot(las, color = 'Intensity')

Generate Reflectance Histogram

crown <- remove_stem(las)
crown <- add_reflectance(crown)
histogram <- get_histogram(crown)
plot(density ~ intensity, data = histogram, xlab='Reflectance (dB)', type='l')

Predict Scorch

scorch <- predict_scorch(las)
scorch

Workflow Part 2: Multiple Trees

directory <- system.file('extdata', package = 'CrownScorchTLS')
filenames <- list.files(directory, pattern='.laz', full.names=TRUE)

par(mfrow = c(3,2), mar = c(4,4,1,1))
for(f in filenames) {
  las <- readLAS(f)
  scorch <- suppressMessages(predict_scorch(las, plot=TRUE))
  cat('file:\t', basename(f), '\t', 'scorch:\t', round(scorch,3),'\n')
}

Workflow Part 3: Custom Prediction Model

The steps for creating a customized model are similar: segment trees, generate histograms, train a custom random forest model, and predict scorch on new objects.

You can find a detailed example at https://github.com/jbcannon/CrownScorchTLS

## ================================
## 1. Load segmented trees
## ================================

# --- Option A: Use example data from GitHub (default for vignette) ---
urls <- c(
  "https://raw.githubusercontent.com/jbcannon/CrownScorchTLS-data/main/data/manual-clip-trees/M-04-15549_post.laz",
  "https://raw.githubusercontent.com/jbcannon/CrownScorchTLS-data/main/data/manual-clip-trees/L-05-14669_post.laz",
  "https://raw.githubusercontent.com/jbcannon/CrownScorchTLS-data/main/data/manual-clip-trees/E-08-9269_post.laz",
  "https://raw.githubusercontent.com/jbcannon/CrownScorchTLS-data/main/data/manual-clip-trees/B-04-4286_post.laz",
  "https://raw.githubusercontent.com/jbcannon/CrownScorchTLS-data/main/data/manual-clip-trees/D-03-10867_post.laz",
  "https://raw.githubusercontent.com/jbcannon/CrownScorchTLS-data/main/data/manual-clip-trees/C-04-11029_post.laz"
)

# Download each file to a temporary .las/.laz file
filenames <- sapply(urls, function(u) {
  tf <- tempfile(fileext = paste0(".", tools::file_ext(u)))
  download.file(u, tf, mode = "wb", quiet = TRUE)
  tf
})


# --- Option B: User supplies their own local files ---
# directory <- "C:/mydata/segmented_trees/"
# filenames <- list.files(directory, pattern = "\\.(las|laz)$", full.names = TRUE)


## ================================
## 2. Extract histogram features
## ================================

library(tidyr)
library(dplyr)

prediction_data <- lapply(filenames, function(f) {
  las  <- readLAS(f)
  crown <- tryCatch(remove_stem(las), error = function(e) las)
  crown <- add_reflectance(crown)

  hist <- get_histogram(crown)
  hist$intensity <- round(hist$intensity, 1)

  pivot_wider(hist,
    names_from = intensity,
    values_from = density,
    names_prefix = "intensity_"
  )
})

prediction_data <- bind_rows(prediction_data)


## ================================
## 3. Train prediction model
## ================================

scorch_training <- c(0.05, 0.20, 0.50, 0.75, 0.95, 0.95)

library(randomForest)
library(Boruta)

boruta.sel <- Boruta(x = prediction_data, y = scorch_training)
important <- names(boruta.sel$finalDecision[boruta.sel$finalDecision != "Rejected"])

model.RF <- randomForest(
  x = prediction_data[, important],
  y = scorch_training
)

print(model.RF)
varImpPlot(model.RF)


## ================================
## 4. Predict scorch on new trees
## ================================

# --- User-supplied new lidar object ---
# new_las <- readLAS("C:/mydata/newtree1.las")

# Example using the first file:
new_las <- readLAS(filenames[1])

predicted_scorch <- predict_scorch(new_las, model = model.RF)
predicted_scorch

These binaries (installable software) and packages are in development.
They may not be fully stable and should be used with caution. We make no claims about them.
Health stats visible at Monitor.