tests/testthat/test-HegyiCICalculator.R

In bcgov/FAIBBase: Basic functions for forest mensuration and ecology

test_that("HegyiCICalculator.R: Hegyi index is not correctly calculated.", {
  library(data.table)
  library(testthat)
  # prepare the data
  ## this is a simple test



  thetrees <- data.table(expand.grid(bearing = seq(0, 359, by = 30),
                                     distance = seq(1, 50, by = 4)))
  thetrees <- thetrees[order(bearing, distance),]
  thetrees <- thetrees[, objectID := as.character(1:156)]
  thetrees[bearing >= 0 & bearing < 90, ':='(species = "PL",
                                             dbh = 1:39)]
  thetrees[bearing >= 90 & bearing < 180, ':='(species = "BS",
                                               dbh = 40:78)]
  thetrees[bearing >= 180 & bearing < 270, ':='(species = "WS",
                                                dbh = 79:117)]
  thetrees[bearing >= 270 & bearing < 360, ':='(species = "BB",
                                                dbh =118:156)]

  thetrees[, ':='(x = sin(bearing*pi/180)*distance,
                  y = cos(bearing*pi/180)*distance)]
  hegyiCI <- HegyiCICalculator(objectID = thetrees$objectID,
                               species = thetrees$species,
                               coordX = thetrees$x,
                               coordY = thetrees$y,
                               size = thetrees$dbh,
                               maxRadius = 10)

  # thetrees <- merge(thetrees,
  #                   hegyiCI,
  #                   by = "objectID")
  # library(ggplot2)
  #
  # speciesmap <- ggplot(data = thetrees, aes(x = x, y = y))+
  #   geom_point(aes(col = species, size = dbh))
  #
  # totalHmap <- ggplot(data = thetrees, aes(x = x, y = y))+
  #   geom_point(aes(col = log(totalH), size = log(totalH)))
  #
  # interHmap <- ggplot()+
  #   geom_point(data = thetrees[interH != 0,],
  #              aes(x = x, y = y, col = interH, size = interH))+
  #   geom_point(data = thetrees[interH == 0,],
  #              aes(x = x, y = y), col = "red")
  #
  # intraHmap <- ggplot()+
  #   geom_point(data = thetrees,
  #              aes(x = x, y = y, col = intraH, size = intraH))


  hegyiCI[,objectID := as.numeric(objectID)]
  hegyiCI <- hegyiCI[order(objectID),]



  hegyiCI[,':='(intraH = round(intraH, 4),
                interH = round(interH, 4),
                totalH = round(totalH, 4))]
  expect_identical(hegyiCI$intraH,
                   c(69.1809, 15.3486, 7.5457, 2.8929, 1.5487, 0.7484, 0.7484, 0.7484,
                     0.7484, 0.7484, 0.7484, 0.6028, 0.3358, 4.9938, 2.5101, 2.053,
                     1.7576, 1.193, 0.7484, 0.7484, 0.7484, 0.7484, 0.7484, 0.7484,
                     0.6136, 0.355, 1.6469, 1.1691, 1.1326, 1.0344, 0.8775, 0.7484,
                     0.7484, 0.7484, 0.7484, 0.7484, 0.7484, 0.617, 0.3614, 5.5869,
                     2.739, 2.1867, 1.419, 1.0421, 0.7484, 0.7484, 0.7484, 0.7484,
                     0.7484, 0.7484, 0.6187, 0.3646, 4.9167, 2.4817, 2.0785, 1.7782,
                     1.2018, 0.7484, 0.7484, 0.7484, 0.7484, 0.7484, 0.7484, 0.6197,
                     0.3665, 3.0116, 1.7066, 1.5008, 1.1663, 0.933, 0.7484, 0.7484,
                     0.7484, 0.7484, 0.7484, 0.7484, 0.6204, 0.3678, 4.782, 2.4238,
                     1.9883, 1.3471, 1.0116, 0.7484, 0.7484, 0.7484, 0.7484, 0.7484,
                     0.7484, 0.6208, 0.3687, 4.9049, 2.4771, 2.0829, 1.7819, 1.2034,
                     0.7484, 0.7484, 0.7484, 0.7484, 0.7484, 0.7484, 0.6212, 0.3694,
                     3.3625, 1.8485, 1.6005, 1.203, 0.9488, 0.7484, 0.7484, 0.7484,
                     0.7484, 0.7484, 0.7484, 0.6214, 0.37, 4.5091, 2.3152, 1.9188,
                     1.3215, 1.0005, 0.7484, 0.7484, 0.7484, 0.7484, 0.7484, 0.7484,
                     0.6217, 0.3704, 4.9002, 2.4753, 2.0847, 1.7834, 1.2041, 0.7484,
                     0.7484, 0.7484, 0.7484, 0.7484, 0.7484, 0.6218, 0.3707, 3.5233,
                     1.9141, 1.647, 1.2202, 0.9563, 0.7484, 0.7484, 0.7484, 0.7484,
                     0.7484, 0.7484, 0.622, 0.371))
  expect_identical(hegyiCI$interH,
                   c(981.5981, 185.3738, 67.4581, 19.0241, 6.7459, 0, 0, 0, 0, 0,
                     0, 0, 0, 57.5424, 19.5326, 8.3452, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                     0, 29.6762, 10.2189, 4.2742, 0.7361, 0.3209, 0, 0, 0, 0, 0, 0,
                     0, 0, 16.0462, 5.5433, 2.2303, 0.3565, 0.1585, 0, 0, 0, 0, 0,
                     0, 0, 0, 12.222, 4.3125, 1.8325, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                     11.5743, 4.2275, 2.1059, 0.6136, 0.2695, 0, 0, 0, 0, 0, 0, 0,
                     0, 8.1344, 2.9426, 1.4142, 0.434, 0.1915, 0, 0, 0, 0, 0, 0, 0,
                     0, 6.7767, 2.4692, 1.1697, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 7.2826,
                     2.7488, 1.5335, 0.5796, 0.2549, 0, 0, 0, 0, 0, 0, 0, 0, 5.1293,
                     1.954, 1.115, 0.4615, 0.2034, 0, 0, 0, 0, 0, 0, 0, 0, 3.5544,
                     1.2842, 0.5806, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2.9508, 1.02, 0.3793,
                     0.0124, 0.0069, 0, 0, 0, 0, 0, 0, 0, 0))

  expect_identical(hegyiCI$totalH,
                   c(1050.7789, 200.7224, 75.0038, 21.917, 8.2946, 0.7484, 0.7484,
                     0.7484, 0.7484, 0.7484, 0.7484, 0.6028, 0.3358, 62.5363, 22.0427,
                     10.3982, 1.7576, 1.193, 0.7484, 0.7484, 0.7484, 0.7484, 0.7484,
                     0.7484, 0.6136, 0.355, 31.3232, 11.388, 5.4068, 1.7704, 1.1984,
                     0.7484, 0.7484, 0.7484, 0.7484, 0.7484, 0.7484, 0.617, 0.3614,
                     21.6332, 8.2823, 4.417, 1.7755, 1.2006, 0.7484, 0.7484, 0.7484,
                     0.7484, 0.7484, 0.7484, 0.6187, 0.3646, 17.1387, 6.7943, 3.911,
                     1.7782, 1.2018, 0.7484, 0.7484, 0.7484, 0.7484, 0.7484, 0.7484,
                     0.6197, 0.3665, 14.5859, 5.934, 3.6067, 1.7799, 1.2025, 0.7484,
                     0.7484, 0.7484, 0.7484, 0.7484, 0.7484, 0.6204, 0.3678, 12.9163,
                     5.3664, 3.4024, 1.7811, 1.203, 0.7484, 0.7484, 0.7484, 0.7484,
                     0.7484, 0.7484, 0.6208, 0.3687, 11.6816, 4.9463, 3.2526, 1.7819,
                     1.2034, 0.7484, 0.7484, 0.7484, 0.7484, 0.7484, 0.7484, 0.6212,
                     0.3694, 10.6451, 4.5974, 3.134, 1.7825, 1.2037, 0.7484, 0.7484,
                     0.7484, 0.7484, 0.7484, 0.7484, 0.6214, 0.37, 9.6384, 4.2692,
                     3.0338, 1.783, 1.2039, 0.7484, 0.7484, 0.7484, 0.7484, 0.7484,
                     0.7484, 0.6217, 0.3704, 8.4546, 3.7595, 2.6653, 1.7834, 1.2041,
                     0.7484, 0.7484, 0.7484, 0.7484, 0.7484, 0.7484, 0.6218, 0.3707,
                     6.4742, 2.9341, 2.0263, 1.2326, 0.9632, 0.7484, 0.7484, 0.7484,
                     0.7484, 0.7484, 0.7484, 0.622, 0.371))

})