Primeiro Carregamos os pacotes e dados:
library(forestmangr)
library(dplyr)
data(exfm16)
dados <- exfm16
dados
#> # A tibble: 139 x 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
#> # ... with 133 more rowsO objetivo aqui é estimar volume e área basal futuros, utilizando o modelo de Clutter.
\[ \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. \]
Para isso, primeiro precisamos estimar o site. Vamos utilizar o modelo de Chapman & Richards:
\[ DH = \beta_0 * (1 - exp^{-\beta_1 * Age})^{\beta_2} \]
Este modelo é não linear, portanto, vamos estima-lo com a função nls_table,obter os seus coeficientes e estimar o site utilizando a equação para site, considerando a idade índice:
\[ S = DH* \frac{(1 - exp^{- \frac{ \beta_1}{Age} })^{\beta_2}} {(1 - exp^{- \frac{ \beta_1}{IndexAge}})^{\beta_2}} \]
Vamos utilizar uma idade índice de 64 meses.
index_age <- 64
dados <- dados %>%
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(dados)
#> 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.61226Com o site estimado, podemos ajustar o modelo de Clutter:
coefs_clutter <- fit_clutter(dados, "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.05012873Agora, podemos dividir a área em classes, e verificar a produção de cada classe com o modelo.
Primeiro, vamos classificar os dados:
dados_class <- classify_site(dados, "S", 3, "plot")
head(dados_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 LowerAgora, estimamos área basal e volume com a função est_clutter. Também iremos calcular os valores de Incremento Médio Mensal (MMI) e Incremento Corrente Mensal (CMI).
Fornecemos a ela os dados, um vetor com a idade desejada, as variáveis área basal inicial, site e de classificação (criada anteriormente), e um dataframe com os coeficientes do ajuste de clutter (criado anteriormente):
dados_est <- est_clutter(dados_class, 20:125,"B", "S", "category_", coefs_clutter)
dados_est
#> # A tibble: 318 x 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
#> # ... with 312 more rowsPodemos também gerar um gráfico com a idade técnica de corte de cada classe:
est_clutter(dados_class, 20:125,"B", "S", "category_", coefs_clutter,output="plot")