The hardware and bandwidth for this mirror is donated by dogado GmbH, the Webhosting and Full Service-Cloud Provider. Check out our Wordpress Tutorial.
If you wish to report a bug, or if you are interested in having us mirror your free-software or open-source project, please feel free to contact us at mirror[@]dogado.de.

Evaluating yield and growth

First we load the packages and data:

library(forestmangr)
library(dplyr)
data(exfm16)

data_ex <- exfm16
data_ex
#> # A tibble: 139 × 7
#>   strata  plot   age    DH     N     V     B
#>    <int> <int> <dbl> <dbl> <int> <dbl> <dbl>
#> 1      1     1  26.4  12.4  1020  19.7   5.7
#> 2      1     1  38.4  17.2  1020  60.8   9.8
#> 3      1     1  51.6  19.1  1020 103.   13.9
#> 4      1     1  63.6  21.8  1020 136.   15.3
#> 5      1     2  26.4  15     900  27.3   6  
#> 6      1     2  38.4  20.3   900  80    10.5
#> # ℹ 133 more rows

The objetive of this vignette is to estimate future basal area and volume, using Clutter’s model.

\[ \left\{ \begin{array}{ll} Ln(B_2) = LnB_1\begin{pmatrix} \frac{I_1}{I_2} \end{pmatrix} + \alpha_0\begin{pmatrix} 1 - \frac{I_1}{I_2} \end{pmatrix} + \alpha_1\begin{pmatrix} 1 - \frac{I_1}{I_2} \end{pmatrix} S + ln(\varepsilon_2)\\ Ln(V_2) = \beta_0 + \beta_1 \begin{pmatrix} \frac{1}{I_2}\end{pmatrix} + \beta_2 S + \beta_3 Ln(B_2) + Ln(\varepsilon_1) \end{array} \right. \]

To achieve this, first we need to estimate site. Let’s use Chapman & Richards’ model for this:

\[ DH = \beta_0 * (1 - exp^{-\beta_1 * Age})^{\beta_2} \]

This is a non-linear model, thus, we’ll use the nls_table function to fit it, obtain it’s coefficients and estimate the site using it’s equation and the index age:

\[ S = DH* \frac{(1 - exp^{- \frac{ \beta_1}{Age} })^{\beta_2}} {(1 - exp^{- \frac{ \beta_1}{IndexAge}})^{\beta_2}} \]

We’ll use an index age of 64 months.

index_age <- 64
data_ex <-  data_ex %>% 
  nls_table(DH ~ b0 * (1 - exp( -b1 * age )  )^b2, 
            mod_start = c( b0=23, b1=0.03, b2 = 1.3), 
            output = "merge" ) %>% 
  mutate(S = DH *( (  (1- exp( -b1/age ))^b2   ) / 
                     (( 1 - exp(-b1/index_age))^b2 ))  ) %>% 
  select(-b0,-b1,-b2)
head(data_ex)
#>   strata plot  age   DH    N     V    B        S
#> 1      1    1 26.4 12.4 1020  19.7  5.7 22.48027
#> 2      1    1 38.4 17.2 1020  60.8  9.8 24.24290
#> 3      1    1 51.6 19.1 1020 103.4 13.9 22.07375
#> 4      1    1 63.6 21.8 1020 136.5 15.3 21.89203
#> 5      1    2 26.4 15.0  900  27.3  6.0 27.19388
#> 6      1    2 38.4 20.3  900  80.0 10.5 28.61226

Now that we’ve estimated the site variable, we can fit Clutter’s model:

coefs_clutter <- fit_clutter(data_ex, "age", "DH", "B", "V", "S", "plot")
coefs_clutter
#>         b0        b1        b2       b3       a0         a1
#> 1 1.398861 -28.84038 0.0251075 1.241779 1.883471 0.05012873

Now we can divide the data into classes, and calculate the production for each class with this model:

First, we classfy the data:

data_ex_class <- classify_site(data_ex, "S", 3, "plot")
head(data_ex_class)
#>   plot site_mean strata  age   DH    N    V    B       S interval category
#> 1   35   21.4510      2 44.4 18.8  740 40.6  6.5 24.0354 25.07877        1
#> 2   35   21.4510      2 55.2 19.1  720 50.4  7.4 21.0958 25.07877        1
#> 3   35   21.4510      2 68.4 20.1  720 62.2  8.5 19.2218 25.07877        1
#> 4   24   22.0728      2 30.0 13.5 1040 24.3  6.0 22.4604 25.07877        1
#> 5   24   22.0728      2 40.8 17.5 1040 54.8  8.9 23.6813 25.07877        1
#> 6   24   22.0728      2 52.8 19.0 1040 76.6 10.9 21.6216 25.07877        1
#>   category_
#> 1     Lower
#> 2     Lower
#> 3     Lower
#> 4     Lower
#> 5     Lower
#> 6     Lower

Now, we estimate basal area and volume with the est_clutter function. We’ll also calculate the Monthly Mean Increment (MMI) and Current Monthly Increment (CMI) values.

We input the data, a vector for the desired age range, and the basal area, site classification variables, and a vector with the Clutter function fitted coefficients, created previously:

data_ex_est <- est_clutter(data_ex_class, 20:125,"B", "S", "category_", coefs_clutter) 
data_ex_est
#> # A tibble: 318 × 10
#> # Groups:   category_ [3]
#>   category_  Site G_mean   Age LN_B2_EST B2_EST V2_EST   CMI   MMI CMI_MMI
#>   <chr>     <dbl>  <dbl> <int>     <dbl>  <dbl>  <dbl> <dbl> <dbl>   <dbl>
#> 1 Lower      23.0   9.13    20      2.21   9.13   26.6 NA     1.33   NA   
#> 2 Lower      23.0   9.13    21      2.25   9.48   29.8  3.24  1.42    1.82
#> 3 Lower      23.0   9.13    22      2.28   9.81   33.1  3.30  1.50    1.79
#> 4 Lower      23.0   9.13    23      2.31  10.1    36.4  3.33  1.58    1.75
#> 5 Lower      23.0   9.13    24      2.34  10.4    39.8  3.35  1.66    1.70
#> 6 Lower      23.0   9.13    25      2.37  10.7    43.2  3.36  1.73    1.64
#> # ℹ 312 more rows

We can also create a plot for the technical age of cutting for each class:

est_clutter(data_ex_class, 20:125,"B", "S", "category_", coefs_clutter,output="plot")

These binaries (installable software) and packages are in development.
They may not be fully stable and should be used with caution. We make no claims about them.
Health stats visible at Monitor.