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.

Avaliando crescimento e produção

Primeiro Carregamos os pacotes e dados:

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

dados <- exfm16
dados
#> # 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

O 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.61226

Com 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.05012873

Agora, 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     Lower

Agora, 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 × 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

Podemos 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")

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.