The hardware and bandwidth for this mirror is donated by METANET, the Webhosting and Full Service-Cloud Provider.
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[@]metanet.ch.

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

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.