Forest Inventory: Height estimation and plot summarise"
In forestmangr: Forest Mensuration and Management

knitr::opts_chunk$set(collapse = T, comment = "#>")
knitr::opts_chunk$set(fig.width=7, fig.height=5)
options(tibble.print_min = 6L, tibble.print_max = 6L)
library(forestmangr)
library(dplyr)

For this example we'll use forest inventory data, calculate volume and other variables for each plot.

library(forestmangr)
library(dplyr)
data(exfm9)
data_ex <- exfm9
data_ex

The first step is to estimate the height of non measured trees. We'll evaluate two hypsometric models. Henricksen's: $$ Ln(H) = \beta_0 + \beta_1*Ln(H) $$

And Campos & Leite's model, which uses dominant height: $$ Ln(H) = \beta_0 + \beta_1\frac{1}{dbh} + \beta_2Ln(DH) $$ In order to use this model, first we'll need to calculate the dominant height for each plot. To do this we'll use the dom_height function. In it we'll input the dataset, and height, dbh, plot and observation variables. The observation variable refers to the quality or classification of the tree, i.e., if it's normal, forked, dead or dominant. In addition to that, we'll also input the code used to distinguish dominant trees. In this dataset, the code is "dom".

dom_height(df=data_ex,th="TH",dbh="DBH",plot="PLOT",obs="OBS",dom="D")

Now that we've seen the dominant height of each plot, we can run the function again, but this time set the merge_data argument as TRUE, to bind the variable to the data directly:

data_ex <- dom_height(data_ex,"TH","DBH","PLOT","OBS","D",merge_data = TRUE)
head(as.data.frame(data_ex))

Now we can fit the hypsometric models. We'll fit them using the lm_table function. the function forestmangr::inv will allow us to fit the Campos & Leite model without creating a new variable for 1/dbh:

data_ex <- data_ex %>% 
  lm_table(log(TH) ~ inv(DBH) + log(DH),output="merge_est",est.name="CL") %>% 
  lm_table(log(TH) ~ log(DBH), output="merge_est",est.name="Henricksen") 
head(data_ex)

Ps: The lm_table function checks if the model has log in the y variable, and if it does, it removes it automatically when estimating variables. Because of that, there's no need to calculate the exponential for the estimated variables.

We'll evaluate the quality of the fitted values using resid_plot. Non measured trees will be removed automatically:

resid_plot(data_ex, "TH", "CL","Henricksen")

Campos & Leite's model was superior, thus, it will be used.

Now we can estimate the height of non measured trees, using dplyr::mutate and ifelse:

 data_ex <- data_ex %>% 
  mutate( TH_EST = ifelse(is.na(TH), CL, TH ), CL=NULL,Henricksen=NULL )
head(data_ex)

To estimate the volume with bark, we'll take a previously fitted equation, and save it in a data frame:

tabcoef_vwb <- data.frame(b0=-9.595863,b1=1.889372,b2=0.9071631)
tabcoef_vwb

And do the same for volume without bark:

tabcoef_vwob <- data.frame(b0=-9.808975,b1=1.918007,b2=0.908154)
tabcoef_vwob

Now we'll estimate volume, basal area and age:

data_ex <- data_ex %>% 
    mutate(CSA = pi*DBH^2/40000,
         AGE = as.numeric(MEASUREMENT_DATE - PLANTING_DATE) / 30,
         VWB = exp(tabcoef_vwb$b0 + tabcoef_vwb$b1*log(DBH) + tabcoef_vwb$b2*log(TH_EST) ),
         VWOB = exp(tabcoef_vwob$b0 + tabcoef_vwob$b1*log(DBH) + tabcoef_vwob$b2*log(TH_EST) ) )
head(data_ex)

To summarise the plots, we'll use plot_summarise. We'll input the dataset, and variables such as plot, plot area, dbh, height, total area, volume with bark, volume without bark, dominant height and age. With this, the function will calculate for each plot the mean diameter, quadratic diameter, mean height and mean dominant height. It will also calculate to total number of individuals, basal area and volume with and without bark for each plot, and extrapolate it to hectares.

tab_invt <- plot_summarise(df=data_ex,plot="PLOT",plot_area="PLOT_AREA",dbh="DBH",                           th="TH_EST",total_area="STRATA_AREA",vwb="VWB",vwob="VWOB",dh="DH",age="AGE")
head(as.data.frame(tab_invt))