tests/testthat/test_h_standard_gnfi3.R

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

library(ForestElementsR)



test_that("badly dimensioned inputs trigger an error", {

  # No input vector must be longer than dbh_cm
  expect_error(
    h_standard_gnfi3(species_id = c(10, 10, 10),
                     dbh_cm = c(32, 33),
                     d_q_cm = 29,
                     h_q_m  = 28)
  )

  expect_error(
    h_standard_gnfi3(species_id = 10,
                     dbh_cm = c(32, 33),
                     d_q_cm = c(29, 29.3, 31.2),
                     h_q_m  = 28)
  )

  expect_error(
    h_standard_gnfi3(species_id = 10,
                     dbh_cm = c(32, 33),
                     d_q_cm = c(29.3),
                     h_q_m  = c(28, 28.8, 28.8))
  )

  # Having only dbh_cm with length > 1 is ok
  expect_no_error(
    h_standard_gnfi3(species_id = 10,
                     dbh_cm = c(32, 33, 35, 52.3),
                     d_q_cm = 29.3,
                     h_q_m  = 28)
  )
})



test_that("height calculation h_standard_gnfi3 is correct", {

  # Check for ger_nfi_2012 species coding (the original coding)

  # Three trees with different diameters replicated for all species
  # # (groups) for which h_standard_gnfi3 is parameterized
  n    <- nrow(h_standard_ger_nfi_2012_param_orig)

  d_cm <- rep(c(15.3, 33.7, 52.1), times = n)
  spec <- fe_species_ger_nfi_2012(
    rep(h_standard_ger_nfi_2012_param_orig$species_id, each = 3)
  )
  dq   <- 35.2
  hq   <- 34.8

  h_expect <- c(
    22.69916781658977100733, 34.29010158621888137986, 38.76182926621871871475,
    22.69916781658977100733, 34.29010158621888137986, 38.76182926621871871475,
    22.69916781658977100733, 34.29010158621888137986, 38.76182926621871871475,
    22.94937586658520345395, 34.30322804116917012607, 38.65338049534921083250,
    22.94937586658520345395, 34.30322804116917012607, 38.65338049534921083250,
    22.94937586658520345395, 34.30322804116917012607, 38.65338049534921083250,
    22.94937586658520345395, 34.30322804116917012607, 38.65338049534921083250,
    22.94937586658520345395, 34.30322804116917012607, 38.65338049534921083250,
    22.94937586658520345395, 34.30322804116917012607, 38.65338049534921083250,
    27.38310699152910032694, 34.51432424286181799289, 36.95745953219301327408,
    27.38310699152910032694, 34.51432424286181799289, 36.95745953219301327408,
    27.38310699152910032694, 34.51432424286181799289, 36.95745953219301327408,
    20.91838027719566994733, 34.19215633874342330500, 39.58243700162882561244,
    27.84592486717006920571, 34.53432202240096415835, 36.80139237810040953036,
    27.84592486717006920571, 34.53432202240096415835, 36.80139237810040953036,
    22.69916781658977100733, 34.29010158621888137986, 38.76182926621871871475,
    22.69916781658977100733, 34.29010158621888137986, 38.76182926621871871475,
    27.00650804224151357857, 34.49779735294882243579, 37.08702810105145886155,
    27.18666093065894884262, 34.50573225674347810354, 37.02475283229964730936,
    27.18666093065894884262, 34.50573225674347810354, 37.02475283229964730936,
    27.18666093065894884262, 34.50573225674347810354, 37.02475283229964730936,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    28.77440616057704403374, 34.57344489332148640415, 36.49830981738895019362,
    28.77440616057704403374, 34.57344489332148640415, 36.49830981738895019362,
    28.77440616057704403374, 34.57344489332148640415, 36.49830981738895019362,
    28.77440616057704403374, 34.57344489332148640415, 36.49830981738895019362,
    28.77440616057704403374, 34.57344489332148640415, 36.49830981738895019362,
    28.77440616057704403374, 34.57344489332148640415, 36.49830981738895019362,
    28.77440616057704403374, 34.57344489332148640415, 36.49830981738895019362,
    28.77440616057704403374, 34.57344489332148640415, 36.49830981738895019362,
    28.77440616057704403374, 34.57344489332148640415, 36.49830981738895019362,
    28.77440616057704403374, 34.57344489332148640415, 36.49830981738895019362,
    28.77440616057704403374, 34.57344489332148640415, 36.49830981738895019362,
    28.77440616057704403374, 34.57344489332148640415, 36.49830981738895019362,
    28.77440616057704403374, 34.57344489332148640415, 36.49830981738895019362,
    28.77440616057704403374, 34.57344489332148640415, 36.49830981738895019362,
    28.77440616057704403374, 34.57344489332148640415, 36.49830981738895019362,
    28.77440616057704403374, 34.57344489332148640415, 36.49830981738895019362,
    28.77440616057704403374, 34.57344489332148640415, 36.49830981738895019362,
    28.77440616057704403374, 34.57344489332148640415, 36.49830981738895019362
  )

  expect_equal(h_standard_gnfi3(spec, d_cm, dq, hq), h_expect)



  # Check for tum_wwk_short species coding

  # Three trees with different diameters replicated for all ten species
  # (groups) for which h_standard_gnfi3 is parameterized
  d_cm <- rep(c(15.3, 33.7, 52.1), times = 10)
  spec <- fe_species_tum_wwk_short(rep(1:10, each = 3))
  dq   <- 35.2
  hq   <- 34.8

  h_expect <- c(
    22.69916781658977100733, 34.29010158621888137986, 38.76182926621871871475,
    27.38310699152910032694, 34.51432424286181799289, 36.95745953219301327408,
    22.94937586658520345395, 34.30322804116917012607, 38.65338049534921083250,
    27.84592486717006920571, 34.53432202240096415835, 36.80139237810040953036,
    27.00650804224151357857, 34.49779735294882243579, 37.08702810105145886155,
    27.18666093065894884262, 34.50573225674347810354, 37.02475283229964730936,
    20.91838027719566994733, 34.19215633874342330500, 39.58243700162882561244,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    28.77440616057704403374, 34.57344489332148640415, 36.49830981738895019362,
    22.69916781658977100733, 34.29010158621888137986, 38.76182926621871871475
  )

  expect_equal(h_standard_gnfi3(spec, d_cm, dq, hq), h_expect)


  # Check for bavrn_state_short species coding

  # Three trees with different diameters replicated for all nine species
  # (groups) for which h_standard_gnfi3 is parameterized
  d_cm <- rep(c(15.3, 33.7, 52.1), times = 9)
  spec <- fe_species_bavrn_state_short(rep(1:9, each = 3))
  dq   <- 35.2
  hq   <- 34.8

  h_expect <- c(
    22.69916781658977100733, 34.29010158621888137986, 38.76182926621871871475,
    22.94937586658520345395, 34.30322804116917012607, 38.65338049534921083250,
    27.38310699152910032694, 34.51432424286181799289, 36.95745953219301327408,
    27.84592486717006920571, 34.53432202240096415835, 36.80139237810040953036,
    20.91838027719566994733, 34.19215633874342330500, 39.58243700162882561244,
    27.00650804224151357857, 34.49779735294882243579, 37.08702810105145886155,
    27.18666093065894884262, 34.50573225674347810354, 37.02475283229964730936,
    28.77440616057704403374, 34.57344489332148640415, 36.49830981738895019362,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473
  )

  expect_equal(h_standard_gnfi3(spec, d_cm, dq, hq), h_expect)


  # Check for bavrn_state species coding

  # Three trees with different diameters replicated for all 45 species
  # (groups) for which h_standard_gnfi3 is parameterized
  d_cm <- rep(c(15.3, 33.7, 52.1), times = 45)
  spec <- fe_species_get_coding_table("bavrn_state")$species_id |>
    unique() |>
    sort() |>
    as_fe_species_bavrn_state() |>
    rep(each = 3)
  dq   <- 35.2
  hq   <- 34.8

  h_expect <- c(
    22.69916781658977100733, 34.29010158621888137986, 38.76182926621871871475,
    22.69916781658977100733, 34.29010158621888137986, 38.76182926621871871475,
    22.69916781658977100733, 34.29010158621888137986, 38.76182926621871871475,
    22.94937586658520345395, 34.30322804116917012607, 38.65338049534921083250,
    22.94937586658520345395, 34.30322804116917012607, 38.65338049534921083250,
    22.94937586658520345395, 34.30322804116917012607, 38.65338049534921083250,
    22.94937586658520345395, 34.30322804116917012607, 38.65338049534921083250,
    22.94937586658520345395, 34.30322804116917012607, 38.65338049534921083250,
    22.94937586658520345395, 34.30322804116917012607, 38.65338049534921083250,
    27.38310699152910032694, 34.51432424286181799289, 36.95745953219301327408,
    27.38310699152910032694, 34.51432424286181799289, 36.95745953219301327408,
    27.84592486717006920571, 34.53432202240096415835, 36.80139237810040953036,
    27.84592486717006920571, 34.53432202240096415835, 36.80139237810040953036,
    20.91838027719566994733, 34.19215633874342330500, 39.58243700162882561244,
    27.00650804224151357857, 34.49779735294882243579, 37.08702810105145886155,
    28.77440616057704403374, 34.57344489332148640415, 36.49830981738895019362,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    28.77440616057704403374, 34.57344489332148640415, 36.49830981738895019362,
    28.77440616057704403374, 34.57344489332148640415, 36.49830981738895019362,
    28.77440616057704403374, 34.57344489332148640415, 36.49830981738895019362,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    27.18666093065894884262, 34.50573225674347810354, 37.02475283229964730936,
    27.18666093065894884262, 34.50573225674347810354, 37.02475283229964730936,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    28.77440616057704403374, 34.57344489332148640415, 36.49830981738895019362,
    28.77440616057704403374, 34.57344489332148640415, 36.49830981738895019362,
    28.77440616057704403374, 34.57344489332148640415, 36.49830981738895019362,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    28.77440616057704403374, 34.57344489332148640415, 36.49830981738895019362,
    28.77440616057704403374, 34.57344489332148640415, 36.49830981738895019362,
    28.77440616057704403374, 34.57344489332148640415, 36.49830981738895019362,
    28.77440616057704403374, 34.57344489332148640415, 36.49830981738895019362,
    28.77440616057704403374, 34.57344489332148640415, 36.49830981738895019362,
    28.77440616057704403374, 34.57344489332148640415, 36.49830981738895019362,
    28.77440616057704403374, 34.57344489332148640415, 36.49830981738895019362,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    28.77440616057704403374, 34.57344489332148640415, 36.49830981738895019362,
    22.69916781658977100733, 34.29010158621888137986, 38.76182926621871871475
  )

  expect_equal(
    suppressWarnings( # Species cast warnings here are ok
      h_standard_gnfi3(spec, d_cm, dq, hq)
    ),
    h_expect
  )


  # Check for tum_wwk_long species coding

  # Three trees with different diameters replicated for all nine species
  # (groups) for which h_standard_gnfi3 is parameterized
  d_cm <- rep(c(15.3, 33.7, 52.1), times = 44)
  spec <- fe_species_get_coding_table("tum_wwk_long")$species_id |>
    unique() |>
    sort() |>
    as_fe_species_tum_wwk_long() |>
    rep(each = 3)
  dq   <- 35.2
  hq   <- 34.8

  h_expect <- c(
    22.69916781658977100733, 34.29010158621888137986, 38.76182926621871871475,
    27.38310699152910032694, 34.51432424286181799289, 36.95745953219301327408,
    22.69916781658977100733, 34.29010158621888137986, 38.76182926621871871475,
    22.94937586658520345395, 34.30322804116917012607, 38.65338049534921083250,
    22.69916781658977100733, 34.29010158621888137986, 38.76182926621871871475,
    22.69916781658977100733, 34.29010158621888137986, 38.76182926621871871475,
    27.84592486717006920571, 34.53432202240096415835, 36.80139237810040953036,
    22.69916781658977100733, 34.29010158621888137986, 38.76182926621871871475,
    22.69916781658977100733, 34.29010158621888137986, 38.76182926621871871475,
    27.00650804224151357857, 34.49779735294882243579, 37.08702810105145886155,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    27.18666093065894884262, 34.50573225674347810354, 37.02475283229964730936,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    20.91838027719566994733, 34.19215633874342330500, 39.58243700162882561244,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    28.77440616057704403374, 34.57344489332148640415, 36.49830981738895019362,
    28.77440616057704403374, 34.57344489332148640415, 36.49830981738895019362,
    28.77440616057704403374, 34.57344489332148640415, 36.49830981738895019362,
    28.77440616057704403374, 34.57344489332148640415, 36.49830981738895019362,
    28.77440616057704403374, 34.57344489332148640415, 36.49830981738895019362,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473,
    25.02752469375252530881, 34.40691237983676842305, 37.80919363270987787473
  )

  expect_equal(
    suppressWarnings( # Species cast warnings here are ok
      h_standard_gnfi3(spec, d_cm, dq, hq)
    ),
    h_expect
  )
})



test_that(
  "height calculation h_standard_gnfi3 works with all species codings", {

  d_cm  <- rep(30, 5)
  spec_raw <- c(10, 30, 20, 100, 40) # ger_nfi_2012 codes
  age   <- 63
  dq    <- 27.2
  hq    <- 27.1
  spec  <- fe_species_ger_nfi_2012(spec_raw)

  # Reference calculated with ger_nfi_2012
  h_ref <- h_standard_gnfi3(spec, d_cm, dq, hq)

  # Coding as numeric (but ger_nfi_2012 codes)
  expect_equal(
    h_standard_gnfi3(spec_raw, d_cm, dq, hq),
    h_ref
  )
  # Coding as character (but ger_nfi_2012 codes)
  expect_equal(
    h_standard_gnfi3(as.character(spec_raw), d_cm, dq, hq),
    h_ref
  )
  # Bavarian state coding
  expect_equal(
    h_standard_gnfi3(as_fe_species_bavrn_state(spec), d_cm, dq, hq),
    h_ref
  )
  # Tum WWK short coding
  expect_equal(
    h_standard_gnfi3(as_fe_species_tum_wwk_short(spec), d_cm, dq, hq),
    h_ref
  )
  # TUM WWK long coding
  expect_equal(
    h_standard_gnfi3(as_fe_species_tum_wwk_long(spec), d_cm, dq, hq),
    h_ref
  )
  # ForestElementsR master coding
  expect_equal(
    h_standard_gnfi3(as_fe_species_master(spec), d_cm, dq, hq),
    h_ref
  )

  # A message should be issued if conversion into ger_nfi_2012 fails and
  # tum_wwk_short is used
  expect_message(
    # One digit-codes (if not given in a fe_species format) are not existing
    # in ger_nfi_2012 (conversion fails), tum_wwk_short is used
    h_standard_gnfi3(7, 30, 30, 29)
  )

  expect_no_message(
    # No message should be issued if species are given as tum_wwk_short object,
    # because it is assumed that this is what the user wants
    h_standard_gnfi3(fe_species_tum_wwk_short(7), 30, 30, 29)
  )
})