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