LadderFuelsR: An R Package for vertical fuel continuity analysis using Airborne Laser Scanning data
Authors: Olga Viedma, Carlos Silva and JM Moreno
Automated tool for vertical fuel continuity analysis using Airborne Laser Scanning data that can be applied on multiple tree species and for large-scale studies.The workflow consisted of 1) calculating the Leaf Area Density (LAD) profiles of each segmented tree; 2) identifying gaps and fuel layers; 3) estimating the distance between fuel layers; and 4) retrieving the fuel layers base height (FBH) and depth. Additionally, other functions recalculate previous metrics after considering distances > 1 m and calculate the CBH based on three criteria: maximum LAD, and the largest- and the last-distance. Moreover, the package calculates: i) the percentage of LAD comprised in each fuel layer and remove fuel layers below a specified threshold (default 25 % LAD) recalculating the distances among the reminder ones. On the other hand, when the LAD profiles showed only one fuel layer with CBH at 1.5 m (the base height), it identifies the CBH performing a segmented linear regression (breaking point) on the cumulative sum of LAD as a function of height. Finally, a collection of plotting functions is developed to represent all previous metrics.
#The CRAN version:
install.packages("LadderFuelsR")
# The development version:
#install.packages("remotes")
library(remotes)
install_github("https://github.com/olgaviedma/LadderFuelsR", dependencies = TRUE)
# loading LadderFuelsR package
library(LadderFuelsR)```{r pressure, echo=FALSE} if (!require(“pacman”)) install.packages(“pacman”) pacman::p_load(plyr, dplyr, tidyr, stringr, stringi, purrr, rlang, tidyverse, sf, terra, data.table, rgdal, lidR, leafR, segmented, lidRplugins, ggplot2, gt, gridExtra, patchwork, SSBtools, tibble, rgl, rglwidget, LadderFuelsR, magrittr, gdata)
```
```{r CHM pitfree 0.5 m, echo=TRUE, message=FALSE, warning=FALSE}
LIDAR_dir <- file.path(system.file(“extdata”, package = “LadderFuelsR”)) lidar_file<- lidR::readLAS(file.path(LIDAR_dir, “Eglin_zone1_clipped_000000.las”), filter = “-drop_z_below 0”)
chm_pitfree<- grid_canopy(lidar_file, res=0.5,pitfree( c(0,2,5,10,15,20,25,30,35,40), c(0,1.5), subcircle=0.15)) chm_pitfree[chm_pitfree > 40] <- NA chm_pitfree[chm_pitfree < 0] <- 0 chm_pitfree1 <- projectRaster(chm_pitfree, crs=26916)
col <- height.colors(25) plot(chm_pitfree1,col=col)
``` 
```{r Tree tops detection, echo=TRUE, message=FALSE, warning=FALSE}
# parameters ws= 2.5 hmin = 2 res=0.5 ttops_multichm = find_trees(lidar_file, multichm(res = res, dist_2d = 2,ws= ws, layer_thickness = 0.3,dist_3d = 1, hmin = hmin)) proj4string(ttops_multichm) <- CRS(‘+init=EPSG:26916’)
x<-add_treetops3d(plot(lidar_file, bg = “white”, size = 4), ttops_multichm) # Customize the plot orientation rgl.viewpoint(theta = 0, phi = 0, fov = 60, zoom = 0.75) # Convert the rgl scene to an HTML widget rglwidget(elementId = “x”, width = 800, height = 600)
``` 
```{r Crowns Silva, echo=TRUE, message=FALSE, warning=FALSE}
algo_silva1 <-silva2016(chm_pitfree1, ttops_multichm, max_cr_factor = 0.6, exclusion = 0.3, ID = “treeID”) crowns_silva_las1 <-segment_trees(lidar_file, algo_silva1, attribute = “treeID”, uniqueness = “incremental”) crowns_silva_las2<-filter_poi(crowns_silva_las1, !is.na(treeID))
my_palette <- colorRampPalette(col) x1<-plot(crowns_silva_las2, color = “treeID”, pal = my_palette, bg = “white”)
rgl.viewpoint(theta = 0, phi = 0, fov = 10, zoom = 0.75)
rglwidget(elementId = “x1”, width = 800, height = 600)
```
```{r tree metrics function, echo=TRUE}
custom_crown_metrics <- function(z, i) { # user-defined function metrics <- list( dz = 1, th = 1, z_max = max(z),# max height z_min = min(z),# min height z_mean = mean(z),# mean height z_sd = sd(z), # vertical variability of points z_q1=quantile(z, probs = 0.01), z_q5=quantile(z, probs = 0.05), z_q25=quantile(z, probs = 0.25), z_q50=quantile(z, probs = 0.50), z_q75=quantile(z, probs = 0.75), z_q95=quantile(z, probs = 0.95), crr=(mean(z)-min(z))/(max(z)-min(z)) ) return(metrics) # output } ccm = ~custom_crown_metrics(z = Z, i = Intensity)
## 5.Computing crown level standard metrics within all trees detected{r tree and crown standard and own metrics, echo=TRUE, message=FALSE, warning=FALSE} crowns_silva_filter<-filter_poi(crowns_silva_las2, Z >= 1)
metrics1 = crown_metrics(crowns_silva_filter,func = .stdtreemetrics, geom = “convex”) crown_diam<-data.frame(sqrt(metrics1$convhull_area/ pi) * 2) names(crown_diam)<-“crown_diam” metrics2 = crown_metrics(crowns_silva_filter,func = ccm, geom = “convex”) #concave metrics_all <- dplyr::bind_cols(list(metrics1,crown_diam,metrics2)) metrics_all1 <- metrics_all[,c(1:4,6,10:21)] names(metrics_all1)<-c(“treeID”, “Z”, “npoints”, “convhull_area”, “crown_diam”, “z_max”, “z_min”, “z_mean”,“z_sd”, “z_q1”,“z_q5”, “z_q25”,“z_q50”,“z_q75”, “z_q95”, “crr”, “geometry” )
tree_crowns <- st_as_sf(metrics_all1)
ttops1<-st_as_sf(ttops_multichm) crowns1<-st_as_sf(tree_crowns) ttops_within_crowns <- st_intersection(ttops1, crowns1)
par(mfrow = c(1, 1), mar = c(1, 1, 1, 1), pin = c(5, 4)) plot(st_geometry(crowns1), pch = 16, col = “green”) plot(ttops_within_crowns, add = TRUE, pch= 16, col = “darkblue”, main = “Tree tops over the crowns”) ``` 
```{r cropLAS files with no overlapping crowns, echo=TRUE, message=FALSE, warning=FALSE}
trees_ID <- tree_crowns %>% dplyr::select(treeID) n <- nrow(trees_ID)
crown_cort <- vector(“list”, length=n)
for (i in 1:n) { kk <- trees_ID[i,] crown_cort[[i]] = clip_roi(crowns_silva_las2, kk) }
my_palette <- colorRampPalette(col) x2<-plot(crown_cort[[1]], color = “Z”, pal = my_palette, bg = “black”, size = 2.5)
rgl.viewpoint(theta = 0, phi = 0, fov = 60, zoom = 0.75)
```{r LAI and LAD tree metrics, echo=TRUE, message=FALSE, warning=FALSE}
LIDAR_dir <- file.path(system.file(“extdata”, package = “LadderFuelsR”)) las_list1 <- list.files(LIDAR_dir, pattern = "*_CROWN.las", full.names = TRUE, ignore.case = TRUE)
files_with_more_than_10_points <- c()
for (file in las_list1) { las_data <- lidR::readLAS(file) las_data1<-filter_poi(las_data, Z >= 1)
# skip to next file if there was a problem reading if (is.null(las_data1)) next
# check if it contains more than three points if (las_data1@header$Number of point records > 10) { files_with_more_than_10_points <- c(files_with_more_than_10_points, file) } }
short_name1<-NULL profile_list<-NULL lidar_lai_list<-NULL understory_lai_list<-NULL LAHV_metric_list<-NULL
for (j in seq_along(files_with_more_than_10_points)){
short_name<-stri_sub(files_with_more_than_10_points[j], 1, -5) short_name1<-gsub(".*/“,”",short_name)
normlas_file<-files_with_more_than_10_points[[j]]
VOXELS_LAD = lad.voxels(normlas_file, grain.size = 2)
lad_profile = lad.profile(VOXELS_LAD, relative = F) lai_tot = lai(lad_profile) understory_lai <- lai(lad_profile, min = 0.3, max = 2.5) LAHV_metric<- LAHV(lad_profile, LAI.weighting = FALSE, height.weighting = FALSE)
lad_profile1 = data.frame(lad_profile, treeID = short_name1) lai_tot1 = data.frame(lai_tot, treeID = short_name1) understory_lai1 = data.frame(understory_lai, treeID = short_name1) LAHV_metric1 = data.frame(LAHV_metric, treeID = short_name1)
profile_list<-rbind(profile_list, lad_profile1) lidar_lai_list<-rbind(lidar_lai_list,lai_tot1) understory_lai_list <-rbind(understory_lai_list,understory_lai1) LAHV_metric_list<-rbind(LAHV_metric_list,LAHV_metric1) }
head(profile_list,10) ``` 
```{r depurating LAD databases, echo=TRUE, message=FALSE, warning=FALSE}
cols <- c(‘treeID’) profile_list[cols] <- lapply(profile_list[cols], function (x) as.factor(x)) profile_list\(lad<-round(profile_list\)lad,digits = 4)
cases <- data.frame(table(profile_list\(treeID)) cases1 <-cases[cases\)Freq > 5, ] names(cases1)<-c(“treeID”, “Freq”)
profile_list1 <- profile_list[profile_list\(treeID %in% cases1\)treeID, ] profile_list2 <- data.frame(profile_list1 %>% replace(is.na(.), 0.01))
## 9.Gaps and Fuel Layers Base Height (FBH){r Gaps and Fuel layers Base Height (fbh), echo=TRUE, message=FALSE, warning=FALSE}
profile_list2\(treeID <- factor(profile_list2\)treeID)
trees_name1 <- as.character(profile_list2$treeID) trees_name2 <- factor(unique(trees_name1))
gaps_fbhs_list<-list() for (i in levels(trees_name2)) { tree2 <- profile_list2 |> dplyr::filter(treeID == i) gaps_fbhs <- get_gaps_fbhs(tree2) gaps_fbhs_list[[i]] <- gaps_fbhs }
gaps_fbhs_list1 <- dplyr::bind_rows(gaps_fbhs_list) gaps_fbhs_list1\(treeID <- factor(gaps_fbhs_list1\)treeID)
gaps_fbhs_list1_no_treeID <- gaps_fbhs_list1[, -which(names(gaps_fbhs_list1) == c(“treeID”,“treeID1”))] # Check if any row has all NA values rows_with_all_NA_or_zero <- apply(gaps_fbhs_list1_no_treeID, 1, function(row) all(is.na(row) | row == 0)) # Get the row index with all NA values row_index <- which(rows_with_all_NA_or_zero)
if (length(row_index) > 0) { gaps_fbhs_metrics <- gaps_fbhs_list1[-row_index, ] } else { gaps_fbhs_metrics <- gaps_fbhs_list1 } rownames(gaps_fbhs_metrics) <- NULL head(gaps_fbhs_metrics) ``` 
```{r LAD percentile of each height bin, echo=TRUE, message=FALSE, warning=FALSE}
profile_list2\(treeID <- factor(profile_list2\)treeID)
trees_name1 <- as.character(profile_list2$treeID) trees_name2 <- factor(unique(trees_name1))
gaps_perc_list <- list() # Initialize outside the loop
for (i in levels(trees_name2)) {
tree1 <- profile_list2 |> dplyr::filter(treeID == i)
percentiles <- calculate_gaps_perc(tree1)
gaps_perc_list[[i]] <- percentiles
}
gaps_perc <- dplyr::bind_rows(gaps_perc_list)head(gaps_perc) ``` 
```{r Distances (and their heights) between fuel layers, echo=TRUE, message=FALSE, warning=FALSE}
numeric_vars <- setdiff(names(gaps_fbhs_metrics), c(“treeID”, “treeID1”)) gaps_fbhs_metrics[numeric_vars] <- lapply(gaps_fbhs_metrics[numeric_vars], function(x) as.numeric(ifelse(x == “NA”, NA, x))) gaps_fbhs_metrics\(treeID <- factor(gaps_fbhs_metrics\)treeID)
gaps_perc\(treeID <- factor(gaps_perc\)treeID)
trees_name1 <- as.character(gaps_fbhs_metrics$treeID) trees_name2 <- factor(unique(trees_name1))
metrics_distance_list <- list()
for (i in levels(trees_name2)) {
# Filter data for each tree tree1 <- gaps_fbhs_metrics |> dplyr::filter(treeID == i) tree2 <- gaps_perc |> dplyr::filter(treeID == i)
# Get distance metrics for each tree metrics_distance <- get_distance(tree1,tree2) metrics_distance_list[[i]] <- metrics_distance }
distance_metrics <- dplyr::bind_rows(metrics_distance_list) distance_metrics <- distance_metrics[, order(names(distance_metrics))] rownames(distance_metrics) <- NULL head(distance_metrics) ``` 
```{r Distane between fuel layers, echo=TRUE, message=FALSE, warning=FALSE}
library(dplyr) library(magrittr)
profile_list2\(treeID <- factor(profile_list2\)treeID) # Tree metrics derived from get_distance() function distance_metrics\(treeID <- factor(distance_metrics\)treeID)
metrics_depth_list <- list()
for (i in levels(profile_list2$treeID)){
tree1 <- profile_list2 |> dplyr::filter(treeID == i) tree2 <- distance_metrics |> dplyr::filter(treeID == i)
# Get depths for each tree metrics_depth <- get_depths(tree1, tree2) metrics_depth_list[[i]] <- metrics_depth }
depth_metrics <- dplyr::bind_rows(metrics_depth_list)
depth_metrics <- depth_metrics[, order(names(depth_metrics))] rownames(depth_metrics) <- NULL head(depth_metrics) ``` 
```{r Plots Gaps and Fuel layers Base Height (fbh), echo=TRUE, message=FALSE, warning=FALSE}
library(LadderFuelsR) library(ggplot2) library(lattice)
profile_list2\(treeID <- factor(profile_list2\)treeID) # Tree metrics derived from get_depths() function depth_metrics\(treeID <- factor(depth_metrics\)treeID)
plots_gaps_fbhs <- get_plots_gap_fbh(profile_list2, depth_metrics)
par(mfrow = c(2, 2)) # Plot in RED are the GAPS and in GREEN the FBHs plot(plots_gaps_fbhs[[1]]) plot(plots_gaps_fbhs[[2]]) plot(plots_gaps_fbhs[[3]]) ```
|
|
|
|
```{r Fuels base height after removing distances equal 1 m, echo=TRUE, message=FALSE, warning=FALSE}
library(SSBtools) library(dplyr) library(magrittr)
depth_metrics\(treeID <- factor(depth_metrics\)treeID)
trees_name1 <- as.character(depth_metrics$treeID) trees_name2 <- factor(unique(trees_name1))
fbh_corr_list <- list()
for (i in levels(trees_name2)){
tree3 <- depth_metrics |> dplyr::filter(treeID == i)
fbh_corr <- get_real_fbh(tree3)
fbh_corr_list[[i]] <- fbh_corr }
fbh_metrics_corr <- dplyr::bind_rows(fbh_corr_list) fbh_metrics_corr\(treeID <- factor(fbh_metrics_corr\)treeID)
original_column_names <- colnames(fbh_metrics_corr)
prefixes <- c(“treeID”, “Hdist”, “Hcbh”, “Hdepth”, “dist”, “depth”, “max_height”)
new_order <- c()
for (prefix in prefixes) { # Find column names matching the current prefix matching_columns <- grep(paste0(“^”, prefix), original_column_names, value = TRUE) # Append to the new order new_order <- c(new_order, matching_columns) }
fbh_metrics_corr <- fbh_metrics_corr[, new_order] rownames(fbh_metrics_corr) <- NULL head(fbh_metrics_corr) ``` 
```{r Fuel layers depth after removinG distances equal 1 m, echo=TRUE, message=FALSE, warning=FALSE}
library(dplyr) library(magrittr) library(tidyr)
fbh_metrics_corr\(treeID <- factor(fbh_metrics_corr\)treeID)
trees_name1 <- as.character(fbh_metrics_corr$treeID) trees_name2 <- factor(unique(trees_name1))
depth_metrics_corr_list <- lapply(levels(trees_name2), function(i) { # Filter data for each tree tree2 <- fbh_metrics_corr |> dplyr::filter(treeID == i) # Get real depths for each tree get_real_depths(tree2) })
depth_metrics_corr <- dplyr::bind_rows(depth_metrics_corr_list) rownames(depth_metrics_corr) <- NULL head(depth_metrics_corr) ``` 
```{r Fuel layers distances after removing distances equal 1 m, echo=TRUE, message=FALSE, warning=FALSE}
library(dplyr) library(magrittr) library(stringr)
depth_metrics_corr\(treeID <- factor(depth_metrics_corr\)treeID)
trees_name1 <- as.character(depth_metrics_corr$treeID) trees_name2 <- factor(unique(trees_name1))
distance_metrics_corr_list <- lapply(levels(trees_name2), function(i) { # Filter data for each tree tree2 <- depth_metrics_corr |> dplyr::filter(treeID == i) # Get effective gap for each tree get_effective_gap(tree2) })
distances_metrics_corr <- dplyr::bind_rows(distance_metrics_corr_list)
original_column_names <- colnames(distances_metrics_corr)
prefixes <- c(“treeID”, “Hcbh”, “dptf”, “Hdptf”, “effdist”, “dist”, “Hdist”, “max_Hcbh”, “max_dptf”, “max_Hdptf”, “last_Hcbh”, “last_dptf”, “last_Hdptf”, “max_height”)
new_order <- c()
for (prefix in prefixes) { # Find column names matching the current prefix matching_columns <- grep(paste0(“^”, prefix), original_column_names, value = TRUE)
numeric_suffixes <- as.numeric(gsub(paste0(“^”, prefix), "", matching_columns)) matching_columns <- matching_columns[order(numeric_suffixes)]
new_order <- c(new_order, matching_columns) }
distances_metrics_corr1 <- distances_metrics_corr[, new_order] # Unlist the data frame distances_metrics_corr2 <- as.data.frame(lapply(distances_metrics_corr1, function(x) unlist(x))) rownames(distances_metrics_corr2) <- NULL head(distances_metrics_corr2) ``` 
```{r Fuels LAD percentage for fule layers with a LAD percentage above a threshold, echo=TRUE, message=FALSE, warning=FALSE}
library(dplyr) library(magrittr)
profile_list2\(treeID <- factor(profile_list2\)treeID)
distances_metrics_corr2\(treeID <- factor(distances_metrics_corr2\)treeID)
trees_name1 <- as.character(distances_metrics_corr2$treeID) trees_name2 <- factor(unique(trees_name1))
LAD_metrics1 <- list() LAD_metrics2 <- list()
for (i in levels(trees_name2)) { # Filter data for each tree tree1 <- profile_list2 |> dplyr::filter(treeID == i) tree2 <- distances_metrics_corr2 |> dplyr::filter(treeID == i)
LAD_metrics <- get_layers_lad(tree1, tree2, thrshold = 10) LAD_metrics1[[i]] <- LAD_metrics\(df1 LAD_metrics2[[i]] <- LAD_metrics\)df2 }
LAD_metrics_all1 <- dplyr::bind_rows(LAD_metrics1) LAD_metrics_all2 <- dplyr::bind_rows(LAD_metrics2)
LAD_metrics_list <- list(LAD_metrics_all1, LAD_metrics_all2)
fuels_LAD_metrics <- list()
prefixes <- c(“treeID”, “Hdist”, “Hcbh”, “effdist”, “dptf”, “Hdptf”, “max”, “last”)
for (i in seq_along(LAD_metrics_list)) {
LAD_metrics_all <- LAD_metrics_list[[i]]
original_column_names <- colnames(LAD_metrics_all)
new_order <- c()
for (prefix in prefixes) { # Find column names matching the current prefix matching_columns <- grep(paste0(“^”, prefix), original_column_names, value = TRUE)
numeric_suffixes <- as.numeric(gsub(paste0(“^”, prefix), "", matching_columns))
# Order the columns based on numeric suffixes matching_columns <- matching_columns[order(numeric_suffixes)]
new_order <- c(new_order, matching_columns) } # Reorder columns LAD_metrics_all <- LAD_metrics_all[, new_order] # Store the reordered data frame in the list fuels_LAD_metrics[[i]] <- LAD_metrics_all } rownames(fuels_LAD_metrics[[1]]) <- NULL rownames(fuels_LAD_metrics[[2]]) <- NULL
head(fuels_LAD_metrics[[2]]) ``` 
```{r Plots of fuel layers with LAD percentage greater than a threshold, echo=TRUE, message=FALSE, warning=FALSE}
library(ggplot2)
profile_list2\(treeID <- factor(profile_list2\)treeID) # Tree metrics derived from get_layers_lad() function LAD_gt10p <- fuels_LAD_metrics[[2]]
trees_name1 <- as.character(LAD_gt10p$treeID) trees_name2 <- factor(unique(trees_name1))
plots_trees_LAD <- get_plots_effective(profile_list2, LAD_gt10p)
par(mfrow = c(2, 2)) plot(plots_trees_LAD[[1]]) plot(plots_trees_LAD[[2]]) plot(plots_trees_LAD[[3]]) ```
|
|
|
|
```{r CBH based on different criteria: maximum LAD, maximum and last distance, echo=TRUE, message=FALSE, warning=FALSE}
library(dplyr) library(magrittr)
LAD_gt10p <- fuels_LAD_metrics[[2]]
trees_name1 <- as.character(LAD_gt10p$treeID) trees_name2 <- factor(unique(trees_name1))
cbh_metrics_list <- list()
for (j in levels(trees_name2)){
tree1 <- LAD_gt10p |> dplyr::filter(treeID == j) cbh_metrics <- get_cbh_metrics(tree1) cbh_metrics_list[[j]] <- cbh_metrics }
cbh_metrics_all <- dplyr::bind_rows(cbh_metrics_list)
original_column_names <- colnames(cbh_metrics_all)
desired_order <- c(“treeID”, “Hcbh”, “dptf”,“effdist”,“dist”, “Hdist”, “Hdptf”,“maxlad_”,“max_”,“last_”,“nlayers”)
prefixes <- unique(sub("^([a-zA-Z]+).*“,”\1", original_column_names)) # Initialize vector to store new order new_order <- c()
for (prefix in desired_order) { # Find column names matching the current prefix matching_columns <- grep(paste0(“^”, prefix), original_column_names, value = TRUE) # Append to the new order new_order <- c(new_order, matching_columns) }
cbh_metrics_all <- cbh_metrics_all[, new_order]
``` 
```{r Plots of CBH based on different criteria: maximum LAD, maximum and last distance, echo=TRUE, message=FALSE, warning=FALSE} library(ggplot2)
profile_list2\(treeID <- factor(profile_list2\)treeID) # Tree metrics derived from get_cbh_metrics() function cbh_metrics_all\(treeID <- factor(cbh_metrics_all\)treeID)
trees_name1 <- as.character(cbh_metrics_all$treeID) trees_name2 <- factor(unique(trees_name1))
plots_cbh_maxlad <- get_plots_cbh_LAD(profile_list2, cbh_metrics_all) plots_cbh_maxdist <- get_plots_cbh_maxdist(profile_list2, cbh_metrics_all) plots_cbh_lastdist <- get_plots_cbh_lastdist(profile_list2, cbh_metrics_all)
par(mfrow = c(2, 2)) plot(plots_cbh_maxlad[[1]]) plot(plots_cbh_maxdist[[1]]) plot(plots_cbh_lastdist[[1]]) ```
|
|
|
|
```{r CBH and the LAD percentage below and above the CBH using the breaking point method, echo=TRUE, message=FALSE, warning=FALSE}
library(dplyr) library(magrittr)
profile_list2\(treeID <- factor(profile_list2\)treeID)
cbh_metrics_all\(treeID <- factor(cbh_metrics_all\)treeID)
trees_name1 <- as.character(cbh_metrics_all$treeID) trees_name2 <- factor(unique(trees_name1))
cum_LAD_metrics_list <- list()
for (i in levels(trees_name2)) { # Filter data for each tree tree1 <- profile_list2 |> dplyr::filter(treeID == i) tree2 <- cbh_metrics_all |> dplyr::filter(treeID == i)
cum_LAD_metrics_all <- get_cum_break(tree1, tree2,threshold=75, verbose=TRUE) cum_LAD_metrics_list[[i]] <- cum_LAD_metrics_all }
cum_LAD_metrics <- dplyr::bind_rows(cum_LAD_metrics_list)
original_column_names <- colnames(cum_LAD_metrics)
prefixes <- c(“treeID”, “Hcbh”, “below”, “above”, “bp”, “max”, “cumlad”)
new_order <- c()
for (prefix in prefixes) { # Find column names matching the current prefix matching_columns <- grep(paste0(“^”, prefix), original_column_names, value = TRUE)
numeric_suffixes <- as.numeric(gsub(paste0(“^”, prefix), "", matching_columns)) matching_columns <- matching_columns[order(numeric_suffixes)]
new_order <- c(new_order, matching_columns) }
cum_LAD_metrics <- cum_LAD_metrics[, new_order]
rownames(cum_LAD_metrics) <- NULL head(cum_LAD_metrics) ``` 
```{r Plots of the CBH and the LAD percentage below and above the CBH using the breaking point method, echo=TRUE, message=FALSE, warning=FALSE}
library(ggplot2)
profile_list2\(treeID <- factor(profile_list2\)treeID)
cum_LAD_metrics\(treeID <- factor(cum_LAD_metrics\)treeID)
plots_cbh_bp <- get_plots_cbh_bp(profile_list2, cum_LAD_metrics)
par(mfrow = c(2, 2)) plot(plots_cbh_bp[[1]]) plot(plots_cbh_bp[[2]]) plot(plots_cbh_bp[[3]]) ```
|
|
|
|
```{r Joining crown polygons and ladder fuels metrics, echo=TRUE, message=FALSE, warning=FALSE}
cbh_metrics_all\(treeID1 <- factor(cbh_metrics_all\)treeID1)
tree_crowns\(treeID1 <- factor(tree_crowns\)treeID)
crowns_properties<-merge (tree_crowns,cbh_metrics_all, by=“treeID1”) crowns_properties\(maxlad_Hcbh_factor <- cut(crowns_properties\)maxlad_Hcbh, breaks = 5)
palette <- colorRampPalette(c(“orange”, “dark green”))
ggplot() + geom_sf(data = crowns_properties, aes(fill = maxlad_Hcbh_factor)) + scale_fill_manual(values = palette(5)) + theme_minimal() + labs(title = “Tree Crowns”, fill = “maxlad_Hcbh”)
```
We gratefully acknowledge funding from project INFORICAM (PID2020-119402RB-I00), funded by the Spanish MCIN/AEI/ 10.13039/501100011033 and by the “European Union NextGenerationEU/PRTR”. Carlos Silva was supported by the NASA’s Carbon Monitoring System funding (CMS, grant 22-CMS22-0015).
Please report any issue regarding the LadderFuelsR package to Dr. Olga Viedma (olga.viedma@uclm.es)
Viedma,O.;Silva, C; Moreno, JM: LadderFuelsR: An R Package for vertical fuel continuity analysis using LiDAR data.version 0.0.1, accessed on November. 22 2023, available at: https://CRAN.R-project.org/package=LadderFuelsR
LadderFuelsR package comes with no guarantee, expressed or implied, and the authors hold no responsibility for its use or reliability of its outputs.