tests/testthat/test-small_function.R

In BIOMASS: Estimating Aboveground Biomass and Its Uncertainty in Tropical Forests

options(stringsAsFactors = FALSE)

data("NouraguesTrees")
data("NouraguesHD")

NouraguesTrees <- NouraguesTrees[1:50, ]

# Argument repetitive
D <- NouraguesTrees$D

data("NouraguesCoords")

skip_if_not_function <- function(name) {
  if (!exists(name)) {
    skip(paste("The function", name, "is internal"))
  }
}

context("Function computeE")
test_that("Compute E", {
  
  skip_on_cran()
  
  coord <- apply(NouraguesCoords[c("Long","Lat")] , 2, mean) # compute the mean of the corner coordinates

  E <- computeE(coord)

  expect_is(E, "numeric")
  expect_length(E, 1)
  
  expect_equal(computeE(cbind(12, 50)), 1.129928, tolerance = 0.1)
  expect_error(computeE(cbind(long = -20, lat = 4)), "coordinate")
})

context("Function getBioclimParam")
test_that("getBioclimParam", {
  
  skip_if_not_function("getBioclimParam")
  
  coord <- NouraguesCoords[c("Long","Lat")]
  
  B <- getBioclimParam(coord)

  expect_is(B, "data.frame")
  expect_equal(dim(B), c(16, 3))

  skip_on_cran()
  expect_equal(getBioclimParam(cbind(12, 50)),
    data.frame("tempSeas" = 6.62375, "precSeas" = 0.01925, "CWD" = -0.0921875),
    tolerance = 0.1
  )
})

context("Function getTaxonomy")

test_that("Without finding the order", {
  
  Taxo <- getTaxonomy(NouraguesTrees$Genus)

  expect_equal(Taxo[, 1], as.character(NouraguesTrees$Genus))
  expect_is(Taxo, "data.frame")
  expect_equal(dim(Taxo), c(50, 2))
  expect_is(Taxo[, 1], "character")
  expect_is(Taxo[, 2], "character")

  Taxo <- Taxo[order(Taxo$inputGenus), ]

  res <- "inputGenus      family
  Abarema    Fabaceae
  Amaioua   Rubiaceae
  Amphirrhox    Violaceae"

  expect_equivalent(unique(Taxo)[1:3,], fread(res, data.table = FALSE))
})

test_that("With finding the order", {
  Taxo <- getTaxonomy(NouraguesTrees$Genus, findOrder = TRUE)
  expect_equal(Taxo[, 1], as.character(NouraguesTrees$Genus))

  expect_is(Taxo, "data.frame")
  expect_equal(dim(Taxo), c(50, 3))
  expect_is(Taxo[, 1], "character")
  expect_is(Taxo[, 2], "character")
  expect_is(Taxo[, 3], "character")

  Taxo <- Taxo[order(Taxo$inputGenus), ]

  res <- "inputGenus      family      order
  Abarema  Fabaceae      Fabales
  Amaioua Rubiaceae  Gentianales
  Amphirrhox Violaceae Malpighiales"

  expect_equivalent(unique(Taxo)[1:3,], fread(res, data.table = FALSE))
})


context("Internal function of HD model ")
test_that("loglog function", {
  skip_if_not_function("loglogFunction")

  data <- data.frame(H = c(5, 5), D = c(2, 3))

  expect_is(loglogFunction(data, "log1"), "lm")
  expect_is(loglogFunction(data, "log2"), "lm")
})

test_that("Michaelis function", {
  skip_if_not_function("michaelisFunction")
  
  coord <- apply(NouraguesCoords[c("Long","Lat")] , 2, mean) # compute the mean of the corner coordinates
  
  data <- data.frame(H = retrieveH(D, coord = coord)$H, D = D)

  expect_is(michaelisFunction(data), "nls")
})

test_that("Weibull function", {
  
  skip_if_not_function("weibullFunction")
  
  coord <- apply(NouraguesCoords[c("Long","Lat")] , 2, mean) # compute the mean of the corner coordinates
  
  data <- data.frame(H = retrieveH(D, coord = coord)$H, D = D)

  expect_is(weibullFunction(data), "nls")
})



context("Predict Height of the tree")

for (method in c("log1", "log2", "weibull", "michaelis")) {
  test_that(paste("predictHeight", method), {
    skip_if_not_function("predictHeight")
    HDmodel <- modelHD(
      D = NouraguesHD$D,
      H = NouraguesHD$H,
      method = method,
      useWeight = TRUE
    )
    for (err in c(TRUE, FALSE)) {
      expect_length(predictHeight(D, HDmodel, err = err), length(D))
      expect_is(predictHeight(D, HDmodel, err = err), "numeric")

      if (err == TRUE) {
        H <- predictHeight(rep(10, 10), HDmodel, err = err)
        expect_false(all(H == H[1]))
      }
    }
  })
}

test_that("predictHeigth with plot argument", {
  HDmodel <- modelHD(
    D = NouraguesHD$D,
    H = NouraguesHD$H,
    method = "log2",
    useWeight = TRUE
  )

  expect_failure(expect_error(predictHeight(D, HDmodel, plot = "Plot1")))

  HDmodel <- modelHD(
    D = NouraguesHD$D,
    H = NouraguesHD$H,
    method = "log2",
    useWeight = TRUE,
    plot = NouraguesHD$plotId
  )

  expect_error(predictHeight(D, HDmodel), "model")
  expect_length(predictHeight(D, HDmodel, plot = "Plot1"), length(D))
  expect_failure(expect_equal(
    predictHeight(D, HDmodel, plot = "Plot1"),
    predictHeight(D, HDmodel, plot = "Plot2")
  ))
  expect_error(predictHeight(D, HDmodel, plot = "AAA"), "Cannot")
  expect_error(predictHeight(D, HDmodel, plot = c("Plot1", "Plot2")), "length")

  plot <- rep(c("Plot1", "Plot2"), length.out = length(D))

  Res <- predictHeight(D, HDmodel, plot = plot)
  expect_failure(expect_equal(Res, predictHeight(D, HDmodel, plot = "Plot1")))
  expect_equal(Res[plot == "Plot1"], predictHeight(D, HDmodel, plot = "Plot1")[plot == "Plot1"])
  expect_equal(Res[plot == "Plot2"], predictHeight(D, HDmodel, plot = "Plot2")[plot == "Plot2"])
  expect_failure(expect_equal(Res[plot == "Plot1"], predictHeight(D, HDmodel, plot = "Plot2")[plot == "Plot1"]))
  expect_failure(expect_equal(Res[plot == "Plot2"], predictHeight(D, HDmodel, plot = "Plot1")[plot == "Plot2"]))
})


context("compute Feld Region")
test_that("compute Feld Region", {
  
  coord <- cbind(-52.68, 4.08)
  
  expect_equal(unique(computeFeldRegion(coord)), "GuianaShield")
  expect_length(computeFeldRegion(coord), nrow(coord))

  expect_equal(unique(computeFeldRegion(coord, level = "world")), "Pantropical")
  expect_equal(
    computeFeldRegion(coord, level = rep(c("region", "continent", "world"), length.out = nrow(coord))),
    rep(c("GuianaShield", "SEAsia", "Pantropical"), length.out = nrow(coord))
  )

  expect_error(computeFeldRegion(coord, level = c("region", "region")))
  expect_error(computeFeldRegion(coord, level = "fgaz"))
})


context("Analysis of Procrust")
test_that("Analysis of Procrust", {
  X <- expand.grid(X = c(0, 1), Y = c(0, 1))
  Y <- expand.grid(X = c(11, 10), Y = c(10, 11))

  lis <- procrust(Y, X)
  expect_is(lis, "list")
  expect_length(lis, 2)

  expect_is(lis$rotation, "matrix")
  expect_is(lis$translation, "matrix")

  expect_equivalent(as.matrix(Y), sweep(as.matrix(X) %*% lis$rotation, 2, lis$translation, "+"))
})


context("lat long to UTM")
test_that("lat long to UTM", {
  long <- c(-52.68, -51.12, -53.11)
  lat <- c(4.08, 3.98, 4.12)
  coord <- cbind(long, lat)
  
  skip_if_not_installed("proj4") 
  UTM <- latlong2UTM(coord)
  expect_is(UTM, "data.frame")

  expect_equal(dim(UTM), c(3, 5))

  for (i in c(1, 2, 4, 5)) expect_is(UTM[, i], "numeric")
  expect_is(UTM[, 3], "character")
  expect_equal(unique(UTM[, 3]), "+proj=utm +zone=22 +north +ellps=WGS84 +datum=WGS84 +units=m +no_defs")
})