tests/testthat/test_standing_area_gnfi3.R

In ForestElementsR: Data Structures and Functions for Working with Forest Data

library(ForestElementsR)


test_that("standing_area_gnfi3 works with all appropriate species codings", {

  # Original parameterization
  spec_id <- as_fe_species_ger_nfi_2012(
    fe_species_get_coding_table("ger_nfi_2012")$species_id |>
      unique()
  )

  dbh_cm <- rep(30, times = 51)

  areas_exp <- round(
    c(
      16.63373776762521671913, 16.63373776762521671913, 16.63373776762521671913,
      22.20575041173110264481, 22.20575041173110264481, 22.20575041173110264481,
      22.20575041173110264481, 22.20575041173110264481, 22.20575041173110264481,
      16.98716694115406866672, 16.98716694115406866672, 16.98716694115406866672,
      19.13716694115407079835, 25.14546289114454680202, 23.37831702350028706405,
      16.63373776762521671913, 16.63373776762521671913, 22.53575041173110093951,
      29.03090470877928197524, 29.03090470877928197524, 27.24004214701962212075,
      25.82632545290421433037, 25.82632545290421433037, 25.82632545290421433037,
      25.82632545290421433037, 25.82632545290421433037, 25.82632545290421433037,
      25.82632545290421433037, 25.82632545290421433037, 25.82632545290421433037,
      25.82632545290421433037, 25.82632545290421433037, 25.82632545290421433037,
      39.61006322052943318113, 39.61006322052943318113, 33.24833809701009812443,
      33.24833809701009812443, 45.61946710584651043519, 45.61946710584651043519,
      45.61946710584651043519, 45.61946710584651043519, 45.61946710584651043519,
      25.82632545290421433037, 25.82632545290421433037, 25.82632545290421433037,
      25.82632545290421433037, 25.82632545290421433037, 25.82632545290421433037,
      25.82632545290421433037, 25.82632545290421433037, 25.82632545290421433037
    ),
    digits = 5
  )

  expect_equal(
    round(standing_area_gnfi3(spec_id, dbh_cm), digits = 5), areas_exp
  )

  # -----
  # tum_wwk_long
  spec_id <- as_fe_species_tum_wwk_long(
    fe_species_get_coding_table("tum_wwk_long")$species_id |>
      unique()
  )

  dbh_cm <- rep(30, times = 44)

  areas_exp <- round(
    c(
      16.63373776762521671913, 16.98716694115406866672, 22.20575041173110264481,
      16.63373776762521671913, 16.63373776762521671913, 25.14546289114454680202,
      16.63373776762521671913, 16.63373776762521671913, 22.53575041173110093951,
      25.82632545290421433037, 29.03090470877928197524, 25.82632545290421433037,
      19.13716694115407079835, 25.82632545290421433037, 25.82632545290421433037,
      25.82632545290421433037, 25.82632545290421433037, 25.82632545290421433037,
      25.82632545290421433037, 33.24833809701009812443, 33.24833809701009812443,
      33.24833809701009812443, 25.82632545290421433037, 25.82632545290421433037,
      25.82632545290421433037, 25.82632545290421433037, 25.82632545290421433037,
      25.82632545290421433037, 25.82632545290421433037, 25.82632545290421433037,
      25.82632545290421433037, 25.82632545290421433037, 25.82632545290421433037,
      25.82632545290421433037, 25.82632545290421433037, 25.82632545290421433037,
      33.24833809701009812443, 33.24833809701009812443, 25.82632545290421433037,
      25.82632545290421433037, 25.82632545290421433037, 25.82632545290421433037,
      25.82632545290421433037, 16.63373776762521671913
    ),
    digits = 5
  )

  expect_equal(
      round(
        suppressWarnings( # Species cast warning is not a problem
          standing_area_gnfi3(spec_id, dbh_cm)
        ),
        digits = 5
      ),
      areas_exp
  )


  # -----
  # tum_wwk_short
  spec_id <- as_fe_species_tum_wwk_short(
    fe_species_get_coding_table("tum_wwk_short")$species_id |>
      unique()
  )

  dbh_cm <- rep(30, times = 10)

  areas_exp <- round(
    c(
      16.63373776762521671913, 16.98716694115406866672, 22.20575041173110264481,
      25.14546289114454680202, 22.53575041173110093951, 29.03090470877928197524,
      19.13716694115407079835, 25.82632545290421433037, 33.24833809701009812443,
      16.63373776762521671913
    ),
    digits = 5
  )

  expect_equal(
    round(
      suppressWarnings( # Species cast warning is not a problem
        standing_area_gnfi3(spec_id, dbh_cm)
      ),
      digits = 5),
    areas_exp
  )

  # -----
  # bavrn_state
  spec_id <- as_fe_species_bavrn_state(
    fe_species_get_coding_table("bavrn_state")$species_id |>
      unique()
  )

  dbh_cm <- rep(30, times = 45)

  areas_exp <- round(
    c(
      16.63373776762521671913, 16.63373776762521671913, 16.63373776762521671913,
      22.20575041173110264481, 22.20575041173110264481, 22.20575041173110264481,
      22.20575041173110264481, 22.20575041173110264481, 22.20575041173110264481,
      16.98716694115406866672, 16.98716694115406866672, 25.14546289114454680202,
      25.14546289114454680202, 19.13716694115407079835, 22.53575041173110093951,
      33.24833809701009812443, 25.82632545290421433037, 25.82632545290421433037,
      25.82632545290421433037, 33.24833809701009812443, 33.24833809701009812443,
      33.24833809701009812443, 25.82632545290421433037, 25.82632545290421433037,
      29.03090470877928197524, 29.03090470877928197524, 25.82632545290421433037,
      25.82632545290421433037, 33.24833809701009812443, 33.24833809701009812443,
      33.24833809701009812443, 25.82632545290421433037, 25.82632545290421433037,
      25.82632545290421433037, 33.24833809701009812443, 33.24833809701009812443,
      33.24833809701009812443, 33.24833809701009812443, 33.24833809701009812443,
      33.24833809701009812443, 33.24833809701009812443, 25.82632545290421433037,
      25.82632545290421433037, 33.24833809701009812443, 16.63373776762521671913
    ),
    digits = 5
  )

  expect_equal(
    round(
      suppressWarnings( # Species cast warning is not a problem
        standing_area_gnfi3(spec_id, dbh_cm)
      ),
      digits = 5),
    areas_exp
  )

  # -----
  # bavrn_state_short
  spec_id <- as_fe_species_bavrn_state_short(
    fe_species_get_coding_table("bavrn_state_short")$species_id |>
      unique()
  )

  dbh_cm <- rep(30, times = 9)

  areas_exp <- round(
    c(
      16.63373776762521671913, 22.20575041173110264481, 16.98716694115406866672,
      25.14546289114454680202, 19.13716694115407079835, 22.53575041173110093951,
      33.24833809701009812443, 25.82632545290421433037, 29.03090470877928197524
    ),
    digits = 5
  )

  expect_equal(
    round(
      suppressWarnings( # Species cast warning is not a problem
        standing_area_gnfi3(spec_id, dbh_cm)
      ),
      digits = 5),
    areas_exp
  )

  # -----
  # Master coding (as an example for a coding where the default version of
  # standing_area_gnfi3() must be used)
  spec_id <- as_fe_species_master(
    fe_species_get_coding_table("master")$species_id |>
      unique()
  )

  dbh_cm <- rep(30, times = 96)

  areas_exp <- round(
    c(
      16.98716694115406866672, 16.98716694115406866672, 16.98716694115406866672,
      16.98716694115406866672, 16.98716694115406866672, 16.98716694115406866672,
      16.98716694115406866672, 16.98716694115406866672, 16.98716694115406866672,
      16.98716694115406866672, 16.98716694115406866672, 16.98716694115406866672,
      16.63373776762521671913, 16.63373776762521671913, 25.14546289114454680202,
      23.37831702350028706405, 23.37831702350028706405, 16.63373776762521671913,
      16.63373776762521671913, 16.63373776762521671913, 16.63373776762521671913,
      16.63373776762521671913, 16.63373776762521671913, 16.63373776762521671913,
      16.63373776762521671913, 22.20575041173110264481, 22.20575041173110264481,
      22.20575041173110264481, 22.20575041173110264481, 22.20575041173110264481,
      22.20575041173110264481, 22.20575041173110264481, 22.20575041173110264481,
      22.20575041173110264481, 22.20575041173110264481, 22.20575041173110264481,
      19.13716694115407079835, 16.63373776762521671913, 16.63373776762521671913,
      16.63373776762521671913, 16.63373776762521671913, 16.63373776762521671913,
      25.82632545290421433037, 25.82632545290421433037, 25.82632545290421433037,
      25.82632545290421433037, 25.82632545290421433037, 33.24833809701009812443,
      33.24833809701009812443, 25.82632545290421433037, 39.61006322052943318113,
      39.61006322052943318113, 25.82632545290421433037, 25.82632545290421433037,
      25.82632545290421433037, 25.82632545290421433037, 22.53575041173110093951,
      25.82632545290421433037, 25.82632545290421433037, 25.82632545290421433037,
      25.82632545290421433037, 25.82632545290421433037, 25.82632545290421433037,
      25.82632545290421433037, 25.82632545290421433037, 25.82632545290421433037,
      25.82632545290421433037, 45.61946710584651043519, 45.61946710584651043519,
      45.61946710584651043519, 45.61946710584651043519, 45.61946710584651043519,
      25.82632545290421433037, 25.82632545290421433037, 25.82632545290421433037,
      25.82632545290421433037, 25.82632545290421433037, 25.82632545290421433037,
      25.82632545290421433037, 29.03090470877928197524, 29.03090470877928197524,
      27.24004214701962212075, 25.82632545290421433037, 25.82632545290421433037,
      25.82632545290421433037, 25.82632545290421433037, 25.82632545290421433037,
      25.82632545290421433037, 25.82632545290421433037, 25.82632545290421433037,
      25.82632545290421433037, 25.82632545290421433037, 25.82632545290421433037,
      25.82632545290421433037, 25.82632545290421433037, 25.82632545290421433037
    ),
    digits = 5
  )

  expect_equal(
    round(
      suppressWarnings( # Species cast warning is not a problem
        standing_area_gnfi3(spec_id, dbh_cm)
      ),
      digits = 5),
    areas_exp
  )
})