Miscellaneous updates to unit tests (primarily)

Biomass_core.Rmd

@@ -160,11 +160,13 @@ setPaths(inputPath = file.path(tempDir, "inputs"),
 
 times <- list(start = 0, end = 10)
 
-studyArea <- Cache(randomStudyArea, size = 1e7) # cache this so it creates a random one only once on a machine
+studyArea <- Cache(randomStudyArea, size = 1e10) # cache this so it creates a random one only once on a machine
 
+set.seed(123)
 # Pick the species you want to work with -- using the naming convention in "Boreal" column of LandR::sppEquivalencies_CA
 speciesNameConvention <- "Boreal"
 speciesToUse <- c("Pice_Gla", "Popu_Tre", "Pinu_Con")
+#speciesToUse <- c("Pice_Gla")
 
 sppEquiv <- LandR::sppEquivalencies_CA[get(speciesNameConvention) %in% speciesToUse]
 # Assign a colour convention for graphics for each species

R/age-cohorts.R

@@ -1,4 +1,5 @@
-ageReclassification <- compiler::cmpfun(function(cohortData, successionTimestep, stage, byGroups = c('pixelGroup', 'speciesCode', 'age')) {
+ageReclassification <- # ompiler::cmpfun(
+  function(cohortData, successionTimestep, stage, byGroups = c('pixelGroup', 'speciesCode', 'age')) {
 
   byGroupsNoAge <- byGroups[!byGroups %in% 'age'] #age is what will be lumped
   #byGroups default added for backwards compatibility
@@ -23,9 +24,8 @@ ageReclassification <- compiler::cmpfun(function(cohortData, successionTimestep,
     cdColNames <- colnames(cohortData)
     message("  Setting all ages <= ", successionTimestep, " to ", successionTimestepPlusOne)
     if (any(anyDuplicates)) {
-
       # pull out only duplicated types -- note "which = TRUE" gives only the indices of the joined rows -- will use the inverse below
-      tdDuplicates <- targetData[targetData[anyDuplicates], nomatch = NULL,
+      tdDuplicates <- targetData[unique(targetData[anyDuplicates], by = byGroupsNoAge), nomatch = NULL,
                                  on = byGroupsNoAge, which = TRUE]
 
       td <- targetData[tdDuplicates]
@@ -57,4 +57,4 @@ ageReclassification <- compiler::cmpfun(function(cohortData, successionTimestep,
     }
   }
   return(cohortData)
-})
+}#)

R/helpers.R

@@ -38,6 +38,11 @@ updateSpeciesEcoregionAttributes <- function(speciesEcoregion, currentTime, coho
 #' @importFrom data.table setkey
 updateSpeciesAttributes <- function(species, cohortData) {
   # to assign longevity, mortalityshape, growthcurve to cohortData
+  if (!("speciesCode" %in% colnames(species)) | !("speciesCode" %in% colnames(cohortData))) {
+    browser()
+    species <- species[, speciesCode := as.factor(species)]
+  }
+
   species_temp <- setkey(species[, .(speciesCode, longevity, mortalityshape, growthcurve)], speciesCode)
   setkey(cohortData, speciesCode)
   cohortData <- cohortData[species_temp, nomatch = 0]
@@ -60,7 +65,8 @@ updateSpeciesAttributes <- function(species, cohortData) {
 #'
 #' @export
 #' @importFrom data.table copy rbindlist setkey
-calculateSumB <- compiler::cmpfun(function(cohortData, lastReg, currentTime, successionTimestep,
+calculateSumB2 <- #compiler::cmpfun(
+  function(cohortData, lastReg, currentTime, successionTimestep,
                                            doAssertion = getOption("LandR.assertions", TRUE)) {
   nrowCohortData <- NROW(cohortData)
 
@@ -123,7 +129,8 @@ calculateSumB <- compiler::cmpfun(function(cohortData, lastReg, currentTime, suc
   if (algo == 1 || isTRUE(doAssertion)) {
     ## this older version is typically much slower than the newer one below (Eliot June 2, 2019)
     cohortData1 <- copy(cohortData)
-    old1 <- Sys.time()
+    if (isTRUE(doAssertion))
+      old1 <- Sys.time()
     oldKey <- checkAndChangeKey(cohortData1, "pixelGroup")
     cohortData1[age >= successionTimestep, sumB := sum(B, na.rm = TRUE), by = "pixelGroup"]
     setorderv(cohortData1, c("sumB"), na.last = TRUE)
@@ -136,7 +143,8 @@ calculateSumB <- compiler::cmpfun(function(cohortData, lastReg, currentTime, suc
     set(cohortData1, NULL, "sumB2", NULL)
     if (!is.null(oldKey))
       setkeyv(cohortData1, oldKey)
-    old2 <- Sys.time()
+    if (isTRUE(doAssertion))
+      old2 <- Sys.time()
     if (!is.integer(cohortData1[["sumB"]]))
       set(cohortData1, NULL, "sumB", asInteger(cohortData1[["sumB"]]))
   }
@@ -177,15 +185,14 @@ calculateSumB <- compiler::cmpfun(function(cohortData, lastReg, currentTime, suc
   }
 
   cohortData <- if (algo == 1) copy(cohortData1) else copy(cohortData2)
-
   if (isTRUE(doAssertion)) {
-    if (!exists("oldAlgoSumB")) mod$oldAlgoSumB <- 0
-    if (!exists("newAlgoSumB")) mod$newAlgoSumB <- 0
+    if (!exists("oldAlgoSumB", envir = mod)) mod$oldAlgoSumB <- 0
+    if (!exists("newAlgoSumB", envir = mod)) mod$newAlgoSumB <- 0
     mod$oldAlgoSumB <- mod$oldAlgoSumB + (old2 - old1)
     mod$newAlgoSumB <- mod$newAlgoSumB + (new2 - new1)
 
-    print(paste("Biomass_core:calculateSumB: new algo", mod$newAlgoSumB))
-    print(paste("Biomass_core:calculateSumB: old algo", mod$oldAlgoSumB))
+    print(paste("Biomass_core:calculateSumB: new algo (cumulative)", mod$newAlgoSumB))
+    print(paste("Biomass_core:calculateSumB: old algo (cumulative)", mod$oldAlgoSumB))
 
     setkeyv(cohortData, c("pixelGroup", "speciesCode", "age"))
     setkeyv(cohortData1, c("pixelGroup", "speciesCode", "age"))
@@ -202,11 +209,11 @@ calculateSumB <- compiler::cmpfun(function(cohortData, lastReg, currentTime, suc
     #}
   }
   return(cohortData)
-})
+}#)
 
 #' calculateAgeMortality
 #'
-#' TODO: description and title needed
+#' Follows https://github.com/LANDIS-II-Foundation/Extension-Biomass-Succession/blob/c07f044c4ffaeb075c714b3c0a23e3c22761e7ab/src/CohortBiomass.cs#L141
 #'
 #' @param cohortData \code{data.table} TODO: description needed
 #' @param stage TODO: description needed
@@ -234,7 +241,7 @@ calculateAgeMortality <- function(cohortData, stage = "nonSpinup", spinupMortali
 
 #' calculateANPP
 #'
-#' TODO: description and title needed
+#' Follows https://github.com/LANDIS-II-Foundation/Extension-Biomass-Succession/blob/c07f044c4ffaeb075c714b3c0a23e3c22761e7ab/src/CohortBiomass.cs#L163
 #'
 #' @param cohortData \code{data.table} TODO: description needed
 #' @param stage TODO: description needed
@@ -243,7 +250,8 @@ calculateAgeMortality <- function(cohortData, stage = "nonSpinup", spinupMortali
 #'
 #' @export
 #' @importFrom data.table set
-calculateANPP <- compiler::cmpfun(function(cohortData, stage = "nonSpinup") {
+calculateANPP <- # compiler::cmpfun(
+  function(cohortData, stage = "nonSpinup") {
   if (stage == "spinup") {
     cohortData[age > 0, aNPPAct := maxANPP * exp(1) * (bAP^growthcurve) *
                  exp(-(bAP^growthcurve)) * bPM]
@@ -261,11 +269,11 @@ calculateANPP <- compiler::cmpfun(function(cohortData, stage = "nonSpinup") {
         pmin(cohortData$maxANPP*cohortData$bPM, aNPPAct))
   }
   return(cohortData)
-})
+}# )
 
 #' calculateGrowthMortality
 #'
-#' TODO: description and title needed
+#' Follows https://github.com/LANDIS-II-Foundation/Extension-Biomass-Succession/blob/c07f044c4ffaeb075c714b3c0a23e3c22761e7ab/src/CohortBiomass.cs#L243
 #'
 #' @param cohortData \code{data.table} TODO: description needed
 #' @param stage TODO: description needed
@@ -275,7 +283,8 @@ calculateANPP <- compiler::cmpfun(function(cohortData, stage = "nonSpinup") {
 #' @export
 #' @importFrom data.table set
 #' @importFrom fpCompare %>>% %<=%
-calculateGrowthMortality <- compiler::cmpfun(function(cohortData, stage = "nonSpinup") {
+calculateGrowthMortality <- #compiler::cmpfun(
+  function(cohortData, stage = "nonSpinup") {
   if (stage == "spinup") {
     cohortData[age > 0 & bAP %>>% 1.0, mBio := maxANPP*bPM]
     cohortData[age > 0 & bAP %<=% 1.0, mBio := maxANPP*(2*bAP) / (1 + bAP)*bPM]
@@ -290,10 +299,11 @@ calculateGrowthMortality <- compiler::cmpfun(function(cohortData, stage = "nonSp
         pmin(cohortData$maxANPP*cohortData$bPM, cohortData$mBio))
   }
   return(cohortData)
-})
+}#)
 
 #' calculateCompetition
 #'
+#' Follows https://github.com/LANDIS-II-Foundation/Extension-Biomass-Succession/blob/c07f044c4ffaeb075c714b3c0a23e3c22761e7ab/src/CohortBiomass.cs#L437
 #' TODO: description and title needed
 #'
 #' @param cohortData \code{data.table} TODO: description needed
@@ -303,7 +313,8 @@ calculateGrowthMortality <- compiler::cmpfun(function(cohortData, stage = "nonSp
 #'
 #' @export
 #' @importFrom data.table key setkeyv
-calculateCompetition <- compiler::cmpfun(function(cohortData, stage = "nonSpinup") {
+calculateCompetition <- #compiler::cmpfun(
+  function(cohortData, stage = "nonSpinup") {
   # two competition indics are calculated bAP and bPM
   if (stage == "spinup") {
     cohortData[age > 0, bPot := pmax(1, maxB - sumB + B)]
@@ -339,7 +350,7 @@ calculateCompetition <- compiler::cmpfun(function(cohortData, stage = "nonSpinup
     set(cohortData, NULL, c("cMultiplier"), NULL)
   }
   return(cohortData)
-})
+}#)
 
 checkAndChangeKey <- function(obj, key) {
   oldKey <- key(obj)

R/spinup.R

@@ -12,7 +12,8 @@
 #' @export
 #' @importFrom data.table data.table set setkey
 #'
-spinUp <- compiler::cmpfun(function(cohortData, calibrate, successionTimestep,
+spinUp <- #compiler::cmpfun(
+  function(cohortData, calibrate, successionTimestep,
                                     spinupMortalityfraction, species) {
   maxAge <- max(cohortData$age, na.rm = TRUE) # determine the pre-simulation length
   set(cohortData, NULL, "origAge", cohortData$age)
@@ -113,7 +114,7 @@ spinUp <- compiler::cmpfun(function(cohortData, calibrate, successionTimestep,
     all <- list(cohortData = cohortData)
   }
   return(all)
-})
+}#)
 
 # cacheSpinUpFunction <- function(sim, cachePath) {
 #   # for slow functions, add cached versions. Then use sim$xxx() throughout module instead of xxx()

tests/testthat/test-Biomass_coreFireDisturbance.R

@@ -1,14 +1,21 @@
 test_that("test regeneration after fire. ",{
-  library(SpaDES)
-  library(data.table)
-  library(raster)
-  # define the module and path
-  module <- list("Biomass_core")
-  path <- list(modulePath="..",
-               outputPath="~/output")
-  parameters <- list(.progress=list(type="graphical", interval=1),
-                     .globals=list(verbose=FALSE),
-                     Biomass_core=list( .saveInitialTime=NA))
+  opts <- options(reproducible.useGDAL = FALSE,
+                  spades.moduleCodeChecks = FALSE,
+                  reproducible.useMemoise = TRUE,
+                  spades.useRequire = FALSE,
+                  LandR.assertions = FALSE,
+                  spades.recoveryMode = FALSE)
+  on.exit(options(opts))
+  require("raster")
+  require("data.table")
+  module <- "Biomass_core"
+  modulePath <- getwd()
+  while( grepl(module, modulePath)) modulePath <- dirname(modulePath)
+  outputPath <- checkPath(file.path(tempdir(), rndstr(1)), create = TRUE)
+  path <- list(modulePath = modulePath, # TODO: use general path
+               outputPath = outputPath) # TODO: use general path
+  parameters <- list(Biomass_core = list(.saveInitialTime = NA))
+
   pixelGroupMap <- raster(xmn = 50,xmx = 50 + 50*100,
                           ymn = 50,ymx = 50 + 50*100,
                           res = c(100, 100),

tests/testthat/test-Biomass_coreInit.R

@@ -1,17 +1,21 @@
-test_that("test Biomass_coreInit", {
-  # define the module and path
-  library(raster)
-  library(data.table)
-  module <- list("Biomass_core")
-  path <- list(
-    modulePath = "..",
-    outputPath = "~/output"
-  )
-  parameters <- list(
-    .progress = list(type = "graphical", interval = 1),
-    .globals = list(verbose = FALSE),
-    Biomass_core = list(.saveInitialTime = NA)
-  )
+test_that("test Init", {
+  opts <- options(reproducible.useGDAL = FALSE,
+                  spades.moduleCodeChecks = FALSE,
+                  reproducible.useMemoise = TRUE,
+                  spades.useRequire = FALSE,
+                  LandR.assertions = FALSE,
+                  spades.recoveryMode = FALSE)
+  on.exit(options(opts))
+  require("raster")
+  require("data.table")
+  module <- "Biomass_core"
+  modulePath <- getwd()
+  while( grepl(module, modulePath)) modulePath <- dirname(modulePath)
+  outputPath <- checkPath(file.path(tempdir(), rndstr(1)), create = TRUE)
+  path <- list(modulePath = modulePath, # TODO: use general path
+               outputPath = outputPath) # TODO: use general path
+  parameters <- list(Biomass_core = list(.saveInitialTime = NA))
+
   initialCommunitiesMap <- raster(
     xmn = 50, xmx = 50 + 3 * 100,
     ymn = 50, ymx = 50 + 3 * 100,
@@ -77,10 +81,10 @@ test_that("test Biomass_coreInit", {
     objects = objects,
     paths = path
   )
-  if (exists("Biomass_coreInit")) {
-    simOutput <- Biomass_coreInit(mySim)
+  if (exists("Init")) {
+    simOutput <- Init(mySim)
   } else {
-    simOutput <- mySim$.mods$Biomass_core$Biomass_coreInit(mySim)
+    simOutput <- mySim$.mods$Biomass_core$Init(mySim)
   }
   # check the cohortData table
   cohortData <- simOutput$cohortData
@@ -179,10 +183,10 @@ test_that("test Biomass_coreInit", {
     objects = objects,
     paths = path
   )
-  if (exists("Biomass_coreInit")) {
-    simOutput <- Biomass_coreInit(mySim)
+  if (exists("Init")) {
+    simOutput <- Init(mySim)
   } else {
-    simOutput <- mySim$.mods$Biomass_core$Biomass_coreInit(mySim)
+    simOutput <- mySim$.mods$Biomass_core$Init(mySim)
   }
 
   # check the calibration mode

tests/testthat/test-Biomass_coreMortalityAndGrowth.R

@@ -6,14 +6,15 @@ test_that("test growth and mortality at main simulation stage",{
                   LandR.assertions = FALSE,
                   spades.recoveryMode = FALSE)
   on.exit(options(opts))
-  Require::Require(c("SpaDES.core", "reproducible", "data.table", "raster", "LandR"))
-  # define the module and path
-  module <- list("Biomass_core")
-  path <- list(modulePath="..",
-               outputPath="~/output")
-  parameters <- list(.progress=list(type="graphical", interval=1),
-                     .globals=list(verbose=FALSE),
-                     Biomass_core=list( .saveInitialTime=NA, .useCache = FALSE))
+  require("raster")
+  require("data.table")
+  module <- "Biomass_core"
+  modulePath <- getwd()
+  while( grepl(module, modulePath)) modulePath <- dirname(modulePath)
+  outputPath <- checkPath(file.path(tempdir(), rndstr(1)), create = TRUE)
+  path <- list(modulePath = modulePath, # TODO: use general path
+               outputPath = outputPath) # TODO: use general path
+  parameters <- list(Biomass_core = list(.saveInitialTime = NA))
 
   endYr <- 3
   startAge <- 1L

tests/testthat/test-Biomass_coreNoDispersalSeeding.R

@@ -1,11 +1,20 @@
 test_that("test no dispersal seeding algorithm",{
-  # define the module and path
-  module <- list("Biomass_core")
-  path <- list(modulePath = "..",
-               outputPath = "~/output")
-  parameters <- list(.progress = list(type = "graphical", interval = 1),
-                     .globals = list(verbose = FALSE),
-                     Biomass_core = list( .saveInitialTime = NA))
+  opts <- options(reproducible.useGDAL = FALSE,
+                  spades.moduleCodeChecks = FALSE,
+                  reproducible.useMemoise = TRUE,
+                  spades.useRequire = FALSE,
+                  LandR.assertions = FALSE,
+                  spades.recoveryMode = FALSE)
+  on.exit(options(opts))
+  require("raster")
+  require("data.table")
+  module <- "Biomass_core"
+  modulePath <- getwd()
+  while( grepl(module, modulePath)) modulePath <- dirname(modulePath)
+  outputPath <- checkPath(file.path(tempdir(), rndstr(1)), create = TRUE)
+  path <- list(modulePath = modulePath, # TODO: use general path
+               outputPath = outputPath) # TODO: use general path
+  parameters <- list(Biomass_core = list(.saveInitialTime = NA))
 
   pixelGroupMap <- raster(xmn = 50, xmx = 50 + 100 * 100,
                         ymn = 50, ymx = 50 + 100 * 100,

tests/testthat/test-Biomass_coreSummaryBGM.R

@@ -1,12 +1,21 @@
 test_that("test summary aboveground biomass, growth, mortality. ",{
-  library(raster)
-  library(data.table)
-  module <- list("Biomass_core")
-  path <- list(modulePath="..",
-               outputPath="~/output")
-  parameters <- list(.progress=list(type="graphical", interval=1),
-                     .globals=list(verbose=FALSE),
-                     Biomass_core=list( .saveInitialTime=NA))
+  opts <- options(reproducible.useGDAL = FALSE,
+                  spades.moduleCodeChecks = FALSE,
+                  reproducible.useMemoise = TRUE,
+                  spades.useRequire = FALSE,
+                  LandR.assertions = FALSE,
+                  spades.recoveryMode = FALSE)
+  on.exit(options(opts))
+  require("raster")
+  require("data.table")
+  module <- "Biomass_core"
+  modulePath <- getwd()
+  while( grepl(module, modulePath)) modulePath <- dirname(modulePath)
+  outputPath <- checkPath(file.path(tempdir(), rndstr(1)), create = TRUE)
+  path <- list(modulePath = modulePath, # TODO: use general path
+               outputPath = outputPath) # TODO: use general path
+  parameters <- list(Biomass_core = list(.saveInitialTime = NA))
+
   cohortData <- data.table(expand.grid(speciesCode = 1:3,
                                        pixelGroup = 1:5))
   cohortData[,':='(B = seq(700, by = 50, length = 15),