# Inventário: estimativa de altura e totalização de parcelas

Vamos utilizar dados de inventário, e calcular o volume, e demais variávies por parcela.

    library(forestmangr)
    library(dplyr)
    data(exfm9)
    dados <- exfm9
    dados
    #> # A tibble: 900 × 14
    #>   MAP     PROJECT STRATA GENCODE STRATA_AREA PLANTING_DATE SPACING  PLOT
    #>   <chr>     <int>  <int> <fct>         <int> <date>        <fct>   <int>
    #> 1 FOREST1       1      2 FLO014           45 2007-04-01    3x3         1
    #> 2 FOREST1       1      2 FLO014           45 2007-04-01    3x3         1
    #> 3 FOREST1       1      2 FLO014           45 2007-04-01    3x3         1
    #> 4 FOREST1       1      2 FLO014           45 2007-04-01    3x3         1
    #> 5 FOREST1       1      2 FLO014           45 2007-04-01    3x3         1
    #> 6 FOREST1       1      2 FLO014           45 2007-04-01    3x3         1
    #> # ℹ 894 more rows
    #> # ℹ 6 more variables: MEASUREMENT_DATE <date>, PLOT_AREA <int>, PIT <int>,
    #> #   DBH <dbl>, TH <dbl>, OBS <fct>

O primeiro passo é estimar a altura das árvores não medidas. Vamos avaliar dois modelos. O de Henricksen: \[ Ln(H) = \beta_0 + \beta_1*Ln(H) \]

E o de Campos & Leite, com altura dominante: \[ Ln(H) = \beta_0 + \beta_1*\frac{1}{dbh} + \beta_2*Ln(DH) \] Para utilizar este modelo, primeiro precisamos calcular a altura dominante de cada parcela. Para isso vamos utilizar a função `dom_height`. Nela informamos o dataframe, e as variáveis altura, dap, parcela, e observação. A variável observação é referente à qualidade da árvore, se ela é normal, dominante, bifurcada, etc. Além disso, fornecemos o código utilizado para definir as variáveis dominantes. Neste caso, o código utilziado foi `"dom"`:

    dom_height(df=dados,th="TH",dbh="DBH",plot="PLOT",obs="OBS",dom="D")
    #> # A tibble: 10 × 2
    #>    PLOT    DH
    #>   <int> <dbl>
    #> 1     1  25.0
    #> 2     2  23.8
    #> 3     3  20.7
    #> 4     4  20.0
    #> 5     5  19.6
    #> 6     7  24.4
    #> # ℹ 4 more rows

Agora que conhecemos o valor da altura dominante, podemos rodar a função novamente, porém utilizando o argumento `merge_data` como `TRUE`, para unir a variável aos dados diretamente:

    dados <- dom_height(dados,"TH","DBH","PLOT","OBS","D",merge_data = TRUE)
    head(as.data.frame(dados))
    #>       MAP PROJECT STRATA GENCODE STRATA_AREA PLANTING_DATE SPACING PLOT
    #> 1 FOREST1       1      2  FLO014          45    2007-04-01     3x3    1
    #> 2 FOREST1       1      2  FLO014          45    2007-04-01     3x3    1
    #> 3 FOREST1       1      2  FLO014          45    2007-04-01     3x3    1
    #> 4 FOREST1       1      2  FLO014          45    2007-04-01     3x3    1
    #> 5 FOREST1       1      2  FLO014          45    2007-04-01     3x3    1
    #> 6 FOREST1       1      2  FLO014          45    2007-04-01     3x3    1
    #>   MEASUREMENT_DATE PLOT_AREA PIT  DBH   TH OBS    DH
    #> 1       2012-09-04       810   1 15.0 23.8   N 25.04
    #> 2       2012-09-04       810   2 13.0 23.8   N 25.04
    #> 3       2012-09-04       810   3 15.0 24.7   N 25.04
    #> 4       2012-09-04       810   4 13.5 23.3   N 25.04
    #> 5       2012-09-04       810   5 15.0 24.3   N 25.04
    #> 6       2012-09-04       810   6 14.0 22.4   N 25.04

Agora podemos ajustar os modelos hipsométricos. Vamos ajustá-los utilizando `lm_table`. A função `forestmangr::inv` nos permite ajustar o modelo de Campos & Leite sem a necessidade de criar novas variáveis:

    dados <- dados %>%
      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(dados)
    #>       MAP PROJECT STRATA GENCODE STRATA_AREA PLANTING_DATE SPACING PLOT
    #> 1 FOREST1       1      2  FLO014          45    2007-04-01     3x3    1
    #> 2 FOREST1       1      2  FLO014          45    2007-04-01     3x3    1
    #> 3 FOREST1       1      2  FLO014          45    2007-04-01     3x3    1
    #> 4 FOREST1       1      2  FLO014          45    2007-04-01     3x3    1
    #> 5 FOREST1       1      2  FLO014          45    2007-04-01     3x3    1
    #> 6 FOREST1       1      2  FLO014          45    2007-04-01     3x3    1
    #>   MEASUREMENT_DATE PLOT_AREA PIT  DBH   TH OBS    DH       CL Henricksen
    #> 1       2012-09-04       810   1 15.0 23.8   N 25.04 24.60879   22.98647
    #> 2       2012-09-04       810   2 13.0 23.8   N 25.04 23.42624   20.75027
    #> 3       2012-09-04       810   3 15.0 24.7   N 25.04 24.60879   22.98647
    #> 4       2012-09-04       810   4 13.5 23.3   N 25.04 23.74891   21.31799
    #> 5       2012-09-04       810   5 15.0 24.3   N 25.04 24.60879   22.98647
    #> 6       2012-09-04       810   6 14.0 22.4   N 25.04 24.05250   21.87975

Obs: a função lm_table verifica se o modelo possui log na variável y, e caso possua, ele o retira automaticamente. Por isso, não há a necessidade de calcular a exponencial dos dados estimados.

Vamos verificar a qualidade dos ajustes utilizando a função `resid_plot`. Árvores não medidas serão removidas automaticamente:

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

O modelo de campos & leite foi melhor, portanto vamos utilizá-lo.

Agora podemos estimar a altura das árvores não medidas, utilizando `dplyr::mutate` e `ifelse`:

     dados <- dados %>%
      mutate( TH_EST = ifelse(is.na(TH), CL, TH ), CL=NULL,Henricksen=NULL )
    head(dados)
    #>       MAP PROJECT STRATA GENCODE STRATA_AREA PLANTING_DATE SPACING PLOT
    #> 1 FOREST1       1      2  FLO014          45    2007-04-01     3x3    1
    #> 2 FOREST1       1      2  FLO014          45    2007-04-01     3x3    1
    #> 3 FOREST1       1      2  FLO014          45    2007-04-01     3x3    1
    #> 4 FOREST1       1      2  FLO014          45    2007-04-01     3x3    1
    #> 5 FOREST1       1      2  FLO014          45    2007-04-01     3x3    1
    #> 6 FOREST1       1      2  FLO014          45    2007-04-01     3x3    1
    #>   MEASUREMENT_DATE PLOT_AREA PIT  DBH   TH OBS    DH TH_EST
    #> 1       2012-09-04       810   1 15.0 23.8   N 25.04   23.8
    #> 2       2012-09-04       810   2 13.0 23.8   N 25.04   23.8
    #> 3       2012-09-04       810   3 15.0 24.7   N 25.04   24.7
    #> 4       2012-09-04       810   4 13.5 23.3   N 25.04   23.3
    #> 5       2012-09-04       810   5 15.0 24.3   N 25.04   24.3
    #> 6       2012-09-04       810   6 14.0 22.4   N 25.04   22.4

Para estimar o volume, vamos pegar uma equação ajustada previamente com dados de cubagem, e salvá-la em um dataframe:

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

Agora para volume sem casca:

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

Agora vamos estimar área basal, idade, e volume:

    dados <- dados %>%
        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(dados)
    #>       MAP PROJECT STRATA GENCODE STRATA_AREA PLANTING_DATE SPACING PLOT
    #> 1 FOREST1       1      2  FLO014          45    2007-04-01     3x3    1
    #> 2 FOREST1       1      2  FLO014          45    2007-04-01     3x3    1
    #> 3 FOREST1       1      2  FLO014          45    2007-04-01     3x3    1
    #> 4 FOREST1       1      2  FLO014          45    2007-04-01     3x3    1
    #> 5 FOREST1       1      2  FLO014          45    2007-04-01     3x3    1
    #> 6 FOREST1       1      2  FLO014          45    2007-04-01     3x3    1
    #>   MEASUREMENT_DATE PLOT_AREA PIT  DBH   TH OBS    DH TH_EST        CSA  AGE
    #> 1       2012-09-04       810   1 15.0 23.8   N 25.04   23.8 0.01767146 66.1
    #> 2       2012-09-04       810   2 13.0 23.8   N 25.04   23.8 0.01327323 66.1
    #> 3       2012-09-04       810   3 15.0 24.7   N 25.04   24.7 0.01767146 66.1
    #> 4       2012-09-04       810   4 13.5 23.3   N 25.04   23.3 0.01431388 66.1
    #> 5       2012-09-04       810   5 15.0 24.3   N 25.04   24.3 0.01767146 66.1
    #> 6       2012-09-04       810   6 14.0 22.4   N 25.04   22.4 0.01539380 66.1
    #>         VWB      VWOB
    #> 1 0.2011052 0.1761617
    #> 2 0.1534627 0.1338786
    #> 3 0.2079921 0.1822010
    #> 4 0.1616611 0.1411803
    #> 5 0.2049342 0.1795194
    #> 6 0.1670810 0.1460599

Agora, para totalizar as parcelas, utlizamos `plot_summarise`, informando as variáveis parcela, área da parcela, dap, altura,área total,volume com casca, volume without bark, altura dominante e idade. Iremos obter com isso as variáveis dap, diâmetro quadrático, altura e altura dominante média por parcela. Além de número de indivíduos, volume total com e sem casca, e área basal por parcela e por hectare.

    tab_invt <- plot_summarise(df=dados,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))
    #>   PLOT AGE STRATA_AREA PLOT_AREA     DBH       q  TH_EST    DH Indv   Indvha
    #> 1    1  66          45       810 14.1722 14.2196 24.0004 25.04   90 1111.111
    #> 2    2  66          45       810 14.4494 14.5235 23.3723 23.76   90 1111.111
    #> 3    3  63          45       810 12.8539 12.8902 19.9767 20.70   90 1111.111
    #> 4    4  63          51       810 12.2833 12.3285 18.9652 19.98   90 1111.111
    #> 5    5  63          51       810 12.6389 12.6939 18.8658 19.60   90 1111.111
    #> 6    7  66          45       810 14.7584 14.8135 23.9202 24.40   90 1111.111
    #>        G    G_ha     VWB   VWB_ha    VWOB  VWOB_ha
    #> 1 1.4292 17.6450 16.5503 204.3245 14.4789 178.7514
    #> 2 1.4744 18.2028 16.6473 205.5216 14.5737 179.9222
    #> 3 1.1614 14.3388 11.5018 141.9973 10.0318 123.8493
    #> 4 1.0744 13.2638 10.2121 126.0759  8.8958 109.8248
    #> 5 1.1390 14.0618 10.7609 132.8508  9.3818 115.8243
    #> 6 1.5339 18.9371 17.6205 217.5366 15.4333 190.5350