area-based.1.data.preparation.Rmd

title: "R workflow for ABA data preparation"
author: "Jean-Matthieu Monnet"
date: "`r Sys.Date()`"
output:
  html_document: default
  pdf_document: default
papersize: a4
bibliography: "../bib/bibliography.bib"

# erase all
cat("\014")
rm(list = ls())
# knit options
knitr::opts_chunk$set(echo = TRUE)
# Set so that long lines in R will be wrapped:
knitr::opts_chunk$set(tidy.opts = list(width.cutoff = 80), tidy = TRUE)
knitr::opts_chunk$set(fig.align = "center")
# ggplot2
library(ggplot2)

The code below presents a workflow to prepare inventory data for the calibration of area-based models with airborne laser scanning data and field measurements.

Licence: GNU GPLv3 / Source page

Required R packages : ggplot2, sf, leaflet, lidaRtRee (tested with version r packageVersion("lidaRtRee")) and lidR (tested with version r packageVersion("lidR"))

Many thanks to Pascal Obstétar for checking code and improvement suggestions.

Import field inventory data

Tree-level inventory

96 plots of 15 m radius have been inventoried in the Quatre Montagnes area (Vercors Mountain, France). Plots are aggregated in clusters of 4. Data are provided in the folder "data/aba.model/field":

• one file per plot for tree information ("Verc-CLUSTERID-PLOTID-ArbresTerrain.csv")

• one file per cluster for plot center location ("Verc-CLUSTERID-PiquetsTerrain.csv")

The first step is to import tree and plot information in two separate data.frames.

# set inventory parameters
# plot radius (m)
p_radius <- 15
# DBH threshold (cm) for inventory, trees smaller than this value are not inventoried
dbh_min <- 7.5
# list tree files by pattern matching
files_t <- as.list(dir(
  path = "../data/aba.model/field/",
  pattern = "Verc-[[:alnum:]]{2}-[[:digit:]]{1}_ArbresTerrain.csv",
  full.names = TRUE
))
# load content of all files with lapply
trees <- lapply(files_t, function(x) {
  # read table
  dummy <- read.table(x, sep = ";", header = T, stringsAsFactors = F)
  # add one column with plot_id from file name
  cbind(dummy, data.frame(plot_id = rep(substr(x, 31, 34), nrow(dummy))))
})
# bind elements of list into a single data.frame
trees <- do.call(rbind, trees)
# add study area info in plot_id
trees$plot_id <- paste0("Verc-", trees$plot_id)

Fields are:

• tree_id: tree id in the plot

• pole_id: plot id inside the cluster (1 to 4)
• species: tree species abreviated as GESP (GEnus SPecies)
• azimuth_gr: azimuth in grades from the plot center to tree center
• slope_gr: slope in grades from the plot center to tree center
• diameter_cm: tree diameter at breast height (1.3 m, upslope), in cm
• ground_distance_m: ground distance between the plot center and tree edge at breast height, in m
• height_m: tree height, in m
• appearance:
  • 0: lying or missing,
  • 1: live,
  • 2: live with broken treetop,
  • 3: dead with branches,
  • 4: dead without branches (snag)
• tilted: 0: no, 1:yes
• remark
• plot_id: plot id

The following lines set column names to english and convert the appearance column to factor with adequate values for the levels.

# change column names to English
names(trees) <- c(
  "tree_id", "pole_id", "species", "azimuth_gr", "slope_gr", "diameter_cm",
  "ground_distance_m", "height_m", "appearance", "tilted", "remark", "plot_id"
)
# add factor levels to column appearance
# set appearance of tree 92 in plot Verc-S8-1 to 1 (missing value)
trees$appearance[is.na(trees$appearance)] <- 1
trees$appearance <- factor(trees$appearance, levels = 0:4)
levels(trees$appearance) <- c("missing or lying", "live", "live with broken treetop", "dead with branches", "dead without branches (snag)")
# convert species column to factor
trees$species <- factor(trees$species)
head(trees, n = 3)

Plot-level information

The next step is to import plot coordinates.

# list location files by pattern matching
files_p <- dir(
  path = "../data/aba.model/field/",
  pattern = "Verc-[[:alnum:]]{2}_PiquetsTerrain.csv",
  full.names = TRUE
)
# initialize data.frame
plots <- NULL
# load all plot files with a loop
for (i in files_p)
{
  # read file
  dummy <- read.table(i, sep = ";", header = T, stringsAsFactors = F)
  # append to data.frame and add plot_id info
  plots <- rbind(plots, cbind(dummy, data.frame(plot_id = rep(substr(i, 31, 32), nrow(dummy)))))
}
# keep only necessary data in plots data.frame (remove duplicate position measurements)
plots <- plots[is.element(plots$Id, c("p1", "p2", "p3", "p4")), ]
# add plot_id to cluster_id
plots$cluster_id <- paste0("Verc-", substr(plots$plot_id, 1, 2))
plots$plot_id <- paste(plots$cluster_id, substr(plots$Id, 2, 2), sep = "-")
# keep only coordinates and Id in data.frame
plots <- plots[, c("X", "Y", "plot_id", "cluster_id")]
# convert to spatial sf object
plots_sf <- sf::st_as_sf(plots, coords = c("X", "Y"))
# set coordinate system
sf::st_crs(plots_sf) <- 2154
# add coordinates in data.frame of sf object
plots_sf <- cbind(plots_sf, data.frame(sf::st_coordinates(plots_sf)))

The following lines maps the plot centers with a background from OpenStreetMap using the leaflet package :

library(dplyr)
library(leaflet)
# transform coordinates  to lat / lon
markers <- sf::st_transform(plots_sf, sf::st_crs(4326))
#
m <- leaflet(markers) %>%
  addCircleMarkers(radius = 4,
                   color = "black",
                   fillOpacity = 1) %>%
  addTiles()
m

In case tree positions have to be precisely calculated in a given projected coordinates system, it is necessary to correct magnetic azimuth with magnetic declination at the time of inventory and meridian convergence at the location. The values of magnetic declination and meridian convergence at each plot location are loaded from an additional table.

# get meta data about meridian convergence and declination by importing the metadata file.
meta <- read.table(file = "../data/aba.model/field/plot.metadata.csv", sep = ";", header = T)
# keep only required attributes
meta <- meta[, c("Id", "Convergence_gr", "Declinaison_gr")]
# rename attributes
names(meta) <- c("cluster_id", "convergence_gr", "declination_gr")
# merge to add convergence and declination in plots data.frame
plots_sf <- merge(plots_sf, meta)
head(plots_sf, n = 3)

Compute tree coordinates

Tree coordinates can be computed from the plot center coordinates and from the azimuth, slope and ground distance measurements. In case ground distance is measured to the tree edge, the tree diameter has to be taken into account to compute the position of the tree center.

# merge tree and plots data.frames to import plot center
trees <- merge(trees, plots_sf[, c("X", "Y", "convergence_gr", "declination_gr", "plot_id")],
  by = "plot_id"
)
# compute projected coordinates
dummy <- lidaRtRee::polar2Projected(
  trees$X, trees$Y, 0, trees$azimuth_gr / 200 * pi,
  trees$ground_distance_m, trees$slope_gr / 200 * pi,
  trees$declination_gr / 200 * pi,
  trees$convergence_gr / 200 * pi, trees$diameter_cm / 100
)
# add coordinates to trees data.frame
trees[, c("X", "Y", "horiz_dist_m")] <- dummy[, c("x", "y", "d")]
head(trees, n = 3)

Import ALS data

The LAZ files provided with this tutorial are the point clouds already extracted around the plots. The code presented afterwards will thus extract the point clouds in files which correspond to already extracted data, but it can also perform the operation if the folder contains LAZ files corresponding to a wall to wall cover. LAZ files should be non-overlapping, and normalized (i.e. the Z field contains the height above ground).

Point cloud extraction

Normalized points clouds are extracted over each plot. For the delineation of single trees, a buffer has to be added around the plot border. The attribute buffer is added and filled with TRUE for loaded points which are located outside of the plot extent. Those points will be removed when statistics are computed for the point cloud located inside the extent of the field plot.

# folder with laz files
# lazdir <- "/media/reseau/lessem/ProjetsCommuns/Lidar/data/38_Quatre_Montagnes/norm.laz/"
lazdir <- "../data/aba.model/ALS/plots.norm.laz/"
# make catalog of las files
cata <- lidR::readALSLAScatalog(lazdir)
# set coordinate system
lidR::projection(cata) <- 2154
# disable display of catalog processing
lidR::opt_progress(cata) <- FALSE
# extract from LAZ files in catalog
llas_height <- lidR::clip_circle(cata, plots_sf$X, plots_sf$Y, p_radius + 5)
# add "buffer" attribute equal to TRUE to points outside plot
llas_height <-
  mapply(
    function(x, y, las)
      lidR::add_attribute(las, (las$X - x) ^ 2 +
                            (las$Y - y) ^ 2 > p_radius ^ 2,
                          "buffer"),
    as.list(plots_sf$X),
    as.list(plots_sf$Y),
    llas_height
  )
# set names of point clouds in list
names(llas_height) <- plots_sf$plot_id
# set negative height values to 0
llas_height <- lapply(llas_height, function(x)
{
  x$Z[x$Z < 0] <- 0
  x
})
# write plot clouds
# for (i in names(llas_height))
#  {lidR::writeLAS(llas_height[[i]], file=paste0(lazdir, i, ".laz"))}

Point clouds with altitude values can be used to compute terrain statistics. The folder plots.laz contains the point clouds with altitude value extracted on the extent of each field plot. No buffer is added when loading those point clouds. The points not classified as ground are removed.

# folder with laz files
lazdir <- "../data/aba.model/ALS/plots.laz/"
# make catalog of las files
cata <- lidR::readALSLAScatalog(lazdir)
# set coordinate system
lidR::projection(cata) <- 2154
# disable plot of tile processing
lidR::opt_progress(cata) <- FALSE
# option to read only ground and water points
lidR::opt_filter(cata) <- "-keep_class 2 9"
# option to read only xyzc attributes (coordinates and classification)
lidR::opt_select(cata) <- "xyzc"
# extract las point cloud without buffer
llas_ground <- lidR::clip_circle(cata, plots$X, plots$Y, p_radius)
# set names
names(llas_ground) <- plots$plot_id

Computation of terrain statistics

Terrain statistics can be extracted from the cloud of ground points with altitude values. The function lidaRtRee::terrain_points_metrics computes the aspect, altitude and slope of a point cloud by fitting a plane to points. The altitude is extracted by interpolating values at user-specified coordinates, or as the mean of the range of altitude values if no coordinates are specified.

# use mapply to apply points2terrainStats function to each point cloud
# while providing the coordinates of each center
metrics_terrain <- mapply(function(x, y) {
  lidaRtRee::terrain_points_metrics(x, plots[y, c("X", "Y")], p_radius)
},
x = llas_ground,
y = as.list(1:length(llas_ground)),
SIMPLIFY = FALSE
)
# bind results in data.frame
metrics_terrain <- do.call(rbind, metrics_terrain)
#
# compute terrain stats without specifying centre
metrics_terrain2 <- lapply(llas_ground, lidaRtRee::terrain_points_metrics)
metrics_terrain2 <- do.call(rbind, metrics_terrain2)
# display results for comparison
head(cbind(metrics_terrain, metrics_terrain2), n = 3)

Check field inventory data

Below are some checks that can be performed to correct possible errors in the field data.

Consistency with the inventory protocol (all trees)

To ensure that all trees were correctly inventoried according to the protocol :

• If the distance of the tree to the plot center was recorded, the horizontal distance between the plot center and the tree center has to be checked to make sure the tree is included in the 15 meter radius.

• Diameters can also be checked to avoid that trees below the DBH limit remain in the inventory.

summary(trees[, c("diameter_cm", "horiz_dist_m")])

Once values have been checked for potential writing errors, remaining errors should be removed.

nb_trees <- nrow(trees)
# keep only trees inside plot
trees <- trees[trees$horiz_dist_m <= p_radius, ]
# keep trees above the DBH limit
trees <- trees[trees$diameter_cm >= dbh_min, ]

In this case r nb_trees - nrow(trees) trees were removed.

Consistency of trees azimuth and slope to center (by plot)

If tree 3D spherical coordinates have been recorded, azimuth can be checked against slope. For each plot, if the slope and azimuth are constant on the whole surface, then plotting the tree slope from the plot center against the tree azimuth from the plot center should draw a sinusoid-shaped point cloud. Outliers are likely to be errors in slope or azimuth values. For trees located close to the plot center, slope measurement precision is lower, so that larger deviation might be accepted.

# example plot to test
plot_test <- "Verc-01-1"
# plot slope as a function of azimuth,
# symbol size proportional to horizontal distance from center
plot(slope_gr ~ azimuth_gr,
  data = trees, subset = which(trees$plot_id == plot_test),
  cex = horiz_dist_m / p_radius, main = "Trees slope and azimuth to plot center"
)

The following lines create a sf spatial polygon corresponding to one plot extent.

# extract example plot
plots_sf.t <- plots_sf[plots_sf$plot_id == plot_test, ]
# create polygon with buffer of plot radius
plots_extent_t <- sf::st_buffer(plots_sf.t, p_radius, nQuadSegs = 10)

Consistency of field operator path (by plot)

In case trees have been numbered in the order of inventory on the field, plotting tree positions with lines linking the trees in the order of inventory should trace the path of field operators. Any detour might indicate an error in distance or azimuth values.

# extraction of trees of plot to test
trees_t <- trees[trees$plot_id == plot_test, ]
# display plot limits
plot(sf::st_geometry(plots_extent_t), border = "red", axes = TRUE)
# display plot center
plot(sf::st_geometry(plots_sf.t), col = "red", pch = 3, add = TRUE)
# add inventoried trees
lidaRtRee::plot_tree_inventory(trees_t[, c("X", "Y")],
  trees_t$height_m,
  species = as.character(trees_t$species),
  # pch = as.numeric(trees_t$appearance) - 1,
  add = TRUE
)
# draw lines between trees
lines(trees_t[order(trees_t$tree_id), c("X", "Y")])

Height / diameter allometry (all trees)

The allometry of trees can also be checked in case heights were also measured. Plotting the heights against diameters can be informative to detect errors in diameter or height values. In this case, the information about the appearance of trees sometimes provides explanation for outliers (mostly damaged or dead trees).

# symbol size proportional to horizontal distance from center
plot(height_m ~ diameter_cm,
  data = trees,
  col = lidaRtRee::species_color()[as.character(trees$species), "col"],
  pch = as.numeric(trees$appearance) - 1,
  main = "Height VS diameter, all trees"
)
legend("bottomright",
  legend = levels(trees$appearance),
  pch = (1:length(levels(trees$appearance)) - 1)
)

The ggplot2 package provides useful syntax and functions for producing informative graphics. The next plot displays the diameter / height relationship for the three most abundant species in the dataset.

g <- ggplot(
  trees[is.element(trees$species, c("ABAL", "PIAB", "FASY")), ],
  aes(x = diameter_cm, y = height_m, shape = appearance)
)
g + geom_point(aes(color = species)) +
  scale_x_sqrt() +
  geom_smooth(aes(group = species), color = "black", linetype = "dashed") +
  facet_grid(. ~ species) +
  labs(x = "diameter_cm (sqrt scale)")

Diameter distribution (by plot)

For each plot, displaying the histogram of trees, colored by species is also informative to make sure the forest structure is coherent.

# plot diameter distribution
# remove unused levels in species factor column
trees_t$species <- factor(trees_t$species)
# stacked histogram : data.frame split by species
dummy <- split(trees_t$diameter_cm, trees_t$species)
lidaRtRee::hist_stack(dummy,
  col = lidaRtRee::species_color()[names(dummy), "col"],
  breaks = seq(
    from = dbh_min, by = 5,
    to = 5 * ceiling(max(trees_t$diameter_cm - 2.5) / 5) + 2.5
  ),
  main = paste0("Diameter distribution of plot ", plot_test),
  ylab = "Number of trees",
  xlab = "Diameter (cm)"
  # xlab and ylab not displayed: will be fixed in next release of lidaRtRee
)
legend("topright", names(dummy), fill = lidaRtRee::species_color()[names(dummy), "col"])

# plot diameter distribution
# change order of levels to display more abundant species at the bottom
trees_t$species <- factor(trees_t$species, levels = names(sort(table(trees_t$species))))
# load custom species table with associated colors
table.species <- lidaRtRee::species_color()
# extract species present on the plot
table.species <- table.species[levels(trees_t$species), "col"]
# stacked histogram : data.frame split by species
ggplot(trees_t, aes(x = diameter_cm, fill = species)) +
  geom_histogram(breaks = seq(from = 7.5, to = max(trees_t$diameter_cm) + 5, by = 5), color = "black") +
  scale_fill_manual(values = table.species) +
  labs(
    title = paste0("Diameter distribution of plot ", plot_test),
    y = "Number of trees", x = "Diameter (cm)"
  )

Trees positions and remote sensing data (by plot)

In case remote sensing data is available, plotting trees positions, sizes and species on high-resolution remote sensing background also helps in identifying errors or incoherence. Airborne laser scanning data is particularly helpful. Please refer to the field plot coregistration and tree segmentation tutorials for additional information.

The tree positions can be plotted with the canopy height model computed with the ALS data.

# compute background
# compute canopy height model
chm <- lidR::rasterize_canopy(llas_height[[plot_test]], res = 0.5, algorithm = lidR::p2r(), pkg = "terra")
# display CHM
terra::plot(chm,
  col = gray(seq(0, 1, 1 / 255)),
  main = "Canopy Height Model and tree positions"
)
# add inventoried trees
lidaRtRee::plot_tree_inventory(trees_t[, c("X", "Y")],
  trees_t$height_m,
  species = as.character(trees_t$species),
  pch = as.numeric(trees_t$appearance) - 1,
  add = TRUE
)
# display plot limits
plot(plots_extent_t, border = "red", color = NA, add = TRUE)

Similar output with ggplot2.

# convert raster to data.frame for display with ggplot
chm.df <- terra::as.data.frame(chm, xy = TRUE)
# rename columns
names(chm.df) <- c("x", "y", "CHM")
# create graph
g1 <- ggplot() +
  # raster background
  geom_raster(data = chm.df, aes(x = x, y = y, fill = CHM)) +
  # background scale in black and white
  scale_fill_gradientn(colours = c("black", "white"), na.value = "white") +
  # add trees
  geom_point(data = trees_t, aes(x = X, y = Y, shape = appearance, size = diameter_cm, colour = species)) +#
  # shape radius (not area) proportional to diameter
  scale_radius(name = "diameter_cm") +
  # custom colors for species
  scale_colour_manual(values = table.species) +
  # shapes are empty
  scale_shape(solid = FALSE) +
  # add plot extent
  geom_sf(data = plots_extent_t, fill = NA, color = "red") +
  # specify coordinate system
  coord_sf(datum = 2154) +
  # add title
  labs(title = paste0("Map of plot ", plot_test))
print(g1)

Stand level parameters

Compute stand level forest parameters

Three stand level parameters are computed by aggregating the tree level information at the plot level:

• basal area (G_m2_ha, m^2^/ha)

• mean diameter (D_mean_cm, cm)
• stem density (N_ha, /ha).

Only live trees are considered in this analysis.

# keep only live trees
trees <- trees[is.element(trees$appearance, c("live", "live with broken treetop")), ]
# Basal area in m2/ha
dummy <- aggregate(diameter_cm ~ plot_id, trees,
  FUN = function(x) {
    sum(pi * (x / 200)^2, na.rm = T) * (10000 / (pi * p_radius^2))
  }
)
# rename colum of result
names(dummy)[2] <- "G_m2_ha"
# add information to plots data.frame
plots <- merge(plots, dummy)
# Stem density in m2/ha
dummy <- aggregate(diameter_cm ~ plot_id, trees,
  FUN = function(x) {
    length(x) * (10000 / (pi * p_radius^2))
  }
)
names(dummy)[2] <- "N_ha"
plots <- merge(plots, dummy)
# Mean diameter in cm
dummy <- aggregate(diameter_cm ~ plot_id, trees,
  FUN = function(x) {
    mean(x)
  }
)
names(dummy)[2] <- "D_mean_cm"
plots <- merge(plots, dummy)
# Summary statistics
summary(plots[, c("G_m2_ha", "N_ha", "D_mean_cm")])
# display histograms
par(mfrow = c(1, 3))
hist(plots$G_m2_ha, main = "Basal area", xlab = "(m2/ha)", ylab = "Plot number")
hist(plots$N_ha, main = "Stem density", xlab = "(/ha)", ylab = "Plot number")
hist(plots$D_mean_cm, main = "Mean diameter", xlab = "(cm)", ylab = "Plot number")

Add stratum information from external data

In this area, public forests are generally managed in a different way compared to private forests, resulting in different forest structures. Ownership is also linked to species composition. This classification could be used as a stratification when calibrating relationships between ALS metrics and forest parameters.

Plots will be attributed to strata based on external GIS layers. The first layer is a vector map of public forests (Forêts publiques, ONF Paris, 2019) which is available under the Open Licence Etalab Version 2.0.

The following lines load the public forests layer and intersects it with the plot locations.

# load GIS layer of public forests
public <- sf::st_read("../data/aba.model/GIS/Public4Montagnes.shp", stringsAsFactors = TRUE, quiet = TRUE)
# set coordinate system
sf::st_crs(public) <- 2154
# spatial query
plots_sf <- sf::st_join(plots_sf, public)
# rename column and levels
plots_sf$stratum <- factor(ifelse(is.na(plots_sf$FID), "private", "public"))
# also add to data.frame
plots <- merge(plots, sf::st_drop_geometry(plots_sf[, c("plot_id", "stratum")]))
# remove column
plots_sf$FID <- NULL

The following map displays the plots colored based on ownership, after spatial extraction of this information from the polygons of public forests (black borders).

# project points into map system
markers <- sf::st_transform(plots_sf, 4326)
public_transform <- sf::st_transform(public, 4326)
# display plots
m <- leaflet(markers) %>%
  addTiles() %>%
  addCircleMarkers(radius = 4,
                   color = ifelse(markers$stratum == "public", "green", "blue"),
                   fillOpacity = 1) %>%
  addPolygons(data = sf::st_geometry(public_transform),
              color = "black",
                weight = 1, smoothFactor = 0.5,
                opacity = 1.0, fillColor = "green"
    )
m

Save data before next tutorial

The following lines save the data required for the area-based model calibration step.

save(plots, file = "../data/aba.model/output/plots.rda")
save(llas_height,
  file = "../data/aba.model/output/llas_height.rda",
  compress = "bzip2"
)
save(metrics_terrain, file = "../data/aba.model/output/metrics_terrain.rda")