R/examples/INFCvpe_e.R

In npuletti/ForIT: Functions to estimate tree volume and phytomass in the Italian forest inventory 2005

# COMPARE WITH Tabacchi (2011a) page 25 ----
(v <- INFCvpe("ACRCA", dbh.cm = 22, htot.m = 14))
# [1] 252.9581
# attr(,"pag")
# [1] 231
# attr(,"wrv")
# [1] 2.271e-05
# attr(,"Var_ea")
# [1] 33.17182
# attr(,"Var_ie")
# [1] 1075.883
# attr(,"InDomain")
# [1] TRUE

# Standard Error of the Estimate
see <- sqrt(attr(v, "Var_ie"))
# Degrees of freedom
df <- INFCcatalog$n_oss[INFCcatalog$pag == attr(v, "pag")] -
      INFCcatalog$n_par[INFCcatalog$pag == attr(v, "pag")]
# confidence level
p <- 95/100
# Confidence Interval Half Width
cihw <- qt(1-(1-p)/2, df) * see
cat(" *** Volume confidence interval (p = ", p*100, "%) is [", round(v, 1),
    " +/- ", round(cihw, 1), "] dm^3\n", sep = "")

# ESTIMATION OF PHYTOMASS ----
Quantities[5,] %>% as.data.frame()
#   quantity         quantity_definition
# 1      dw4 phytomass of the whole tree [kg]
tree_phy <- INFCvpe(c("ACRCA", "ALUCO"),
                    dbh.cm = c(22, 15),
                    htot.m = c(14, 16),
                    quantity = "dw4")
tree_phy
# [1] 185.1291  87.7970
# attr(,"pag")
# [1] 231 245
# attr(,"wrv")
# [1] 3.142e-05 2.104e-05
# attr(,"Var_ea")
# [1] 45.89002  9.12407
# attr(,"Var_ie")
# [1] 1488.5135  281.8072
# attr(,"InDomain")
# [1] TRUE TRUE

# PROCESSING A TALLY DATA-FRAME ----
data("ForIT_test_data")
tst_vol <- ForIT_test_data %>%
  dplyr::mutate(vol = INFCvpe(specie, d130, h_dendro),
         OutOfDomain = !attr(vol, "InDomain"))
tst_vol %>%
  dplyr::filter(OutOfDomain)
tst_vol %>%
  dplyr::filter(UC == "U1")

# SUMS AND ACCUARACY AGGREGATION (see ?INFCvpeSUM) ----
df <- function(pag) return(
  INFCcatalog %>%
    dplyr::right_join(tibble::tibble(pag = !!pag), by = "pag") %>%
    dplyr::transmute(df = n_oss - n_par) %>%
    purrr::pluck(1)
)
p <- 95/100
tst_vol %>%
  dplyr::mutate(cihw = qt(1-(1-p)/2,
                   df(attr(vol, "pag"))) *
                sqrt(attr(vol, "Var_ie"))
         ) %>%
  dplyr::filter(!OutOfDomain) %>%
  dplyr::group_by(specie) %>%
  dplyr::summarise(.groups = "drop",
            est = sum(vol),
            cihw = sqrt(sum(cihw^2)),
            ) %>%
  dplyr::mutate(specie = factor(specie,
                                levels = c("ACROP", "ABIAL", "FAUSY"),
                                labels = c("aceri", "abete bianco", "faggio"),
                                ordered = TRUE),
                dplyr::across(c("est", "cihw"), ~round(.x, 1))
  ) %>%
  dplyr::arrange(specie) %>%
  t()
rm(tst_vol)