tests/testthat/test_v_red_harvest_ubark.R

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

library(ForestElementsR)


test_that("volume reduction v_red_harvest_ubark is correct", {

  # All species in the tum_wwk_short coding, vol_orig_m3 always 1 m³
  species_id  <- fe_species_tum_wwk_short(1:10)
  vol_orig_m3 <- 1
  v_expect    <- c(0.8100, 0.8100, 0.7902, 0.7200, 0.8460,
                   0.7902, 0.7902, 0.8100, 0.8100, 0.8100)

  expect_equal(v_red_harvest_ubark(species_id, vol_orig_m3), v_expect)


  # All species in the bavrn_state_short coding, vol_orig_m3 always 1 m³
  species_id  <- fe_species_bavrn_state_short(1:9)
  vol_orig_m3 <- 1
  v_expect    <- c(0.8100, 0.7902, 0.8100, 0.7200, 0.7902,
                   0.8460, 0.7902, 0.8100, 0.8100)

  expect_equal(v_red_harvest_ubark(species_id, vol_orig_m3), v_expect)


  # All species in the bavrn_state coding, must correctly apply
  # bavrn_state_short factors
  species_id <- fe_species_bavrn_state(
    c(
      "10", "11", "12", "20", "21", "22", "23", "24", "25", "30", "35", "40",
      "41", "50", "60", "61", "62", "63", "64", "65", "66", "67", "68", "69",
      "69", "69", "70", "70", "71", "72", "72", "72", "73", "74", "75", "76",
      "77", "78", "78", "78", "78", "79", "80", "80", "80", "80", "80", "80",
      "80", "80", "80", "80", "80", "80", "80", "81", "82", "83", "83", "83",
      "83", "84", "85", "86", "87", "87", "88", "89", "90", "90", "90", "90",
      "90", "90", "90", "90", "90", "90", "90", "90", "90", "90", "90", "90",
      "90", "90", "90", "90", "90", "90", "90", "90", "90", "90", "90", "90"
    )
  )

  v_expect    <- c(
    0.8100, 0.8100, 0.8100, 0.7902, 0.7902, 0.7902, 0.7902, 0.7902, 0.7902,
    0.8100, 0.8100, 0.7200, 0.7200, 0.7902, 0.8460, 0.8100, 0.8100, 0.8100,
    0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.7902,
    0.7902, 0.7902, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100,
    0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100,
    0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100,
    0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100,
    0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100,
    0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100,
    0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100,
    0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100
  )

  expect_equal(
    suppressWarnings( # Species code conversion warnings are irrelevant
      v_red_harvest_ubark(species_id, vol_orig_m3)
    ),
    v_expect
  )

  # All species in the ger_nfi_2012 coding, must correctly apply
  # tum_wwk_short factors; ger_nfi_2012 code 290 is not included, because
  # it is ambiguous with regard to tum_wwk_short
  species_id  <- fe_species_ger_nfi_2012(
    c(
      "10",  "12",  "19",  "19",  "19",  "19",  "20",  "21",  "22",  "24",
      "25",  "29",  "29",  "29",  "29",  "29",  "29",  "30",  "33",  "39",
      "39",  "39",  "39",  "39",  "39",  "39",  "39",  "39",  "39",  "40",
      "50",  "51",  "51",  "90",  "90",  "90",  "90",  "90",  "90",  "90",
      "90",  "94", "100", "110", "111", "112", "120", "130", "140", "141",
     "142", "150", "150", "160", "170", "170", "170", "181", "190", "190",
     "190", "190", "190", "191", "193", "200", "201", "211", "212", "220",
     "221", "222", "223", "224", "230", "240", "250", "251", "252", "292",
     "293", "295"
    )
  )

  vol_orig_m3 <- 1
  v_expect    <- c(
    0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.7902, 0.8100, 0.8100,
    0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100,
    0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100,
    0.8100, 0.8100, 0.7902, 0.7200, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100,
    0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8460, 0.7902, 0.7902,
    0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100,
    0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100,
    0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100,
    0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100, 0.8100,
    0.8100
  )

  expect_equal(
    suppressWarnings( # Species code conversion warnings are irrelevant
      v_red_harvest_ubark(species_id, vol_orig_m3)
    ),
    v_expect)
})