---
title: "SimpleForest"
output: rmarkdown::html_vignette
vignette: >
  %\VignetteIndexEntry{SimpleForest}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

```{r, include = FALSE}
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)
```

## Background

Real Twig was designed and tested using QSMs created with the [TreeQSM](https://github.com/InverseTampere/TreeQSM) modeling software. However, if a QSM provides parent-child cylinder relationships, Real Twig will work, as is the case of the [SimpleForest](https://www.simpleforest.org/) software. If high quality point clouds, QSMs with the proper input settings, and species specific twig diameter measurements are supplied, you can expect to get good estimates of tree volume.

While Real Twig can provide excellent tree volume estimates, it can not transform poor quality data into good data. As a general rule of thumb, the closer the QSM resembles the actual tree before correction, the better the results will be after correction. Real Twig performs best when the topology of the tree is mostly correct, and only the cylinder sizes are the main sources of QSM error. Errors in QSM topology become readily apparent after correction, so Real Twig can also be used to visually validate QSM topology without reference data.

## Installation

You can install the package directly from [CRAN](https://CRAN.R-project.org):

```{r, eval=FALSE}
install.packages("rTwig")
```

Or the latest development version from [GitHub](https://github.com/):

```{r, eval=FALSE}
devtools::install_github("https://github.com/aidanmorales/rTwig")
```

## Load Packages

The first step is to load the rTwig package. Real Twig works well when paired with packages from the [Tidyverse](https://www.tidyverse.org/), so we will also load the dplyr package to help with data manipulation.

```{r, message=FALSE, warning=FALSE}
# Load rTwig
library(rTwig)

# Other useful packages
library(dplyr)
```

```{r, echo=FALSE, message=FALSE}
# Plotting Packages
library(tidyr)
library(ggplot2)
library(ggpubr)
library(ggpmisc)
library(yardstick)
library(gt)
```

## Import QSM

SimpleForest exports its QSMs as .csv files, so they are easy to load into R using the built in `read.csv()` function. If the QSM contains thousands of cylinders, it is much faster to use the `fread()` function from the `data.table` package to take advantage of multi-threaded support. 


```{r, message=FALSE}
# QSM directory
file <- system.file("extdata/QSM.csv", package = "rTwig")

# Import and save QSM cylinder data
cylinder <- read.csv(file)
```

Let's take a look at the SimpleForest cylinder data.

```{r, message=FALSE}
str(cylinder)
```

## Cylinder Data

Next, we have to update the parent-child ordering in the cylinder data to allow for path analysis. We need the first cylinder ID to have an index of 0. Let's update the cylinders using the `update_cylinders()` function and check to make sure the parent-child ordering is sequential without any gaps. Many of the extra QSM variables are all ready included with SimpleForest QSMs, so they are only calculated in this step if they are missing. 

```{r, message=FALSE}
# Update cylinder data
cylinder <- update_cylinders(cylinder)

# Check ordering
cylinder %>%
  select(branchID, parentID, ID) %>%
  head()
```

## Topology

Before we correct the QSM, it is often worthwhile to check the quality of the QSM by plotting it against its input point cloud. To do this, we load the point cloud and save it as a data frame, with the first three columns as the x, y, and z columns. We do this with the `plot_qsm()` function.

```{r, eval = FALSE}
# Load the input point cloud
file <- system.file("extdata/cloud.txt", package = "rTwig")
cloud <- read.table(file, header = FALSE)

# Plot the qsm and point cloud
plot_qsm(cylinder = cylinder, cloud = cloud, radius = cylinder$radius)
```

## Twig Diameters

Before we can correct the QSM radii, we need to know what our real twig diameter is. For this example tree, the species is a Kentucky coffee tree (*Gymnocladus dioicus*), which has nice, stout twigs. rTwig comes with a data base of twigs that can be called by typing in the `twigs` data set. The data set includes the average twig radius, the min and max radius, the standard deviation, and the coefficient of variation. Let's look at the twig data set and find the twig diameter for Kentucky coffee tree.

```{r}
# Look at the twigs database
twigs

# Find our species
filter(twigs, scientific.name == "Gymnocladus dioicus")
```

## Summary Metrics

Before we correct the QSM, Let's take a look at the current metrics, so we can compare the tree volume before and after correction. We can do this with the `qsm_summary()` function. We can also make a plot of the radius versus the growth length to see how much overestimation there is in the twig radii.

```{r, message = FALSE}
# QSM summary
qsm_summary(cylinder, radius = "unmodified")
```

```{r, echo=FALSE, fig.width = 7, fig.height = 4, fig.align='center'}
# Diagnostic Plot 1
cylinder %>%
  ggplot(aes(x = growthLength, y = radius, color = growthLength)) +
  geom_point() +
  labs(
    title = "Radius vs Growth Length",
    x = "Growth Length (m)",
    y = "Radius (m)",
    color = "Growth Length"
  ) +
  theme_classic() +
  scale_y_log10() +
  scale_x_log10() +
  geom_hline(yintercept = .00423) +
  scale_color_viridis_c()
```

```{r, echo=FALSE, fig.width = 7, fig.height = 4, fig.align='center'}
# Diagnostic Plot 2
cylinder %>%
  ggplot(aes(x = growthLength, y = radius, color = branchID)) +
  geom_point() +
  facet_wrap(~branchOrder) +
  labs(
    title = "Radius vs Growth Length by Branch Order",
    x = "Growth Length (m)",
    y = "Radius (m)",
    color = "Branch"
  ) +
  theme_classic() +
  scale_y_log10() +
  scale_x_log10() +
  geom_hline(yintercept = .00423)
```

Looking at the diagnostic plot on a log log scale, with the measured twig radius as the horizontal line, we can see that all of the twig radii are overestimated, with increasing radii variation as the growth length approaches zero. There is not a very clear pattern in any of the individual branch tapers. 

## Correct Radii

Now we can correct our QSM cylinder radii with the `correct_radii()` function. In this step, we model each path in the tree separately, where poorly fit cylinders are identified and removed, and a GAM is fit, where the intercept is the measured twig radius, and the growth length predicts the cylinder radius. Let's correct the cylinder radii on our Kentucky coffee tree and look at the new volume estimates and diagnostic plots.

```{r, message = FALSE, results = 'hide'}
# Correct cylinder radii
cylinder <- correct_radii(cylinder, twigRad = 4.23)
```

```{r, r, message = FALSE}
# Corrected QSM summary
qsm_summary(cylinder, radius = "modified")
```

```{r, echo=FALSE, fig.width = 7, fig.height = 4, fig.align='center'}
# Diagnostic Plot 1
cylinder %>%
  ggplot(aes(x = growthLength, y = radius, color = growthLength)) +
  geom_point() +
  labs(
    title = "Radius vs Growth Length",
    x = "Growth Length (m)",
    y = "Radius (m)",
    color = "Growth Length"
  ) +
  theme_classic() +
  scale_y_log10() +
  scale_x_log10() +
  geom_hline(yintercept = .00423) +
  scale_color_viridis_c()
```

```{r, echo=FALSE, fig.width = 7, fig.height = 4, fig.align='center'}
# Diagnostic Plot 2
cylinder %>%
  ggplot(aes(x = growthLength, y = radius, color = branchID)) +
  geom_point() +
  facet_wrap(~branchOrder) +
  labs(
    title = "Radius vs Growth Length by Branch Order",
    x = "Growth Length (m)",
    y = "Radius (m)",
    color = "Branch"
  ) +
  theme_classic() +
  scale_y_log10() +
  scale_x_log10() +
  geom_hline(yintercept = .00423)
```

Here we can see that we reduced the volume of the QSM by around 8 liters, which is around a 36% overestimation in volume before correction. Kentucky coffee tree has relatively large twigs, so the overestimation is not as severe as a tree with much smaller twigs, that can have upwards of \>200% overestimation in some cases.

Looking at the diagnostic plot, we can see that individual branches can clearly be identified by their unique allometry. Notice how nearly all of the volume reduction occurred in the higher order branches, with the main stem remaining nearly unchanged. The branches now taper towards the measured twig radius for Kentucky coffee tree. Getting the real twig diameter is critical, as too high a value will overestimate volume, and too low a value will underestimate total volume, with the over or underestimate being proportional to the number of twigs and small branches in the tree. If your species is not available in the database, we have found that the genus level twig radius average is a good substitute. 

## Visualization

Optionally, we can smooth our QSM by ensuring all of the cylinders are connected. This is a visual change and does not affect the volume estimates. We can do this with the `smooth_qsm()` function, and plot the results with the `plot_qsm()` function. The different colors are the different branch orders. We can also color our QSM by many different variables and palettes. See the `plot_qsm()` documentation for more details. 

```{r, eval=FALSE}
# Smooth QSM
cylinder <- smooth_qsm(cylinder)

# Plot QSM
plot_qsm(cylinder)

# QSM Custom Colors & Piping
cylinder %>%
  plot_qsm(
    radius = .$radius,
    cyl_color = .$reverseBranchOrder,
    cyl_palette = "magma"
  )

# Plot Twigs Colored by Unique Segment
cylinder %>%
  filter(reverseBranchOrder == 1) %>%
  plot_qsm(
    radius = .$radius,
    cyl_color = .$reverseBranchOrder,
    cyl_palette = "rainbow"
  )
```

We can also save our QSM as a mesh (.ply extension) for use in other modeling programs with the `export_mesh()` function. The same colors and palettes found in the `plot_qsm()` function can be used to color the mesh. 

```{r, eval=FALSE}
# Export Mesh Colored by RBO
cylinder %>%
  export_mesh(
    filename = "QSM_mesh",
    radius = .$radius,
    cyl_color = .$reverseBranchOrder,
    cyl_palette = "magma"
  )

# Export Twigs Colored by Unique Segments
cylinder %>%
  filter(reverseBranchOrder == 1) %>%
  export_mesh(
    filename = "QSM_mesh",
    radius = .$radius,
    cyl_color = .$reverseBranchOrder,
    cyl_palette = "rainbow"
  )
```

## Workflow & Best Practices

Below is an overview of the typical rTwig processing chain. When dealing with multiple trees, we advise creating a master data frame in a tidy format, where each unique tree is a row, and the columns are the tree id, the directory to the QSM .csv file, and the species twig diameter, all of which can be tailored to your workflow needs. Then it is a simple matter of looping over the master data frame, correcting each tree, and saving the results to a master list. Make sure to read each function's documentation for more examples and unique features.

```{r, eval=FALSE}
# Import QSM
file <- system.file("extdata/QSM.csv", package = "rTwig")
cylinder <- read.csv(file)

# Real Twig Main Steps
cylinder <- update_cylinders(cylinder)
cylinder <- correct_radii(cylinder, twigRad = 4.23)

# Summary Metrics
qsm_summary(cylinder)

# Plot Results
plot_qsm(cylinder, color = "GrowthLength")
```

## Validation
How do we know if Real Twig returns accurate volume estimates? We can validate our method against a high quality reference data set that was both laser scanner and destructively sampled. The laser scanning was done in leaf-off conditions with a Riegl VZ-400. The destructive sampling contains total branch and main stem dry mass, and also basic density for both the main stem and the branches. 

It is important to note that Real Twig was not tested with SimpleForest during its development. While Real Twig does improve volume estimates for SimpleForest versus its built in allometric corrections, there are still improvements to be made, as SimpleForest QSM cylinders are generally much more overestimated than TreeQSM cylinders, making the identification of "good" cylinders difficult. 

Below are the mass estimates and statistics using SimpleForest v5.3.2 with its built in vessel volume correction, and Real Twig applied to the same QSMs. 

```{r, echo=FALSE, results='hide', message=FALSE, warning=FALSE}
# Import Data
file <- system.file("extdata/validation.csv", package = "rTwig")
all_biomass <- read.csv(file) %>%
  rename(Version = version)

# Distinct colors
factors <- distinct(all_biomass, Version)
cbPalette <- c("#009E73", "#CC79A7", "#56B4E9", "#999999", "#E69F00", "#009E73", "#F0E442", "#0072B2", "#D55E00")
cbPalette <- cbPalette[1:nrow(factors)]
factors <- bind_cols(factors, cbPalette) %>%
  rename(colors = 2)

# Filter Data
all_biomass <- all_biomass %>%
  left_join(factors, by = join_by(Version)) %>%
  filter(Version %in% c("SimpleForest", "Real Twig (SimpleForest)")) %>%
  mutate(id = paste0(SpCode, Tree))

# Total Biomass
p1 <- ggplot(data = all_biomass, aes(x = Mt.DS, y = Mt.TLS, color = Version, fill = Version)) +
  geom_point(aes(shape = scientific.name), ) +
  geom_smooth(method = "lm", formula = y ~ x) +
  geom_abline() +
  stat_poly_eq(aes(
    label = paste(after_stat(eq.label), after_stat(rr.label), sep = "~~~")
  )) +
  labs(
    x = "", # "Reference Biomass (kg)",
    y = "TLS Biomass (kg)",
    title = "Total",
    shape = "Species",
    color = "Method",
    fill = "Method"
  ) +
  theme_classic() +
  scale_color_manual(values = unique(all_biomass$colors)) +
  scale_fill_manual(values = unique(all_biomass$colors))

# Main Stem Biomass
p2 <- ggplot(data = all_biomass, aes(x = Md.DS, y = Md.TLS, color = Version, fill = Version)) +
  geom_point(aes(shape = scientific.name)) +
  geom_smooth(method = "lm", formula = y ~ x) +
  geom_abline() +
  stat_poly_eq(aes(
    label = paste(after_stat(eq.label), after_stat(rr.label), sep = "~~~")
  )) +
  labs(
    x = "", # "Reference Biomass (kg)",
    y = "", # "TLS Biomass (kg)",
    title = "Main Stem",
    shape = "Species",
    color = "Method",
    fill = "Method"
  ) +
  theme_classic() +
  scale_color_manual(values = unique(all_biomass$colors)) +
  scale_fill_manual(values = unique(all_biomass$colors))

# Branch Biomass
p3 <- ggplot(data = all_biomass, aes(x = Mb.DS, y = Mb.TLS, color = Version, fill = Version)) +
  geom_point(aes(shape = scientific.name)) +
  geom_smooth(method = "lm", formula = y ~ x) +
  geom_abline() +
  stat_poly_eq(aes(
    label = paste(after_stat(eq.label), after_stat(rr.label), sep = "~~~")
  )) +
  labs(
    x = "", # "Reference Biomass (kg)",
    y = "", # "TLS Biomass (kg)",
    title = "Branch",
    shape = "Species",
    color = "Method",
    fill = "Method"
  ) +
  theme_classic() +
  scale_color_manual(values = unique(all_biomass$colors)) +
  scale_fill_manual(values = unique(all_biomass$colors))

# Total Biomass % Error
p4 <- ggplot(data = all_biomass, aes(x = Mt.DS, y = tperr, color = Version, fill = Version)) +
  geom_point(aes(shape = scientific.name)) +
  geom_smooth(method = "lm", formula = y ~ x) +
  geom_hline(yintercept = 0) +
  labs(
    x = "", # "Reference Biomass (kg)",
    y = "% TLS Biomass Error",
    title = "Total % Error",
    shape = "Speces",
    color = "Method",
    fill = "Method"
  ) +
  theme_classic() +
  scale_color_manual(values = unique(all_biomass$colors)) +
  scale_fill_manual(values = unique(all_biomass$colors))

# Main Stem Biomass % Error
p5 <- ggplot(data = all_biomass, aes(x = Md.DS, y = sperr, color = Version, fill = Version)) +
  geom_point(aes(shape = scientific.name)) +
  geom_smooth(method = "lm", formula = y ~ x) +
  geom_hline(yintercept = 0) +
  labs(
    x = "Reference Biomass (kg)",
    y = "", # "% TLS Biomass Error",
    title = "Main Stem % Error",
    color = "Method",
    fill = "Method"
  ) +
  theme_classic() +
  scale_color_manual(values = unique(all_biomass$colors)) +
  scale_fill_manual(values = unique(all_biomass$colors))

# Branch Biomass % Error
p6 <- ggplot(data = all_biomass, aes(x = Mb.DS, y = tperr, color = Version, fill = Version)) +
  geom_point(aes(shape = scientific.name)) +
  geom_smooth(method = "lm", formula = y ~ x) +
  geom_hline(yintercept = 0) +
  labs(
    x = "", # "Reference Biomass (kg)",
    y = "", # "% TLS Biomass Error",
    title = "Branch % Error",
    shape = "Species",
    color = "Method",
    fill = "Method"
  ) +
  theme_classic() +
  scale_color_manual(values = unique(all_biomass$colors)) +
  scale_fill_manual(values = unique(all_biomass$colors))
```

```{r, echo=FALSE, fig.width=7, fig.height=4, fig.align='center', warning=FALSE, message=FALSE}
ggarrange(p1, p4, common.legend = TRUE, legend = "bottom")
ggarrange(p2, p5, common.legend = TRUE, legend = "bottom")
ggarrange(p3, p6, common.legend = TRUE, legend = "bottom")
```

```{r, echo=FALSE, warning=FALSE, message=FALSE}
### TOTALS #####################################################################
total_stats <- all_biomass %>%
  group_by(Version) %>%
  summarize(
    MRE.pct = mean(tperr),
    RMSE.kg = sqrt(mean(tdiff^2, na.rm = TRUE)),
    RRMSE.pct = RMSE.kg / mean(Mt.DS) * 100
  )

CCC_total <- all_biomass %>%
  group_by(Version) %>%
  ccc(Mt.TLS, Mt.DS) %>%
  select(Version, .estimate) %>%
  rename(CCC = 2)

total_stats <- left_join(total_stats, CCC_total, by = "Version") %>%
  mutate(type = "total")

### MAIN STEM ##################################################################
stem_stats <- all_biomass %>%
  group_by(Version) %>%
  summarize(
    MRE.pct = mean(sperr),
    RMSE.kg = sqrt(mean(sdif^2, na.rm = TRUE)),
    RRMSE.pct = RMSE.kg / mean(Md.DS) * 100
  )

CCC_stem <- all_biomass %>%
  group_by(Version) %>%
  ccc(Md.TLS, Md.DS) %>%
  select(Version, .estimate) %>%
  rename(CCC = 2)

stem_stats <- left_join(stem_stats, CCC_stem, by = "Version") %>%
  mutate(type = "stem")

### BRANCHES ###################################################################
branch_stats <- all_biomass %>%
  group_by(Version) %>%
  summarize(
    MRE.pct = mean(bperr),
    RMSE.kg = sqrt(mean(bdiff^2, na.rm = TRUE)),
    RRMSE.pct = RMSE.kg / mean(Mb.DS) * 100
  )

CCC_branch <- all_biomass %>%
  group_by(Version) %>%
  ccc(Mb.TLS, Mb.DS) %>%
  select(Version, .estimate) %>%
  rename(CCC = 2)

branch_stats <- left_join(branch_stats, CCC_branch, by = "Version") %>%
  mutate(type = "branch")

all_stats <- bind_rows(total_stats, stem_stats, branch_stats)

### TABLES ###################################################################
data <- all_stats %>%
  mutate_if(is.numeric, round, 3) %>%
  rename(
    "Mean Relative Error (%)" = MRE.pct,
    "RMSE (kg)" = RMSE.kg,
    "Relative RMSE (%)" = RRMSE.pct
  ) %>%
  pivot_longer(cols = 2:5, names_to = "metric", values_to = "value") %>%
  pivot_wider(names_from = type, values_from = value) %>%
  group_by(Version) %>%
  group_split()

tables <- vector(mode = "list", length(data))

data[[2]] %>%
  gt() %>%
  tab_header(title = "SimpleForest") %>%
  cols_hide(Version) %>%
  cols_label(
    metric = "Metric",
    total = "Total Woody AGB",
    stem = "Main Stem Biomass",
    branch = "Branch Biomass"
  ) %>%
  cols_align(
    align = "center",
    columns = everything()
  ) %>%
  tab_options(
    table.border.top.style = "hidden",
    table.border.bottom.style = "hidden",
    table_body.hlines.color = "white",
    table.font.color = "black",
    heading.border.bottom.color = "black",
    column_labels.border.bottom.color = "black",
    table_body.border.bottom.color = "black"
  )

data[[1]] %>%
  gt() %>%
  tab_header(title = "Real Twig (SimpleForest)") %>%
  cols_hide(Version) %>%
  cols_label(
    metric = "Metric",
    total = "Total Woody AGB",
    stem = "Main Stem Biomass",
    branch = "Branch Biomass"
  ) %>%
  cols_align(
    align = "center",
    columns = everything()
  ) %>%
  tab_options(
    table.border.top.style = "hidden",
    table.border.bottom.style = "hidden",
    table_body.hlines.color = "white",
    table.font.color = "black",
    heading.border.bottom.color = "black",
    column_labels.border.bottom.color = "black",
    table_body.border.bottom.color = "black"
  )
```

```{r, echo=FALSE, warning=FALSE, message=FALSE}
# Future Package Cleanup
future::plan("sequential")
```
