Commit 39cc0c46 authored by Monnet Jean-Matthieu's avatar Monnet Jean-Matthieu
Browse files

fixed bug due to layer name in forest_metrics

fixed factor raster issue
export html files
parent e23c7f08
......@@ -113,6 +113,9 @@ The `data` slot contains point attributes. Some attributes may be present or not
**`X`, `Y`, `Z`**: coordinates. The point cloud can be displayed with `lidR::plot`
```{r ALS.coordinates, eval=FALSE}
lidR::plot(point_cloud)
# with lidR 4.0.1 and rgl >= 0.108 the point cloud is not centered on bounding box
# you might consider installing an older version of rgl
# install.packages("https://cran.r-project.org/src/contrib/Archive/rgl/rgl_0.107.14.tar.gz")
```
**`gpstime`**: time of emission of the pulse associated to the echo. Provided the precision is sufficient, it allows to retrieve echoes originating from the same pulse.
......
......@@ -158,7 +158,7 @@ The next step is to compute the canopy height model (CHM). It will be used to de
The CHM is computed and NA values are replaced by 0. A check is performed to make sure low or high points are not present.
```{r computeCHM, include = TRUE, fig.width = 6, fig.height = 5, message=FALSE}
```{r computeCHM, include = TRUE, fig.width = 6, fig.height = 4.3, message=FALSE}
# compute chm
chm <- lidR::rasterize_canopy(a, res = res_chm, algorithm = lidR::p2r(), pkg = "terra")
# replace NA, low and high values
......@@ -173,7 +173,7 @@ terra::plot(chm, asp = 1, main = "Canopy height model")
The CHM is smoothed with a Gaussian filter with different `sigma` values. Smoothed results are stored in a list and then integrated ito a single raster
```{r 2dchmMetrics, include = TRUE, fig.width = 12, fig.height = 7.6, message=FALSE}
```{r 2dchmMetrics, include = TRUE, fig.width = 12, fig.height = 6.5, message=FALSE}
# for each value in list of sigma, apply filtering to chm and store result in list
st <- lapply(sigma_l, FUN = function(x) {
lidaRtRee::dem_filtering(chm, nl_filter = "Closing", nl_size = 5, sigmap = x)$smoothed_image
......@@ -216,7 +216,7 @@ terra::plot(metrics_2dchm[[c(
### Gaps and edges metrics
Gaps are computed with the function `gap_detection`.
```{r gapMetrics, include = TRUE, fig.width = 12, fig.height = 3.4, warning=FALSE, message=FALSE}
```{r gapMetrics, include = TRUE, fig.width = 12, fig.height = 2.9, warning=FALSE, message=FALSE}
# compute gaps
gaps <- lidaRtRee::gap_detection(chm,
ratio = 2, gap_max_height = 1,
......@@ -245,7 +245,7 @@ if (!all(is.na(terra::values(gaps_surface)))) {
metrics_gaps <- lidaRtRee::raster_metrics(gaps_surface,
res = resolution,
fun = function(x) {
hist(x$lyr.1,
hist(x$gap_surface,
breaks = breaks_gap_surface,
plot = F
)$counts * (res_chm / resolution)^2
......@@ -318,7 +318,7 @@ terra::plot(metrics_edges, main = "Proportion of edges")
### Tree metrics
Tree tops are detected with the function `treeSegmentation` and then extracted with `treeExtraction`.
```{r treeMetrics, include = TRUE, fig.width = 9, fig.height = 3.4, warning=FALSE, message=FALSE}
```{r treeMetrics, include = TRUE, fig.width = 9, fig.height = 3.1, warning=FALSE, message=FALSE}
# tree top detection (default parameters)
segms <- lidaRtRee::tree_segmentation(chm, hmin = 5)
# extraction to data.frame
......@@ -570,7 +570,7 @@ metrics <- future.apply::future_lapply(
gaps_surface,
res = resolution,
fun = function(x) {
hist(x$lyr.1,
hist(x$gap_surface,
breaks = breaks_gap_surface,
plot = F)$counts * (res_chm / resolution) ^
2
......
......@@ -536,25 +536,24 @@ To display the classification results, an image of the classified segments is cr
```{r display.prediction.MASS, include=TRUE, fig.width = 7, fig.height = 6}
# create image of predicted species
species <- segms$segments_id
# replace segment id by predicted species in image
species <- terra::deepcopy(segms$segments_id)
# replace segment id by id of predicted species in image
terra::values(species) <-
metrics$predicted_s[match(terra::values(segms$segments_id), metrics$seg_id)]
as.numeric(metrics$predicted_s)[match(terra::values(segms$segments_id), metrics$seg_id)]
# remove ground segment
species[segms$segments_id == 0] <- NA
# convert to factor raster
species <- terra::as.factor(species)
# build raster attribute table rat
rat <- data.frame(id = terra::levels(species)[[1]],
rat <- data.frame(id = 1:length(levels(metrics$predicted_s)),
Species = levels(metrics$predicted_s))
# retrieve reference colors
rat$col <- lidaRtRee::species_color()[rat$Species, "col"]
# set NA color to green
rat$col[is.na(rat$col)] <- "green"
levels(species)[[1]] <- rat
# convert to factor (add RAT in SpatRaster)
levels(species) <- rat
# display results
terra::plot(species, col = rat$col)
terra::plot(sf::st_geometry(crowns), add = TRUE, border = "white")
terra::plot(sf::st_geometry(crowns), add = TRUE, border = "black")
lidaRtRee::plot_tree_inventory(tree_metrics_h
[, c("x", "y")],
tree_metrics_h$h,
......@@ -775,7 +774,7 @@ resolution <- 1
apices <- lidaRtRee::tree_detection(cata, res = resolution, crown = TRUE)
# create crown polygons object
crowns <- sf::st_as_sf(sf::st_drop_geometry(apices), wkt = "crown", crs = sf::st_crs(apices))
# compute canopy height model (apply lidR::rasterize_canopy to catalog, with same resolution
# compute canopy height model (apply lidR::rasterize_canopy to catalog, with same resolution)
chm <- lidR::rasterize_canopy(cata, res = resolution)
```
......@@ -790,7 +789,7 @@ terra::plot(chm,
main = "Canopy Height Model and segments"
)
# display segments border
plot(sf::st_geometry(crowns), border = "white", add = T)
plot(sf::st_geometry(crowns), border = "black", add = T)
# add apices
plot(sf::st_geometry(apices), cex = apices$h / 40, add = TRUE, pch = 2)
```
......
This diff is collapsed.
......@@ -11,7 +11,7 @@
 
<meta name="author" content="Jean-Matthieu Monnet" />
 
<meta name="date" content="2022-05-24" />
<meta name="date" content="2022-07-19" />
 
<title>R workflow for ABA data preparation</title>
 
......@@ -365,7 +365,7 @@ pre code {
 
<h1 class="title toc-ignore">R workflow for ABA data preparation</h1>
<h4 class="author">Jean-Matthieu Monnet</h4>
<h4 class="date">2022-05-24</h4>
<h4 class="date">2022-07-19</h4>
 
</div>
 
......@@ -377,7 +377,7 @@ field measurements.</p>
page</a></p>
<p>Required <code>R</code> packages : <code>ggplot2</code>,
<code>sf</code>, <code>ggmap</code>, <code>lidaRtRee</code> (tested with
version 4.0.1) and <code>lidR</code> (tested with version 4.0.1)</p>
version 4.0.3) and <code>lidR</code> (tested with version 4.0.1)</p>
<p>Many thanks to Pascal Obstétar for checking code and improvement
suggestions.</p>
<div id="import-field-inventory-data" class="section level2">
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This source diff could not be displayed because it is too large. You can view the blob instead.
This diff is collapsed.
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment