From faa0528fcbc40fc8a3e4b6567dcdb0d0da2d9eb2 Mon Sep 17 00:00:00 2001 From: Eliot McIntire Date: Thu, 25 Nov 2021 10:35:39 -0800 Subject: [PATCH 01/11] Omnibus commit --- Biomass_core.R | 1446 +++++++++-------- Biomass_core.Rmd | 11 +- R/age-cohorts.R | 8 +- R/helpers.R | 53 +- R/spinup.R | 5 +- data/CHECKSUMS.txt | 139 +- .../test-Biomass_coreFireDisturbance.R | 27 +- tests/testthat/test-Biomass_coreInit.R | 44 +- .../test-Biomass_coreMortalityAndGrowth.R | 17 +- .../test-Biomass_coreNoDispersalSeeding.R | 23 +- tests/testthat/test-Biomass_coreSummaryBGM.R | 25 +- .../testthat/test-Biomass_coreSummaryRegen.R | 23 +- ...st-Biomass_coreUniversalDispersalSeeding.R | 23 +- .../test-Biomass_coreWardDispersalSeeding.R | 241 ++- tests/testthat/test-addNewCohorts.R | 46 +- tests/testthat/test-agereclassification.R | 26 +- tests/testthat/test-assignLightProb.R | 25 +- tests/testthat/test-cacheSpinUpFunction.R | 23 +- tests/testthat/test-calcSiteShade.R | 25 +- tests/testthat/test-calculateANPP.R | 25 +- tests/testthat/test-calculateAgeMortality.R | 25 +- tests/testthat/test-calculateCompetition.R | 25 +- .../testthat/test-calculateGrowthMortality.R | 24 +- tests/testthat/test-calculateSumB.R | 24 +- tests/testthat/test-spinUp.R | 23 +- ...timeScheduleofAgeReclassificationandSumB.R | 24 +- tests/unitTests.R | 4 +- 27 files changed, 1344 insertions(+), 1060 deletions(-) diff --git a/Biomass_core.R b/Biomass_core.R index d7b5e4f..f797d13 100644 --- a/Biomass_core.R +++ b/Biomass_core.R @@ -23,9 +23,9 @@ defineModule(sim, list( "raster", "Rcpp", "R.utils", "scales", "sp", "tidyr", "PredictiveEcology/LandR@development (>= 1.0.0.9001)", "PredictiveEcology/pemisc@development", - "PredictiveEcology/reproducible@development", - "PredictiveEcology/SpaDES.core@development", - "PredictiveEcology/SpaDES.tools@development", + "reproducible", + "SpaDES.core", + "SpaDES.tools", "ianmseddy/LandR.CS@master (>= 0.0.2.0002)"), parameters = rbind( defineParameter("calcSummaryBGM", "character", "end", NA, NA, @@ -139,7 +139,7 @@ defineModule(sim, list( "trunk/tests/v6.0-2.0/ecoregions.txt")), expectsInput("ecoregionMap", "RasterLayer", desc = paste("ecoregion map that has mapcodes match ecoregion table and speciesEcoregion table.", - "Defaults to a dummy map matching rasterToMatch with two regions")), + "Defaults to a dummy map matching rasterToMatch with two regions. Must be a factor raster.")), # expectsInput("initialCommunities", "data.table", # desc = "initial community table", # sourceURL = "https://raw.githubusercontent.com/LANDIS-II-Foundation/Extensions-Succession/master/biomass-succession-archive/trunk/tests/v6.0-2.0/initial-communities.txt"), @@ -347,20 +347,22 @@ doEvent.Biomass_core <- function(sim, eventTime, eventType, debug = FALSE) { "Biomass_core", "summaryBGM", eventPriority = summBGMPriority$end) sim <- scheduleEvent(sim, start(sim) + P(sim)$successionTimestep, "Biomass_core", "summaryRegen", eventPriority = summRegenPriority) - sim <- scheduleEvent(sim, start(sim), - "Biomass_core", "plotSummaryBySpecies", eventPriority = plotPriority) ## only occurs before summaryRegen in init. - sim <- scheduleEvent(sim, end(sim), - "Biomass_core", "plotSummaryBySpecies", eventPriority = plotPriority) ## schedule the last plotting events (so that it doesn't depend on plot interval) + if (!is.na(P(sim)$.plotInitialTime)) { + sim <- scheduleEvent(sim, start(sim), + "Biomass_core", "plotSummaryBySpecies", eventPriority = plotPriority) ## only occurs before summaryRegen in init. + sim <- scheduleEvent(sim, end(sim), + "Biomass_core", "plotSummaryBySpecies", eventPriority = plotPriority) ## schedule the last plotting events (so that it doesn't depend on plot interval) - if (P(sim)$.plotMaps) { - sim <- scheduleEvent(sim, P(sim)$.plotInitialTime, - "Biomass_core", "plotMaps", eventPriority = plotPriority + 0.25) - } + if (P(sim)$.plotMaps) { + sim <- scheduleEvent(sim, P(sim)$.plotInitialTime, + "Biomass_core", "plotMaps", eventPriority = plotPriority + 0.25) + } - sim <- scheduleEvent(sim, start(sim), - "Biomass_core", "plotAvgs", eventPriority = plotPriority + 0.5) - sim <- scheduleEvent(sim, end(sim), - "Biomass_core", "plotAvgs", eventPriority = plotPriority + 0.5) + sim <- scheduleEvent(sim, start(sim), + "Biomass_core", "plotAvgs", eventPriority = plotPriority + 0.5) + sim <- scheduleEvent(sim, end(sim), + "Biomass_core", "plotAvgs", eventPriority = plotPriority + 0.5) + } if (!is.na(P(sim)$.saveInitialTime)) { if (P(sim)$.saveInitialTime < start(sim) + P(sim)$successionTimestep) { @@ -475,9 +477,18 @@ Init <- function(sim, verbose = getOption("LandR.verbose", TRUE)) { ############################################## ## species ############################################## + if (!is.data.table(sim$species)) setDT(sim$species) if (is.null(sim$species)) stop("'species' object must be provided") - species <- setDT(sim$species)[, speciesCode := as.factor(species)] + if ("speciesCode" %in% colnames(sim$species)) { + if ("species" %in% colnames(sim$species)) + sim$species[, species := as.character(speciesCode)] + } else { + if (!"species" %in% colnames(sim$species)) + stop("species object must have either species or speciesCode column, or both") + sim$species[, speciesCode := as.factor(species)] + } + species <- sim$species LandR::assertColumns(species, c(species = "character", Area = "factor", longevity = "integer", sexualmature = "integer", shadetolerance = "numeric", @@ -603,6 +614,11 @@ Init <- function(sim, verbose = getOption("LandR.verbose", TRUE)) { biomassModel <- quote(lme4::lmer(B ~ logAge * speciesCode + cover * speciesCode + (logAge + cover + speciesCode | ecoregionGroup))) + coverModel <- quote(lme4::glmer(cbind(coverPres, coverNum) ~ + (1 | ecoregionGroup), family = binomial)) + biomassModel <- quote(lme4::lmer(B ~ logAge + cover + + (logAge + cover | ecoregionGroup))) + ## COVER message(blue("Estimating Species Establishment Probability from "), red("DUMMY values of ecoregionGroup "), blue("using the formula:\n"), magenta(format(coverModel))) @@ -644,7 +660,7 @@ Init <- function(sim, verbose = getOption("LandR.verbose", TRUE)) { modelBiomass = modelBiomass, successionTimestep = P(sim)$successionTimestep, currentYear = time(sim)) - if (ncell(sim$rasterToMatch) > 3e6) .gc() + if (ncell(sim$rasterToMatch) > 3e6) for (i in 1:10) gc() # from amc package, but just copied here as amc is not a dep ######################################################################## # Create initial communities, i.e., pixelGroups @@ -695,10 +711,10 @@ Init <- function(sim, verbose = getOption("LandR.verbose", TRUE)) { LandR::assertUniqueCohortData(sim$cohortData, c("pixelGroup", "ecoregionGroup", "speciesCode")) } - if (!is.null(sim$ecoregionMap) && !is.null(sim$pixelGroupMap) && !is.null(sim$biomassMap)) { - compareRaster(sim$biomassMap, sim$ecoregionMap, sim$pixelGroupMap, sim$rasterToMatch, orig = TRUE) + if (!is.null(sim$ecoregionMap) && !is.null(sim$pixelGroupMap)) { + compareRaster(sim$ecoregionMap, sim$pixelGroupMap, sim$rasterToMatch, orig = TRUE) } else { - stop("Expecting 3 rasters at this point: sim$biomassMap, sim$ecoregionMap, ", + stop("Expecting 2 rasters at this point: sim$ecoregionMap, ", "sim$pixelGroupMap and they must match sim$rasterToMatch") } @@ -838,6 +854,7 @@ Init <- function(sim, verbose = getOption("LandR.verbose", TRUE)) { set(cohortData, NULL, "B", asInteger(cohortData[["B"]])) } + pixelAll <- cohortData[, .(uniqueSumB = sum(B, na.rm = TRUE)), by = pixelGroup] if (!is.integer(pixelAll[["uniqueSumB"]])) set(pixelAll, NULL, "uniqueSumB", asInteger(pixelAll[["uniqueSumB"]])) @@ -888,7 +905,8 @@ Init <- function(sim, verbose = getOption("LandR.verbose", TRUE)) { return(invisible(sim)) } -SummaryBGM <- compiler::cmpfun(function(sim) { +SummaryBGM <- #compiler::cmpfun( + function(sim) { pixelGroups <- data.table(pixelGroupIndex = unique(sim$cohortData$pixelGroup), temID = 1:length(unique(sim$cohortData$pixelGroup))) cutpoints <- sort(unique(c(seq(1, max(pixelGroups$temID), by = P(sim)$cutpoint), @@ -972,9 +990,33 @@ SummaryBGM <- compiler::cmpfun(function(sim) { rm(cutpoints, pixelGroups, tempOutput_All, summaryBGMtable) ## TODO: is this needed? on exit, should free the mem used for these return(invisible(sim)) -}) +} +# ) + +MortalityAndGrowth <- # compiler::cmpfun( + function(sim) { + # Assertion 1 + missingSpeciesCode <- FALSE + if ("speciesCode" %in% colnames(sim$cohortData)) { + if (!is.factor(sim$cohortData$speciesCode)) + missingSpeciesCode <- TRUE + } else { + missingSpeciesCode <- TRUE + } -MortalityAndGrowth <- compiler::cmpfun(function(sim) { + if (missingSpeciesCode) + stop("sim$cohortData must have a column named speciesCode that is a factor") + + spCodeIsFactor <- TRUE + if ("speciesCode" %in% colnames(sim$species)) { + if (!is.factor(sim$species$speciesCode)) + spCodeIsFactor <- FALSE + } else { + spCodeIsFactor <- FALSE + } + if (!spCodeIsFactor) { + sim$species[, speciesCode := factor(species, levels = levels(sim$cohortData$speciesCode))] + } if (is.numeric(P(sim)$.useParallel)) { data.table::setDTthreads(P(sim)$.useParallel) @@ -983,7 +1025,7 @@ MortalityAndGrowth <- compiler::cmpfun(function(sim) { ## Install climate-sensitive functions (or not) #a <- try(requireNamespace(P(sim)$growthAndMortalityDrivers, quietly = TRUE)) ## Fixed (Eliot) TODO: this is not working. requireNamespace overrides try - #if (class(a) == "try-error") { + #if (class(a) == "try-error") if (!requireNamespace(P(sim)$growthAndMortalityDrivers, quietly = TRUE)) { stop(paste0("The package specified for growthAndMortalityDrivers, ", P(sim)$growthAndMortalityDrivers, ", must be installed")) @@ -993,7 +1035,8 @@ MortalityAndGrowth <- compiler::cmpfun(function(sim) { cohortData <- sim$cohortData pgs <- unique(cohortData$pixelGroup) - groupSize <- maxRowsDT(maxLen = 1e7, maxMem = P(sim)$.maxMemory) + groupSize <- 1e7 + # groupSize <- maxRowsDT(maxLen = 1e7, maxMem = P(sim)$.maxMemory) numGroups <- ceiling(length(pgs) / groupSize) groupNames <- paste0("Group", seq(numGroups)) if (length(pgs) > groupSize) { @@ -1072,6 +1115,8 @@ MortalityAndGrowth <- compiler::cmpfun(function(sim) { subCohortData <- calculateAgeMortality(cohortData = subCohortData) set(subCohortData, NULL, c("longevity", "mortalityshape"), NULL) + + # Calculate bAP and bPM subCohortData <- calculateCompetition(cohortData = subCohortData) if (!P(sim)$calibrate) { set(subCohortData, NULL, "sumB", NULL) @@ -1079,7 +1124,19 @@ MortalityAndGrowth <- compiler::cmpfun(function(sim) { subCohortData <- calculateANPP(cohortData = subCohortData) ## competition effect on aNPP via bPM set(subCohortData, NULL, "growthcurve", NULL) + if (getOption("biomassCore.plotDebug", FALSE)) { + par(mfrow = c(3,3)); + cd <- subCohortData + plot(cd$age, cd$B, main = "Biomass prior to mortality") + # plot(cd[, maxAge := max(age), by = "pixelGroup"]$maxAge, cd$B, main = "Biomass prior to mortality") + + } + + if (getOption("biomassCore.plotDebug", FALSE)) + plot(cd$age, cd$aNPPAct, main = "aNPP prior to removing mAge"); set(subCohortData, NULL, "aNPPAct", pmax(1, subCohortData$aNPPAct - subCohortData$mAge)) + if (getOption("biomassCore.plotDebug", FALSE)) + plot(cd$age, cd$aNPPAct, main = "aNPP after removing mAge"); ## generate climate-sensitivity predictions - this will no longer run if LandR pkg is the driver if (!P(sim)$growthAndMortalityDrivers == "LandR") { @@ -1107,10 +1164,20 @@ MortalityAndGrowth <- compiler::cmpfun(function(sim) { subCohortData[, aNPPAct := pmax(0, asInteger(aNPPAct * growthPred/100))] #changed from ratio to pct for memory } subCohortData <- calculateGrowthMortality(cohortData = subCohortData) + + if (getOption("biomassCore.plotDebug", FALSE)) + plot(cd$age, cd$mBio, main = "mBio prior to removing mAge"); + set(subCohortData, NULL, "mBio", pmax(0, subCohortData$mBio - subCohortData$mAge)) set(subCohortData, NULL, "mBio", pmin(subCohortData$mBio, subCohortData$aNPPAct)) set(subCohortData, NULL, "mortality", subCohortData$mBio + subCohortData$mAge) + if (getOption("biomassCore.plotDebug", FALSE)) { + plot(cd$age, cd$mBio, main = "mBio after removing mAge"); + plot(cd$age, cd$mAge, main = "mAge"); + plot(cd$age, cd$mortality, main = "total mortality") + } + ## this line will return mortality unchanged unless LandR_BiomassGMCS is also run if (!P(sim)$growthAndMortalityDrivers == "LandR") { @@ -1138,6 +1205,9 @@ MortalityAndGrowth <- compiler::cmpfun(function(sim) { set(subCohortData, NULL, "B", subCohortData$B + asInteger(subCohortData$aNPPAct - subCohortData$mortality)) } + if (getOption("biomassCore.plotDebug", FALSE)) { + plot(cd$age, cd$B, main = "Biomass after mortality") + } subCohortData[, `:=`(mortality = asInteger(mortality), aNPPAct = asInteger(aNPPAct))] if (numGroups == 1) { @@ -1148,7 +1218,8 @@ MortalityAndGrowth <- compiler::cmpfun(function(sim) { rm(subCohortData) } rm(cohortData) - gc() ## restored this gc call 2019-08-20 (AMC) + if (NROW(sim$cohortData) > 1e6) # Eliot added 2021-07-08 -- totally unnecessary and slows down "small" sims + gc() ## restored this gc call 2019-08-20 (AMC) ## now age this year's recruits sim$cohortData[age == 1, age := age + 1L] @@ -1161,7 +1232,8 @@ MortalityAndGrowth <- compiler::cmpfun(function(sim) { } LandR::assertCohortData(sim$cohortData, sim$pixelGroupMap, cohortDefinitionCols = P(sim)$cohortDefinitionCols) return(invisible(sim)) -}) +} +#) Dispersal <- function(sim) { @@ -1182,7 +1254,8 @@ Dispersal <- function(sim) { return(invisible(sim)) } -NoDispersalSeeding <- compiler::cmpfun(function(sim, tempActivePixel, pixelsFromCurYrBurn) { +NoDispersalSeeding <- #compiler::cmpfun( + function(sim, tempActivePixel, pixelsFromCurYrBurn) { # if (sim$lastFireYear == round(time(sim))) { # if current year is both fire year and succession year # # find new active pixel that remove successful postfire regeneration # # since this is on site regeneration, all the burnt pixels can not seeding @@ -1248,27 +1321,50 @@ NoDispersalSeeding <- compiler::cmpfun(function(sim, tempActivePixel, pixelsFrom sim$lastReg <- round(time(sim)) return(invisible(sim)) -}) +}#) -UniversalDispersalSeeding <- compiler::cmpfun(function(sim, tempActivePixel) { +UniversalDispersalSeeding <- #compiler::cmpfun( + function(sim, tempActivePixel, pixelsFromCurYrBurn) { # if (sim$lastFireYear == round(time(sim))) { # the current year is both fire year and succession year # tempActivePixel <- sim$activePixelIndex[!(sim$activePixelIndex %in% sim$postFirePixel)] # } else { # tempActivePixel <- sim$activePixelIndex # } - sim$cohortData <- calculateSumB(sim$cohortData, lastReg = sim$lastReg, currentTime = round(time(sim)), - successionTimestep = P(sim)$successionTimestep) - species <- sim$species + + sim$cohortData <- calculateSumB(cohortData = sim$cohortData, + lastReg = sim$lastReg, currentTime = round(time(sim)), + successionTimestep = P(sim)$successionTimestep) + if (is.null(sim$speciesEcoregion)) stop("WardDispersalSeeding requires a speciesEcoregion") + siteShade <- calcSiteShade(currentTime = round(time(sim)), cohortData = sim$cohortData, + sim$speciesEcoregion, sim$minRelativeB) + activePixelGroup <- data.table(pixelGroup = unique(getValues(sim$pixelGroupMap)[tempActivePixel])) %>% + na.omit() + siteShade <- siteShade[activePixelGroup, on = "pixelGroup"] + siteShade[is.na(siteShade), siteShade := 0] + + ## Seed source cells: + ## 1. Select only sexually mature cohorts, then + ## 2. collapse to pixelGroup by species, i.e,. doesn't matter that there is >1 cohort of same species + sim$cohortData <- sim$species[, c("speciesCode", "sexualmature")][sim$cohortData, + on = "speciesCode"] + # sim$cohortData <- setkey(sim$cohortData, speciesCode)[setkey(sim$species[, .(speciesCode, sexualmature)], + # speciesCode), + # nomatch = 0] + + + # sim$cohortData <- calculateSumB(sim$cohortData, lastReg = sim$lastReg, currentTime = round(time(sim)), + # successionTimestep = P(sim)$successionTimestep) + # species <- sim$species # all species can provide seed source, i.e. age>=sexualmature speciessource <- setkey(sim$species[, .(speciesCode, k = 1)], k) - siteShade <- data.table(calcSiteShade(currentTime = round(time(sim)), sim$cohortData, - sim$speciesEcoregion, sim$minRelativeB)) - activePixelGroup <- unique(data.table(pixelGroup = getValues(sim$pixelGroupMap)[tempActivePixel], - ecoregionGroup = factorValues2(sim$ecoregionMap, getValues(sim$ecoregionMap), - att = "ecoregionGroup")[tempActivePixel]), - by = "pixelGroup") - siteShade <- dplyr::left_join(activePixelGroup, siteShade, by = "pixelGroup") %>% data.table() - siteShade[is.na(siteShade), siteShade := 0] + # siteShade <- data.table(calcSiteShade(currentTime = round(time(sim)), sim$cohortData, + # sim$speciesEcoregion, sim$minRelativeB)) + # activePixelGroup <- unique(data.table(pixelGroup = getValues(sim$pixelGroupMap)[tempActivePixel], + # ecoregionGroup = factorValues2(sim$ecoregionMap, getValues(sim$ecoregionMap), + # att = "ecoregionGroup")[tempActivePixel]), + # by = "pixelGroup") + # siteShade <- dplyr::left_join(activePixelGroup, siteShade, by = "pixelGroup") %>% data.table() + # siteShade[is.na(siteShade), siteShade := 0] setkey(siteShade[, k := 1], k) # i believe this is the latest version how the landis guys calculate sufficient light # http://landis-extensions.googlecode.com/svn/trunk/succession-library/trunk/src/ReproductionDefaults.cs @@ -1319,505 +1415,517 @@ UniversalDispersalSeeding <- compiler::cmpfun(function(sim, tempActivePixel) { } sim$lastReg <- round(time(sim)) return(invisible(sim)) -}) - -WardDispersalSeeding <- compiler::cmpfun(function(sim, tempActivePixel, pixelsFromCurYrBurn, - verbose = getOption("LandR.verbose", TRUE)) { - - sim$cohortData <- calculateSumB(cohortData = sim$cohortData, - lastReg = sim$lastReg, currentTime = round(time(sim)), - successionTimestep = P(sim)$successionTimestep) - siteShade <- calcSiteShade(currentTime = round(time(sim)), cohortData = sim$cohortData, - sim$speciesEcoregion, sim$minRelativeB) - activePixelGroup <- data.table(pixelGroup = unique(getValues(sim$pixelGroupMap)[tempActivePixel])) %>% - na.omit() - siteShade <- siteShade[activePixelGroup, on = "pixelGroup"] - siteShade[is.na(siteShade), siteShade := 0] - - ## Seed source cells: - ## 1. Select only sexually mature cohorts, then - ## 2. collapse to pixelGroup by species, i.e,. doesn't matter that there is >1 cohort of same species - sim$cohortData <- sim$species[, c("speciesCode", "sexualmature")][sim$cohortData, - on = "speciesCode"] - # sim$cohortData <- setkey(sim$cohortData, speciesCode)[setkey(sim$species[, .(speciesCode, sexualmature)], - # speciesCode), - # nomatch = 0] - matureCohorts <- sim$cohortData[age >= sexualmature] %>% - unique(by = c("pixelGroup", "speciesCode")) %>% - setkey(., speciesCode) - matureCohorts <- matureCohorts[, .(pixelGroup, speciesCode)] - set(sim$cohortData, NULL, "sexualmature", NULL) - - if (NROW(matureCohorts) > 0) { - seedSource <- sim$species[, list(speciesCode, seeddistance_eff, seeddistance_max)] %>% - setkey(., speciesCode) %>% - .[matureCohorts] - setkey(seedSource, speciesCode) - # Seed Receiving cells: - # 1. Must be sufficient light - # seed receive just for the species that are seed source - tempspecies1 <- sim$species[speciesCode %in% unique(matureCohorts$speciesCode),][ - , .(speciesCode, shadetolerance, seeddistance_eff, seeddistance_max)] - seedReceive <- setkey(tempspecies1[, c(k = 1, .SD)], k)[setkey(siteShade[ - , c(k = 1, .SD)], k), allow.cartesian = TRUE][, k := NULL] - seedReceive <- assignLightProb(sufficientLight = sim$sufficientLight, seedReceive) - set(seedReceive, NULL, "siteShade", NULL) - - # 3. Remove any species from the seedSource that couldn't regeneration anywhere on the map due to insufficient light - seedReceive <- seedReceive[lightProb %>>% runif(NROW(seedReceive), 0, 1), ][ - , .(pixelGroup, speciesCode, seeddistance_eff, seeddistance_max)] - setkey(seedReceive, speciesCode) - - # rm ones that had successful serotiny or resprouting - seedReceive <- seedReceive[!sim$cohortData[age == 1L], on = c("pixelGroup", "speciesCode")] - # (info contained within seedReceive) - # this is should be a inner join, needs to specify the nomatch=0, nomatch = NA is default that sugest the full joint. - seedSource <- seedSource[speciesCode %in% unique(seedReceive$speciesCode),] - - # it could be more efficient if sim$pixelGroupMap is reduced map by removing the pixels that have - # successful postdisturbance regeneration and the inactive pixels - # how to subset the reducedmap - # if (sim$lastFireYear == round(time(sim))) { # the current year is both fire year and succession year - # inactivePixelIndex <- c(sim$inactivePixelIndex, sim$treedFirePixelTableSinceLastDisp$pixelIndex) - # } else { - # inactivePixelIndex <- sim$inactivePixelIndex - # } - reducedPixelGroupMap <- sim$pixelGroupMap - - # Calculate the maximum size of the chunks for LANDISDisp - if (length(pixelsFromCurYrBurn) > 0) { - reducedPixelGroupMap[pixelsFromCurYrBurn] <- NA - } - - seedingData <- LANDISDisp(dtRcv = seedReceive, plot.it = FALSE, - dtSrc = seedSource, - speciesTable = sim$species, - pixelGroupMap = reducedPixelGroupMap, - successionTimestep = P(sim)$successionTimestep, - verbose = getOption("LandR.verbose", TRUE) > 0) +}#) + +WardDispersalSeeding <- # compiler::cmpfun( + function(sim, tempActivePixel, pixelsFromCurYrBurn, + verbose = getOption("LandR.verbose", TRUE)) { + + sim$cohortData <- calculateSumB(cohortData = sim$cohortData, + lastReg = sim$lastReg, currentTime = round(time(sim)), + successionTimestep = P(sim)$successionTimestep) + if (is.null(sim$speciesEcoregion)) stop("WardDispersalSeeding requires a speciesEcoregion") + siteShade <- calcSiteShade(currentTime = round(time(sim)), cohortData = sim$cohortData, + sim$speciesEcoregion, sim$minRelativeB) + activePixelGroup <- data.table(pixelGroup = unique(getValues(sim$pixelGroupMap)[tempActivePixel])) %>% + na.omit() + siteShade <- siteShade[activePixelGroup, on = "pixelGroup"] + siteShade[is.na(siteShade), siteShade := 0] + + ## Seed source cells: + ## 1. Select only sexually mature cohorts, then + ## 2. collapse to pixelGroup by species, i.e,. doesn't matter that there is >1 cohort of same species + sim$cohortData <- sim$species[, c("speciesCode", "sexualmature")][sim$cohortData, + on = "speciesCode"] + # sim$cohortData <- setkey(sim$cohortData, speciesCode)[setkey(sim$species[, .(speciesCode, sexualmature)], + # speciesCode), + # nomatch = 0] + matureCohorts <- sim$cohortData[age >= sexualmature] %>% + unique(by = c("pixelGroup", "speciesCode")) %>% + setkey(., speciesCode) + matureCohorts <- matureCohorts[, .(pixelGroup, speciesCode)] + set(sim$cohortData, NULL, "sexualmature", NULL) + + if (NROW(matureCohorts) > 0) { + seedSource <- sim$species[, list(speciesCode, seeddistance_eff, seeddistance_max)] %>% + setkey(., speciesCode) %>% + .[matureCohorts] + setkey(seedSource, speciesCode) + # Seed Receiving cells: + # 1. Must be sufficient light + # seed receive just for the species that are seed source + tempspecies1 <- sim$species[speciesCode %in% unique(matureCohorts$speciesCode),][ + , .(speciesCode, shadetolerance, seeddistance_eff, seeddistance_max)] + seedReceive <- setkey(tempspecies1[, c(k = 1, .SD)], k)[setkey(siteShade[ + , c(k = 1, .SD)], k), allow.cartesian = TRUE][, k := NULL] + seedReceive <- assignLightProb(sufficientLight = sim$sufficientLight, seedReceive) + set(seedReceive, NULL, "siteShade", NULL) + + # 3. Remove any species from the seedSource that couldn't regeneration anywhere on the map due to insufficient light + seedReceive <- seedReceive[lightProb %>>% runif(NROW(seedReceive), 0, 1), ][ + , .(pixelGroup, speciesCode, seeddistance_eff, seeddistance_max)] + setkey(seedReceive, speciesCode) + + # rm ones that had successful serotiny or resprouting + seedReceive <- seedReceive[!sim$cohortData[age == 1L], on = c("pixelGroup", "speciesCode")] + # (info contained within seedReceive) + # this is should be a inner join, needs to specify the nomatch=0, nomatch = NA is default that sugest the full joint. + seedSource <- seedSource[speciesCode %in% unique(seedReceive$speciesCode),] + + # it could be more efficient if sim$pixelGroupMap is reduced map by removing the pixels that have + # successful postdisturbance regeneration and the inactive pixels + # how to subset the reducedmap + # if (sim$lastFireYear == round(time(sim))) { # the current year is both fire year and succession year + # inactivePixelIndex <- c(sim$inactivePixelIndex, sim$treedFirePixelTableSinceLastDisp$pixelIndex) + # } else { + # inactivePixelIndex <- sim$inactivePixelIndex + # } + reducedPixelGroupMap <- sim$pixelGroupMap + + # Calculate the maximum size of the chunks for LANDISDisp + if (length(pixelsFromCurYrBurn) > 0) { + reducedPixelGroupMap[pixelsFromCurYrBurn] <- NA + } - if (getOption("LandR.verbose", TRUE) > 0) { - emptyForestPixels <- sim$treedFirePixelTableSinceLastDisp[burnTime < time(sim)] - seedsArrivedPixels <- unique(seedingData[emptyForestPixels, on = "pixelIndex", nomatch = 0], by = "pixelIndex") - message(blue("Of", NROW(emptyForestPixels), - "burned and empty pixels: Num pixels where seeds arrived:", - NROW(seedsArrivedPixels))) - } + seedingData <- LANDISDisp(dtRcv = seedReceive, plot.it = FALSE, + dtSrc = seedSource, + speciesTable = sim$species, + pixelGroupMap = reducedPixelGroupMap, + successionTimestep = P(sim)$successionTimestep, + verbose = getOption("LandR.verbose", TRUE) > 0) - rm(seedReceive, seedSource) - if (NROW(seedingData) > 0) { - seedingData[, ecoregionGroup := factorValues2(sim$ecoregionMap, getValues(sim$ecoregionMap), - att = "ecoregionGroup")[seedingData$pixelIndex]] - seedingData <- setkey(seedingData, ecoregionGroup, speciesCode) - - specieseco_current <- speciesEcoregionLatestYear( - sim$speciesEcoregion[, .(year, speciesCode, establishprob, ecoregionGroup)], - round(time(sim))) - specieseco_current <- setkeyv(specieseco_current, c("ecoregionGroup", "speciesCode")) - - # specieseco_current <- sim$speciesEcoregion[year <= round(time(sim))] - # specieseco_current <- setkey(specieseco_current[year == max(specieseco_current$year), - # .(speciesCode, establishprob, ecoregionGroup)], - # ecoregionGroup, speciesCode) - seedingData <- seedingData[specieseco_current, nomatch = 0] - - ############################################## - # Run probability of establishment - ############################################## - LandR::assertCohortData(sim$cohortData, sim$pixelGroupMap, cohortDefinitionCols = P(sim)$cohortDefinitionCols) - - seedingData <- seedingData[runif(nrow(seedingData)) <= establishprob, ] if (getOption("LandR.verbose", TRUE) > 0) { - seedsArrivedPixels <- unique(seedingData[emptyForestPixels, on = "pixelIndex", nomatch = 0], - by = "pixelIndex") + emptyForestPixels <- sim$treedFirePixelTableSinceLastDisp[burnTime <= time(sim)] + seedsArrivedPixels <- unique(seedingData[emptyForestPixels, on = "pixelIndex", nomatch = 0], by = "pixelIndex") message(blue("Of", NROW(emptyForestPixels), - "burned and empty pixels: Num pixels where seedlings established:", + "burned and empty pixels: Num pixels where seeds arrived:", NROW(seedsArrivedPixels))) } - set(seedingData, NULL, "establishprob", NULL) - if (P(sim)$calibrate == TRUE) { - seedingData_summ <- seedingData[ - , .(seedingAlgorithm = P(sim)$seedingAlgorithm, Year = round(time(sim)), - numberOfReg = length(pixelIndex)), - by = speciesCode] - seedingData_summ <- setkey(seedingData_summ, speciesCode)[ - setkey(sim$species[, .(species,speciesCode)], speciesCode), nomatch = 0][ - , .(species, seedingAlgorithm, Year, numberOfReg)] - sim$regenerationOutput <- rbindlist(list(sim$regenerationOutput, seedingData_summ)) - } - if (nrow(seedingData) > 0) { - outs <- updateCohortData(seedingData, cohortData = sim$cohortData, - pixelGroupMap = sim$pixelGroupMap, - currentTime = round(time(sim)), speciesEcoregion = sim$speciesEcoregion, - treedFirePixelTableSinceLastDisp = NULL, - successionTimestep = P(sim)$successionTimestep) - - sim$cohortData <- outs$cohortData - sim$pixelGroupMap <- outs$pixelGroupMap + rm(seedReceive, seedSource) + if (NROW(seedingData) > 0) { + seedingData[, ecoregionGroup := factorValues2(sim$ecoregionMap, getValues(sim$ecoregionMap), + att = "ecoregionGroup")[seedingData$pixelIndex]] + seedingData <- setkey(seedingData, ecoregionGroup, speciesCode) + + specieseco_current <- speciesEcoregionLatestYear( + sim$speciesEcoregion[, .(year, speciesCode, establishprob, ecoregionGroup)], + round(time(sim))) + specieseco_current <- setkeyv(specieseco_current, c("ecoregionGroup", "speciesCode")) + + # specieseco_current <- sim$speciesEcoregion[year <= round(time(sim))] + # specieseco_current <- setkey(specieseco_current[year == max(specieseco_current$year), + # .(speciesCode, establishprob, ecoregionGroup)], + # ecoregionGroup, speciesCode) + seedingData <- seedingData[specieseco_current, nomatch = 0] + + ############################################## + # Run probability of establishment + ############################################## + LandR::assertCohortData(sim$cohortData, sim$pixelGroupMap, cohortDefinitionCols = P(sim)$cohortDefinitionCols) + + seedingData <- seedingData[runif(nrow(seedingData)) <= establishprob, ] + if (getOption("LandR.verbose", TRUE) > 0) { + seedsArrivedPixels <- unique(seedingData[emptyForestPixels, on = "pixelIndex", nomatch = 0], + by = "pixelIndex") + message(blue("Of", NROW(emptyForestPixels), + "burned and empty pixels: Num pixels where seedlings established:", + NROW(seedsArrivedPixels))) + } + + set(seedingData, NULL, "establishprob", NULL) + if (P(sim)$calibrate == TRUE) { + seedingData_summ <- seedingData[ + , .(seedingAlgorithm = P(sim)$seedingAlgorithm, Year = round(time(sim)), + numberOfReg = length(pixelIndex)), + by = speciesCode] + seedingData_summ <- setkey(seedingData_summ, speciesCode)[ + setkey(sim$species[, .(species,speciesCode)], speciesCode), nomatch = 0][ + , .(species, seedingAlgorithm, Year, numberOfReg)] + sim$regenerationOutput <- rbindlist(list(sim$regenerationOutput, seedingData_summ)) + } + if (nrow(seedingData) > 0) { + outs <- updateCohortData(seedingData, cohortData = sim$cohortData, + pixelGroupMap = sim$pixelGroupMap, + currentTime = round(time(sim)), speciesEcoregion = sim$speciesEcoregion, + treedFirePixelTableSinceLastDisp = NULL, + successionTimestep = P(sim)$successionTimestep) + + sim$cohortData <- outs$cohortData + sim$pixelGroupMap <- outs$pixelGroupMap + } } } - } - sim$lastReg <- round(time(sim)) - return(invisible(sim)) -}) - -summaryRegen <- compiler::cmpfun(function(sim) { - #cohortData <- sim$cohortData - if (!is.na(P(sim)$.plotInitialTime) | !is.na(P(sim)$.saveInitialTime)) { - pixelGroupMap <- sim$pixelGroupMap - names(pixelGroupMap) <- "pixelGroup" - # please note that the calculation of reproduction is based on successioinTime step interval, - pixelAll <- sim$cohortData[age <= P(sim)$successionTimestep + 1, - .(uniqueSumReproduction = sum(B, na.rm = TRUE)), - by = pixelGroup] - if (!is.integer(pixelAll[["uniqueSumReproduction"]])) - set(pixelAll, NULL, 'uniqueSumReproduction', asInteger(pixelAll[["uniqueSumReproduction"]])) - - if (NROW(pixelAll) > 0) { - reproductionMap <- rasterizeReduced(pixelAll, pixelGroupMap, "uniqueSumReproduction") - setColors(reproductionMap) <- c("light green", "dark green") - } else { - reproductionMap <- setValues(pixelGroupMap, 0L) + sim$lastReg <- round(time(sim)) + return(invisible(sim)) + }# ) + +summaryRegen <- # compiler::cmpfun( + function(sim) { + #cohortData <- sim$cohortData + if (!is.na(P(sim)$.plotInitialTime) | !is.na(P(sim)$.saveInitialTime)) { + pixelGroupMap <- sim$pixelGroupMap + names(pixelGroupMap) <- "pixelGroup" + # please note that the calculation of reproduction is based on successioinTime step interval, + pixelAll <- sim$cohortData[age <= P(sim)$successionTimestep + 1, + .(uniqueSumReproduction = sum(B, na.rm = TRUE)), + by = pixelGroup] + if (!is.integer(pixelAll[["uniqueSumReproduction"]])) + set(pixelAll, NULL, 'uniqueSumReproduction', asInteger(pixelAll[["uniqueSumReproduction"]])) + + if (NROW(pixelAll) > 0) { + reproductionMap <- rasterizeReduced(pixelAll, pixelGroupMap, "uniqueSumReproduction") + setColors(reproductionMap) <- c("light green", "dark green") + } else { + reproductionMap <- setValues(pixelGroupMap, 0L) + } + rm(pixelAll) + sim$reproductionMap <- reproductionMap + rm(pixelGroupMap) } - rm(pixelAll) - sim$reproductionMap <- reproductionMap - rm(pixelGroupMap) + return(invisible(sim)) } - return(invisible(sim)) -}) - -plotSummaryBySpecies <- compiler::cmpfun(function(sim) { +#) - LandR::assertSpeciesPlotLabels(sim$species$species, sim$sppEquiv) +plotSummaryBySpecies <- #compiler::cmpfun( + function(sim) { - checkPath(file.path(outputPath(sim), "figures"), create = TRUE) + LandR::assertSpeciesPlotLabels(sim$species$species, sim$sppEquiv) - ## BIOMASS, WEIGHTED AVERAGE AGE, AVERAGE ANPP - ## AND AGE OF OLDEST COHORT PER SPECIES + checkPath(file.path(outputPath(sim), "figures"), create = TRUE) - ## Averages are calculated across pixels - ## don't expand table, multiply by no. pixels - faster - thisPeriod <- addNoPixel2CohortData(sim$cohortData, sim$pixelGroupMap, cohortDefinitionCols = P(sim)$cohortDefinitionCols) + ## BIOMASS, WEIGHTED AVERAGE AGE, AVERAGE ANPP + ## AND AGE OF OLDEST COHORT PER SPECIES - for (column in names(thisPeriod)) if (is.integer(thisPeriod[[column]])) - set(thisPeriod, NULL, column, as.numeric(thisPeriod[[column]])) + ## Averages are calculated across pixels + ## don't expand table, multiply by no. pixels - faster + thisPeriod <- addNoPixel2CohortData(sim$cohortData, sim$pixelGroupMap, cohortDefinitionCols = P(sim)$cohortDefinitionCols) - thisPeriod <- thisPeriod[, list(year = time(sim), - BiomassBySpecies = sum(B * noPixels, na.rm = TRUE), - AgeBySppWeighted = sum(age * B * noPixels, na.rm = TRUE) / - sum(B * noPixels, na.rm = TRUE), - aNPPBySpecies = sum(aNPPAct * noPixels, na.rm = TRUE), - OldestCohortBySpp = max(age, na.rm = TRUE)), - by = .(speciesCode)] + for (column in names(thisPeriod)) if (is.integer(thisPeriod[[column]])) + set(thisPeriod, NULL, column, as.numeric(thisPeriod[[column]])) - #overstory - cohortData <- addNoPixel2CohortData(sim$cohortData, sim$pixelGroupMap, cohortDefinitionCols = P(sim)$cohortDefinitionCols) - cohortData[, bWeightedAge := floor(sum(age * B) / sum(B) / 10) * 10, .(pixelGroup)] - # B was set as numeric to avoid problems with big numbers being integers - overstory <- cohortData[age >= bWeightedAge, .(overstoryBiomass = sum(as.numeric(B) * noPixels)), - .(speciesCode)] - thisPeriod <- thisPeriod[overstory, on = 'speciesCode'] + thisPeriod <- thisPeriod[, list(year = time(sim), + BiomassBySpecies = sum(B * noPixels, na.rm = TRUE), + AgeBySppWeighted = sum(age * B * noPixels, na.rm = TRUE) / + sum(B * noPixels, na.rm = TRUE), + aNPPBySpecies = sum(aNPPAct * noPixels, na.rm = TRUE), + OldestCohortBySpp = max(age, na.rm = TRUE)), + by = .(speciesCode)] - if (is.null(sim$summaryBySpecies)) { - sim$summaryBySpecies <- thisPeriod - } else { - sim$summaryBySpecies <- rbindlist(list(sim$summaryBySpecies, thisPeriod)) - } - - ## MEAN NO. PIXELS PER LEADING SPECIES - vtm <- raster::mask(sim$vegTypeMap, sim$studyAreaReporting) - freqs <- table(na.omit(factorValues2(vtm, vtm[], att = 2))) - tabl <- as.vector(freqs) - summaryBySpecies1 <- data.frame(year = rep(floor(time(sim)), length(freqs)), - leadingType = names(freqs), - #freqs = freqs, - counts = tabl, - stringsAsFactors = FALSE) - - whMixedLeading <- which(summaryBySpecies1$leadingType == "Mixed") - summaryBySpecies1$leadingType <- equivalentName(summaryBySpecies1$leadingType, sim$sppEquiv, - "EN_generic_short") - summaryBySpecies1$leadingType[whMixedLeading] <- "Mixed" - - colours <- equivalentName(names(sim$sppColorVect), sim$sppEquiv, "EN_generic_short") - whMixedSppColors <- which(names(sim$sppColorVect) == "Mixed") - colours[whMixedSppColors] <- "Mixed" - - colorIDs <- match(summaryBySpecies1$leadingType, colours) - summaryBySpecies1$cols <- sim$sppColorVect[colorIDs] - - if (is.null(sim$summaryBySpecies1)) { - sim$summaryBySpecies1 <- summaryBySpecies1 - } else { - sim$summaryBySpecies1 <- rbindlist(list(sim$summaryBySpecies1, summaryBySpecies1)) - } + #overstory + cohortData <- addNoPixel2CohortData(sim$cohortData, sim$pixelGroupMap, cohortDefinitionCols = P(sim)$cohortDefinitionCols) + cohortData[, bWeightedAge := floor(sum(age * B) / sum(B) / 10) * 10, .(pixelGroup)] + # B was set as numeric to avoid problems with big numbers being integers + overstory <- cohortData[age >= bWeightedAge, .(overstoryBiomass = sum(as.numeric(B) * noPixels)), + .(speciesCode)] + thisPeriod <- thisPeriod[overstory, on = 'speciesCode'] - if (length(unique(sim$summaryBySpecies1$year)) > 1) { - df <- sim$species[, list(speciesCode, species)][sim$summaryBySpecies, on = "speciesCode"] - df$species <- equivalentName(df$species, sim$sppEquiv, "EN_generic_short") - - colorIDs <- match(df$species, colours) - df$cols <- sim$sppColorVect[colorIDs] - - cols2 <- df$cols - names(cols2) <- df$species - - plot2 <- ggplot(data = df, aes(x = year, y = BiomassBySpecies, fill = species, group = species)) + - geom_area(position = "stack") + - scale_fill_manual(values = cols2) + - labs(x = "Year", y = "Biomass") + - theme(legend.text = element_text(size = 6), legend.title = element_blank()) + - scale_y_continuous(labels = function(x) format(x, scientific = TRUE)) - - if (!is.na(P(sim)$.plotInitialTime)) { - dev(mod$statsWindow) - Plot(plot2, title = paste0("Total biomass by species\n", "across pixels"), new = TRUE) + if (is.null(sim$summaryBySpecies)) { + sim$summaryBySpecies <- thisPeriod + } else { + sim$summaryBySpecies <- rbindlist(list(sim$summaryBySpecies, thisPeriod)) } - maxNpixels <- length(sim$activePixelIndexReporting) - cols3 <- sim$summaryBySpecies1$cols - names(cols3) <- sim$summaryBySpecies1$leadingType + ## MEAN NO. PIXELS PER LEADING SPECIES + vtm <- raster::mask(sim$vegTypeMap, sim$studyAreaReporting) + freqs <- table(na.omit(factorValues2(vtm, vtm[], att = 2))) + tabl <- as.vector(freqs) + summaryBySpecies1 <- data.frame(year = rep(floor(time(sim)), length(freqs)), + leadingType = names(freqs), + #freqs = freqs, + counts = tabl, + stringsAsFactors = FALSE) + + whMixedLeading <- which(summaryBySpecies1$leadingType == "Mixed") + summaryBySpecies1$leadingType <- equivalentName(summaryBySpecies1$leadingType, sim$sppEquiv, + "EN_generic_short") + summaryBySpecies1$leadingType[whMixedLeading] <- "Mixed" + + colours <- equivalentName(names(sim$sppColorVect), sim$sppEquiv, "EN_generic_short") + whMixedSppColors <- which(names(sim$sppColorVect) == "Mixed") + colours[whMixedSppColors] <- "Mixed" - plot3 <- ggplot(data = sim$summaryBySpecies1, aes(x = year, y = counts, fill = leadingType)) + - scale_fill_manual(values = cols3) + - labs(x = "Year", y = "Count") + - geom_area() + - theme(legend.text = element_text(size = 6), legend.title = element_blank()) + - geom_hline(yintercept = maxNpixels, linetype = "dashed", color = "darkgrey", size = 1) + colorIDs <- match(summaryBySpecies1$leadingType, colours) + summaryBySpecies1$cols <- sim$sppColorVect[colorIDs] - if (!is.na(P(sim)$.plotInitialTime)) { - dev(mod$statsWindow) - Plot(plot3, title = "Number of pixels, by leading type", new = TRUE) + if (is.null(sim$summaryBySpecies1)) { + sim$summaryBySpecies1 <- summaryBySpecies1 + } else { + sim$summaryBySpecies1 <- rbindlist(list(sim$summaryBySpecies1, summaryBySpecies1)) } - plot4 <- ggplot(data = df, aes(x = year, y = AgeBySppWeighted, - colour = species, group = species)) + - geom_line(size = 1) + - scale_colour_manual(values = cols2) + - labs(x = "Year", y = "Age") + - theme(legend.text = element_text(size = 6), legend.title = element_blank()) + if (length(unique(sim$summaryBySpecies1$year)) > 1) { + df <- sim$species[, list(speciesCode, species)][sim$summaryBySpecies, on = "speciesCode"] + df$species <- equivalentName(df$species, sim$sppEquiv, "EN_generic_short") - if (!is.na(P(sim)$.plotInitialTime)) { - dev(mod$statsWindow) - Plot(plot4, title = paste0("Biomass-weighted species age\n", - "(averaged across pixels)"), new = TRUE) - } + colorIDs <- match(df$species, colours) + df$cols <- sim$sppColorVect[colorIDs] - if (P(sim)$plotOverstory) { - plot5 <- ggplot(data = df, aes(x = year, y = overstoryBiomass, - fill = species, group = species)) + + cols2 <- df$cols + names(cols2) <- df$species + + plot2 <- ggplot(data = df, aes(x = year, y = BiomassBySpecies, fill = species, group = species)) + geom_area(position = "stack") + scale_fill_manual(values = cols2) + - labs(x = "Year", y = "Overstory Biomass") + + labs(x = "Year", y = "Biomass") + theme(legend.text = element_text(size = 6), legend.title = element_blank()) + scale_y_continuous(labels = function(x) format(x, scientific = TRUE)) - titleLab <- "Overstory biomass by species" - fileNamePlot5 <- "overstory_biomass.png" - } else { - plot5 <- ggplot(data = df, aes(x = year, y = OldestCohortBySpp, + if (!is.na(P(sim)$.plotInitialTime)) { + dev(mod$statsWindow) + Plot(plot2, title = paste0("Total biomass by species\n", "across pixels"), new = TRUE) + } + + maxNpixels <- length(sim$activePixelIndexReporting) + cols3 <- sim$summaryBySpecies1$cols + names(cols3) <- sim$summaryBySpecies1$leadingType + + plot3 <- ggplot(data = sim$summaryBySpecies1, aes(x = year, y = counts, fill = leadingType)) + + scale_fill_manual(values = cols3) + + labs(x = "Year", y = "Count") + + geom_area() + + theme(legend.text = element_text(size = 6), legend.title = element_blank()) + + geom_hline(yintercept = maxNpixels, linetype = "dashed", color = "darkgrey", size = 1) + + if (!is.na(P(sim)$.plotInitialTime)) { + dev(mod$statsWindow) + Plot(plot3, title = "Number of pixels, by leading type", new = TRUE) + } + + plot4 <- ggplot(data = df, aes(x = year, y = AgeBySppWeighted, colour = species, group = species)) + geom_line(size = 1) + scale_colour_manual(values = cols2) + labs(x = "Year", y = "Age") + theme(legend.text = element_text(size = 6), legend.title = element_blank()) - titleLab <- paste("Oldest cohort age\n", "by species (across pixels)") - fileNamePlot5 <- "oldest_cohorts.png" - } + if (!is.na(P(sim)$.plotInitialTime)) { + dev(mod$statsWindow) + Plot(plot4, title = paste0("Biomass-weighted species age\n", + "(averaged across pixels)"), new = TRUE) + } - if (!is.na(P(sim)$.plotInitialTime)) { - dev(mod$statsWindow) - Plot(plot5, title = titleLab, new = TRUE) - } + if (P(sim)$plotOverstory) { + plot5 <- ggplot(data = df, aes(x = year, y = overstoryBiomass, + fill = species, group = species)) + + geom_area(position = "stack") + + scale_fill_manual(values = cols2) + + labs(x = "Year", y = "Overstory Biomass") + + theme(legend.text = element_text(size = 6), legend.title = element_blank()) + + scale_y_continuous(labels = function(x) format(x, scientific = TRUE)) + + titleLab <- "Overstory biomass by species" + fileNamePlot5 <- "overstory_biomass.png" + } else { + plot5 <- ggplot(data = df, aes(x = year, y = OldestCohortBySpp, + colour = species, group = species)) + + geom_line(size = 1) + + scale_colour_manual(values = cols2) + + labs(x = "Year", y = "Age") + + theme(legend.text = element_text(size = 6), legend.title = element_blank()) + + titleLab <- paste("Oldest cohort age\n", "by species (across pixels)") + fileNamePlot5 <- "oldest_cohorts.png" + } - plot6 <- ggplot(data = df, aes(x = year, y = aNPPBySpecies, colour = species, group = species)) + - geom_line(size = 1) + - scale_color_manual(values = cols2) + - labs(x = "Year", y = "aNPP") + - theme(legend.text = element_text(size = 6), legend.title = element_blank()) + - scale_y_continuous(labels = function(x) format(x, scientific = TRUE)) + if (!is.na(P(sim)$.plotInitialTime)) { + dev(mod$statsWindow) + Plot(plot5, title = titleLab, new = TRUE) + } - if (!is.na(P(sim)$.plotInitialTime)) { - dev(mod$statsWindow) - Plot(plot6, title = paste0("Total aNPP by species\n", "across pixels"), new = TRUE) - } + plot6 <- ggplot(data = df, aes(x = year, y = aNPPBySpecies, colour = species, group = species)) + + geom_line(size = 1) + + scale_color_manual(values = cols2) + + labs(x = "Year", y = "aNPP") + + theme(legend.text = element_text(size = 6), legend.title = element_blank()) + + scale_y_continuous(labels = function(x) format(x, scientific = TRUE)) + + if (!is.na(P(sim)$.plotInitialTime)) { + dev(mod$statsWindow) + Plot(plot6, title = paste0("Total aNPP by species\n", "across pixels"), new = TRUE) + } - if (time(sim) == end(sim)) { - # if (!is.na(P(sim)$.saveInitialTime)) - ggsave(file.path(outputPath(sim), "figures", "biomass_by_species.png"), - plot2 + theme_bw(base_size = 16)) - ggsave(file.path(outputPath(sim), "figures", "N_pixels_leading.png"), - plot3 + theme_bw(base_size = 16)) - ggsave(file.path(outputPath(sim), "figures", "biomass-weighted_species_age.png"), - plot4 + theme_bw(base_size = 16)) - ggsave(file.path(outputPath(sim), "figures", fileNamePlot5), - plot5 + theme_bw(base_size = 16)) - ggsave(file.path(outputPath(sim), "figures", "total_aNPP_by_species.png"), - plot6 + theme_bw(base_size = 16)) + if (time(sim) == end(sim)) { + # if (!is.na(P(sim)$.saveInitialTime)) + ggsave(file.path(outputPath(sim), "figures", "biomass_by_species.png"), + plot2 + theme_bw(base_size = 16)) + ggsave(file.path(outputPath(sim), "figures", "N_pixels_leading.png"), + plot3 + theme_bw(base_size = 16)) + ggsave(file.path(outputPath(sim), "figures", "biomass-weighted_species_age.png"), + plot4 + theme_bw(base_size = 16)) + ggsave(file.path(outputPath(sim), "figures", fileNamePlot5), + plot5 + theme_bw(base_size = 16)) + ggsave(file.path(outputPath(sim), "figures", "total_aNPP_by_species.png"), + plot6 + theme_bw(base_size = 16)) + } } + + return(invisible(sim)) } +#) - return(invisible(sim)) -}) - -plotVegAttributesMaps <- compiler::cmpfun(function(sim) { - LandR::assertSpeciesPlotLabels(sim$species$species, sim$sppEquiv) - - if (!is.na(P(sim)$.plotInitialTime)) { - biomassMapForPlot <- raster::mask(sim$simulatedBiomassMap, sim$studyAreaReporting) - ANPPMapForPlot <- raster::mask(sim$ANPPMap, sim$studyAreaReporting) - mortalityMapForPlot <- raster::mask(sim$mortalityMap, sim$studyAreaReporting) - if (is.null(sim$reproductionMap)) { - reproductionMapForPlot <- biomassMapForPlot - reproductionMapForPlot[!is.na(reproductionMapForPlot)][] <- 0 - } else { - reproductionMapForPlot <- raster::mask(sim$reproductionMap, sim$studyAreaReporting) - } +plotVegAttributesMaps <- # compiler::cmpfun( + function(sim) { + LandR::assertSpeciesPlotLabels(sim$species$species, sim$sppEquiv) - levs <- raster::levels(sim$vegTypeMap)[[1]] - levelsName <- names(levs)[2] - # facVals <- pemisc::factorValues2(sim$vegTypeMap, sim$vegTypeMap[], - # att = levelsName, - # na.rm = TRUE) - - ## Doesn't change anything in the current default setting, but it does create - ## an NA where there is "Mixed". - ## Other species in levs[[levelsName]] are already "Leading", - ## but it needs to be here in case it is not Leading in the future. - # The ones we want - sppEquiv <- sim$sppEquiv[!is.na(sim$sppEquiv[[P(sim)$sppEquivCol]]),] - - levsLeading <- equivalentName(levs[[levelsName]], sppEquiv, "Leading") - - if (any(grepl("Mixed", levs[[levelsName]]))) { - hasOnlyMixedAsOther <- sum(is.na(levsLeading) == 1) && - levs[[levelsName]][is.na(levsLeading)] == "Mixed" - #extraValues <- setdiff(levs[[levelsName]], levsLeading) - if (!isTRUE(hasOnlyMixedAsOther)) { - stop("'plotVegAttributesMaps' in Biomass_core can only deal with 'Mixed' category or the ones in sim$sppEquiv") + if (!is.na(P(sim)$.plotInitialTime)) { + biomassMapForPlot <- raster::mask(sim$simulatedBiomassMap, sim$studyAreaReporting) + ANPPMapForPlot <- raster::mask(sim$ANPPMap, sim$studyAreaReporting) + mortalityMapForPlot <- raster::mask(sim$mortalityMap, sim$studyAreaReporting) + if (is.null(sim$reproductionMap)) { + reproductionMapForPlot <- biomassMapForPlot + reproductionMapForPlot[!is.na(reproductionMapForPlot)][] <- 0 + } else { + reproductionMapForPlot <- raster::mask(sim$reproductionMap, sim$studyAreaReporting) } - } - whMixedLevs <- which(levs[[levelsName]] == "Mixed") - whMixedSppColors <- which(names(sim$sppColorVect) == "Mixed") + levs <- raster::levels(sim$vegTypeMap)[[1]] + levelsName <- names(levs)[2] + # facVals <- pemisc::factorValues2(sim$vegTypeMap, sim$vegTypeMap[], + # att = levelsName, + # na.rm = TRUE) + + ## Doesn't change anything in the current default setting, but it does create + ## an NA where there is "Mixed". + ## Other species in levs[[levelsName]] are already "Leading", + ## but it needs to be here in case it is not Leading in the future. + # The ones we want + sppEquiv <- sim$sppEquiv[!is.na(sim$sppEquiv[[P(sim)$sppEquivCol]]),] + + levsLeading <- equivalentName(levs[[levelsName]], sppEquiv, "Leading") + + if (any(grepl("Mixed", levs[[levelsName]]))) { + hasOnlyMixedAsOther <- sum(is.na(levsLeading) == 1) && + levs[[levelsName]][is.na(levsLeading)] == "Mixed" + #extraValues <- setdiff(levs[[levelsName]], levsLeading) + if (!isTRUE(hasOnlyMixedAsOther)) { + stop("'plotVegAttributesMaps' in Biomass_core can only deal with 'Mixed' category or the ones in sim$sppEquiv") + } + } - # Will return NA where there is no value, e.g., Mixed - levsLeading[whMixedLevs] <- "Mixed" - - shortNames <- equivalentName(levsLeading, sppEquiv, "EN_generic_short") - shortNames[whMixedLevs] <- "Mixed" - levs[[levelsName]] <- shortNames - levels(sim$vegTypeMap) <- levs - - colsLeading <- equivalentName(names(sim$sppColorVect), sppEquiv, "Leading") - colsLeading[whMixedSppColors] <- "Mixed" - sppColorVect <- sim$sppColorVect - names(sppColorVect) <- colsLeading - colours <- sppColorVect[na.omit(match(levsLeading, colsLeading))] - setColors(sim$vegTypeMap, levs$ID) <- colours - - # Mask out NAs based on rasterToMatch (for plotting only!) - vegTypeMapForPlot <- raster::mask(sim$vegTypeMap, sim$studyAreaReporting) - - ## Plot - tryCatch({ - dev(mod$mapWindow) # Protecting from error of headless/terminal run - if (!is.null(biomassMapForPlot)) - Plot(biomassMapForPlot, title = "Biomass", new = TRUE) - if (!is.null(ANPPMapForPlot)) - Plot(ANPPMapForPlot, title = "ANPP", new = TRUE) - if (!is.null(mortalityMapForPlot)) - Plot(mortalityMapForPlot, title = "Mortality", new = TRUE) - Plot(vegTypeMapForPlot, new = TRUE, title = "Leading vegetation") - grid.rect(0.93, 0.97, width = 0.2, height = 0.06, gp = gpar(fill = "white", col = "white")) - grid.text(label = paste0("Year = ", round(time(sim))), x = 0.93, y = 0.97) - #if (!is.null(reproductionMapForPlot)) - # Plot(reproductionMapForPlot, title = "Reproduction", new = TRUE) - }, error = function(e) - message("Can't open the device for plotting. Plotting will be disabled to avoid errors")) - } + whMixedLevs <- which(levs[[levelsName]] == "Mixed") + whMixedSppColors <- which(names(sim$sppColorVect) == "Mixed") + + # Will return NA where there is no value, e.g., Mixed + levsLeading[whMixedLevs] <- "Mixed" + + shortNames <- equivalentName(levsLeading, sppEquiv, "EN_generic_short") + shortNames[whMixedLevs] <- "Mixed" + levs[[levelsName]] <- shortNames + levels(sim$vegTypeMap) <- levs + + colsLeading <- equivalentName(names(sim$sppColorVect), sppEquiv, "Leading") + colsLeading[whMixedSppColors] <- "Mixed" + sppColorVect <- sim$sppColorVect + names(sppColorVect) <- colsLeading + colours <- sppColorVect[na.omit(match(levsLeading, colsLeading))] + setColors(sim$vegTypeMap, levs$ID) <- colours + + # Mask out NAs based on rasterToMatch (for plotting only!) + vegTypeMapForPlot <- raster::mask(sim$vegTypeMap, sim$studyAreaReporting) + + ## Plot + tryCatch({ + dev(mod$mapWindow) # Protecting from error of headless/terminal run + if (!is.null(biomassMapForPlot)) + Plot(biomassMapForPlot, title = "Biomass", new = TRUE) + if (!is.null(ANPPMapForPlot)) + Plot(ANPPMapForPlot, title = "ANPP", new = TRUE) + if (!is.null(mortalityMapForPlot)) + Plot(mortalityMapForPlot, title = "Mortality", new = TRUE) + Plot(vegTypeMapForPlot, new = TRUE, title = "Leading vegetation") + grid.rect(0.93, 0.97, width = 0.2, height = 0.06, gp = gpar(fill = "white", col = "white")) + grid.text(label = paste0("Year = ", round(time(sim))), x = 0.93, y = 0.97) + #if (!is.null(reproductionMapForPlot)) + # Plot(reproductionMapForPlot, title = "Reproduction", new = TRUE) + }, error = function(e) + message("Can't open the device for plotting. Plotting will be disabled to avoid errors")) + } - return(invisible(sim)) -}) - -plotAvgVegAttributes <- compiler::cmpfun(function(sim) { - LandR::assertSpeciesPlotLabels(sim$species$species, sim$sppEquiv) - - checkPath(file.path(outputPath(sim), "figures"), create = TRUE) - - ## AVERAGE STAND BIOMASS/AGE/ANPP - ## calculate acrosS pixels - ## don't expand table, multiply by no. pixels - faster - pixelCohortData <- addNoPixel2CohortData(sim$cohortData, sim$pixelGroupMap, cohortDefinitionCols = P(sim)$cohortDefinitionCols) - thisPeriod <- pixelCohortData[, list(year = time(sim), - sumB = sum(B*noPixels, na.rm = TRUE), - maxAge = asInteger(max(age, na.rm = TRUE)), - sumANPP = asInteger(sum(aNPPAct*noPixels, na.rm = TRUE)))] - denominator <- length(sim$pixelGroupMap[!is.na(sim$pixelGroupMap)]) * 100 #to get tonnes/ha - thisPeriod[, sumB := asInteger(sumB/denominator)] - thisPeriod[, sumANPP := asInteger(sumANPP/denominator)] - - if (is.null(sim$summaryLandscape)) { - sim$summaryLandscape <- thisPeriod - } else { - sim$summaryLandscape <- rbindlist(list(sim$summaryLandscape, thisPeriod)) + return(invisible(sim)) } +#) + +plotAvgVegAttributes <- #compiler::cmpfun( + function(sim) { + LandR::assertSpeciesPlotLabels(sim$species$species, sim$sppEquiv) + + checkPath(file.path(outputPath(sim), "figures"), create = TRUE) + + ## AVERAGE STAND BIOMASS/AGE/ANPP + ## calculate acrosS pixels + ## don't expand table, multiply by no. pixels - faster + pixelCohortData <- addNoPixel2CohortData(sim$cohortData, sim$pixelGroupMap, cohortDefinitionCols = P(sim)$cohortDefinitionCols) + thisPeriod <- pixelCohortData[, list(year = time(sim), + sumB = sum(B*noPixels, na.rm = TRUE), + maxAge = asInteger(max(age, na.rm = TRUE)), + sumANPP = asInteger(sum(aNPPAct*noPixels, na.rm = TRUE)))] + denominator <- length(sim$pixelGroupMap[!is.na(sim$pixelGroupMap)]) * 100 #to get tonnes/ha + thisPeriod[, sumB := asInteger(sumB/denominator)] + thisPeriod[, sumANPP := asInteger(sumANPP/denominator)] + + if (is.null(sim$summaryLandscape)) { + sim$summaryLandscape <- thisPeriod + } else { + sim$summaryLandscape <- rbindlist(list(sim$summaryLandscape, thisPeriod)) + } - if (length(unique(sim$summaryLandscape$year)) > 1) { - df2 <- melt(sim$summaryLandscape, id.vars = "year") - - varLabels <- c(sumB = "Biomass", maxAge = "Age", sumANPP = "aNPP") + if (length(unique(sim$summaryLandscape$year)) > 1) { + df2 <- melt(sim$summaryLandscape, id.vars = "year") - plot1 <- ggplot(data = df2, aes(x = year, y = value, colour = variable)) + - geom_line(size = 1) + - scale_colour_brewer(labels = varLabels, type = "qual", palette = "Dark2") + - theme_bw() + - theme(legend.text = element_text(size = 6), legend.title = element_blank(), - legend.position = "bottom") + - facet_wrap(~ variable, scales = "free_y", - labeller = labeller(variable = varLabels)) + - labs(x = "Year", y = "Value", colour = "") + varLabels <- c(sumB = "Biomass", maxAge = "Age", sumANPP = "aNPP") - if (!is.na(P(sim)$.plotInitialTime)) { - dev(mod$statsWindow) - Plot(plot1, title = "mean landscape biomass and aNPP (Mg/ha) and max stand age", new = TRUE) - } + plot1 <- ggplot(data = df2, aes(x = year, y = value, colour = variable)) + + geom_line(size = 1) + + scale_colour_brewer(labels = varLabels, type = "qual", palette = "Dark2") + + theme_bw() + + theme(legend.text = element_text(size = 6), legend.title = element_blank(), + legend.position = "bottom") + + facet_wrap(~ variable, scales = "free_y", + labeller = labeller(variable = varLabels)) + + labs(x = "Year", y = "Value", colour = "") + + if (!is.na(P(sim)$.plotInitialTime)) { + dev(mod$statsWindow) + Plot(plot1, title = "mean landscape biomass and aNPP (Mg/ha) and max stand age", new = TRUE) + } - if (time(sim) == end(sim)) { - # if (!is.na(P(sim)$.saveInitialTime)) - ggsave(file.path(outputPath(sim), "figures", "landscape_biomass_aNPP_max_age.png"), - plot1 + theme_bw(base_size = 16) + theme(legend.position = "bottom")) + if (time(sim) == end(sim)) { + # if (!is.na(P(sim)$.saveInitialTime)) + ggsave(file.path(outputPath(sim), "figures", "landscape_biomass_aNPP_max_age.png"), + plot1 + theme_bw(base_size = 16) + theme(legend.position = "bottom")) + } } + return(invisible(sim)) } - return(invisible(sim)) -}) - -Save <- compiler::cmpfun(function(sim) { - raster::projection(sim$simulatedBiomassMap) <- raster::projection(sim$ecoregionMap) - raster::projection(sim$ANPPMap) <- raster::projection(sim$ecoregionMap) - raster::projection(sim$mortalityMap) <- raster::projection(sim$ecoregionMap) - raster::projection(sim$reproductionMap) <- raster::projection(sim$ecoregionMap) - writeRaster(sim$simulatedBiomassMap, - file.path(outputPath(sim), "figures", - paste0("simulatedBiomassMap_Year", round(time(sim)), ".tif")), - datatype = 'INT4S', overwrite = TRUE) - writeRaster(sim$ANPPMap, - file.path(outputPath(sim), "figures", - paste0("ANPP_Year", round(time(sim)), ".tif")), - datatype = 'INT4S', overwrite = TRUE) - writeRaster(sim$mortalityMap, - file.path(outputPath(sim), "figures", - paste0("mortalityMap_Year", round(time(sim)), ".tif")), - datatype = 'INT4S', overwrite = TRUE) - writeRaster(sim$reproductionMap, - file.path(outputPath(sim), "figures", - paste0("reproductionMap_Year", round(time(sim)), ".tif")), - datatype = 'INT4S', overwrite = TRUE) +#) + +Save <- #compiler::cmpfun( + function(sim) { + raster::projection(sim$simulatedBiomassMap) <- raster::projection(sim$ecoregionMap) + raster::projection(sim$ANPPMap) <- raster::projection(sim$ecoregionMap) + raster::projection(sim$mortalityMap) <- raster::projection(sim$ecoregionMap) + raster::projection(sim$reproductionMap) <- raster::projection(sim$ecoregionMap) + writeRaster(sim$simulatedBiomassMap, + file.path(outputPath(sim), "figures", + paste0("simulatedBiomassMap_Year", round(time(sim)), ".tif")), + datatype = 'INT4S', overwrite = TRUE) + writeRaster(sim$ANPPMap, + file.path(outputPath(sim), "figures", + paste0("ANPP_Year", round(time(sim)), ".tif")), + datatype = 'INT4S', overwrite = TRUE) + writeRaster(sim$mortalityMap, + file.path(outputPath(sim), "figures", + paste0("mortalityMap_Year", round(time(sim)), ".tif")), + datatype = 'INT4S', overwrite = TRUE) + writeRaster(sim$reproductionMap, + file.path(outputPath(sim), "figures", + paste0("reproductionMap_Year", round(time(sim)), ".tif")), + datatype = 'INT4S', overwrite = TRUE) - return(invisible(sim)) -}) + return(invisible(sim)) + } +#) CohortAgeReclassification <- function(sim) { if (time(sim) != start(sim)) { @@ -1831,225 +1939,227 @@ CohortAgeReclassification <- function(sim) { } } -.inputObjects <- compiler::cmpfun(function(sim) { - cacheTags <- c(currentModule(sim), "function:.inputObjects") - dPath <- asPath(getOption("reproducible.destinationPath", dataPath(sim)), 1) - if (getOption("LandR.verbose", TRUE) > 0) - message(currentModule(sim), ": using dataPath '", dPath, "'.") +.inputObjects <- #compiler::cmpfun( + function(sim) { + cacheTags <- c(currentModule(sim), "function:.inputObjects") + dPath <- asPath(getOption("reproducible.destinationPath", dataPath(sim)), 1) + if (getOption("LandR.verbose", TRUE) > 0) + message(currentModule(sim), ": using dataPath '", dPath, "'.") - ####################################################### + ####################################################### - if (!suppliedElsewhere("studyArea", sim)) { - stop("Please provide a 'studyArea' polygon") - # message("'studyArea' was not provided by user. Using a polygon (6250000 m^2) in southwestern Alberta, Canada") - # sim$studyArea <- randomStudyArea(seed = 1234, size = (250^2)*100) # Jan 2021 we agreed to force user to provide a SA/SAL - } + if (!suppliedElsewhere("studyArea", sim)) { + sim$studyArea <- randomStudyArea(seed = 1234, size = (250^2)*100) # Jan 2021 we agreed to force user to provide a SA/SAL + # stop("Please provide a 'studyArea' polygon") + # message("'studyArea' was not provided by user. Using a polygon (6250000 m^2) in southwestern Alberta, Canada") + # sim$studyArea <- randomStudyArea(seed = 1234, size = (250^2)*100) # Jan 2021 we agreed to force user to provide a SA/SAL + } - if (is.na(P(sim)$.studyAreaName)) { - params(sim)[[currentModule(sim)]][[".studyAreaName"]] <- reproducible::studyAreaName(sim$studyArea) - message("The .studyAreaName is not supplied; derived name from sim$studyArea: ", - params(sim)[[currentModule(sim)]][[".studyAreaName"]]) - } + if (is.na(P(sim)$.studyAreaName)) { + params(sim)[[currentModule(sim)]][[".studyAreaName"]] <- reproducible::studyAreaName(sim$studyArea) + message("The .studyAreaName is not supplied; derived name from sim$studyArea: ", + params(sim)[[currentModule(sim)]][[".studyAreaName"]]) + } - needRTM <- FALSE - if (is.null(sim$rasterToMatch)) { - if (!suppliedElsewhere("rasterToMatch", sim)) { - needRTM <- TRUE - message("There is no rasterToMatch supplied; will attempt to use rawBiomassMap") - } else { - stop("rasterToMatch is going to be supplied, but ", currentModule(sim), " requires it ", - "as part of its .inputObjects. Please make it accessible to ", currentModule(sim), - " in the .inputObjects by passing it in as an object in simInit(objects = list(rasterToMatch = aRaster)", - " or in a module that gets loaded prior to ", currentModule(sim)) + needRTM <- FALSE + if (is.null(sim$rasterToMatch)) { + if (!suppliedElsewhere("rasterToMatch", sim)) { + needRTM <- TRUE + message("There is no rasterToMatch supplied; will attempt to use rawBiomassMap") + } else { + stop("rasterToMatch is going to be supplied, but ", currentModule(sim), " requires it ", + "as part of its .inputObjects. Please make it accessible to ", currentModule(sim), + " in the .inputObjects by passing it in as an object in simInit(objects = list(rasterToMatch = aRaster)", + " or in a module that gets loaded prior to ", currentModule(sim)) + } } - } - if (needRTM) { - if (!suppliedElsewhere("rawBiomassMap", sim) || - !compareRaster(sim$rawBiomassMap, sim$studyArea, stopiffalse = FALSE)) { - rawBiomassMapURL <- paste0("http://ftp.maps.canada.ca/pub/nrcan_rncan/Forests_Foret/", - "canada-forests-attributes_attributs-forests-canada/", - "2001-attributes_attributs-2001/", - "NFI_MODIS250m_2001_kNN_Structure_Biomass_TotalLiveAboveGround_v1.tif") - rawBiomassMapFilename <- "NFI_MODIS250m_2001_kNN_Structure_Biomass_TotalLiveAboveGround_v1.tif" - httr::with_config(config = httr::config(ssl_verifypeer = 0L), { ## TODO: re-enable verify - #necessary for KNN - rawBiomassMap <- Cache(prepInputs, - targetFile = rawBiomassMapFilename, - url = rawBiomassMapURL, - destinationPath = dPath, + if (needRTM) { + if (!suppliedElsewhere("rawBiomassMap", sim) || + !compareRaster(sim$rawBiomassMap, sim$studyArea, stopiffalse = FALSE)) { + rawBiomassMapURL <- paste0("http://ftp.maps.canada.ca/pub/nrcan_rncan/Forests_Foret/", + "canada-forests-attributes_attributs-forests-canada/", + "2001-attributes_attributs-2001/", + "NFI_MODIS250m_2001_kNN_Structure_Biomass_TotalLiveAboveGround_v1.tif") + rawBiomassMapFilename <- "NFI_MODIS250m_2001_kNN_Structure_Biomass_TotalLiveAboveGround_v1.tif" + httr::with_config(config = httr::config(ssl_verifypeer = 0L), { ## TODO: re-enable verify + #necessary for KNN + rawBiomassMap <- Cache(prepInputs, + targetFile = rawBiomassMapFilename, + url = rawBiomassMapURL, + destinationPath = dPath, + studyArea = sim$studyArea, + rasterToMatch = NULL, + maskWithRTM = FALSE, + useSAcrs = FALSE, ## never use SA CRS + method = "bilinear", + datatype = "INT2U", + filename2 = NULL, + userTags = c(cacheTags, "rawBiomassMap"), + omitArgs = c("destinationPath", "targetFile", "userTags", "stable")) + }) + } else { + rawBiomassMap <- Cache(postProcess, + x = sim$rawBiomassMap, studyArea = sim$studyArea, - rasterToMatch = NULL, - maskWithRTM = FALSE, - useSAcrs = FALSE, ## never use SA CRS + useSAcrs = FALSE, + maskWithRTM = FALSE, ## mask with SA method = "bilinear", datatype = "INT2U", filename2 = NULL, - userTags = c(cacheTags, "rawBiomassMap"), + overwrite = TRUE, + userTags = cacheTags, omitArgs = c("destinationPath", "targetFile", "userTags", "stable")) - }) - } else { - rawBiomassMap <- Cache(postProcess, - x = sim$rawBiomassMap, - studyArea = sim$studyArea, - useSAcrs = FALSE, - maskWithRTM = FALSE, ## mask with SA - method = "bilinear", - datatype = "INT2U", - filename2 = NULL, - overwrite = TRUE, - userTags = cacheTags, - omitArgs = c("destinationPath", "targetFile", "userTags", "stable")) - } + } - ## if we need rasterToMatchLarge, that means a) we don't have it, but b) we will have rawBiomassMap - - warning("rasterToMatch is missing and will be created", - " from rawBiomassMap and studyAreaLarge.", - " If this is wrong, provide raster.") - - sim$rasterToMatch <- rawBiomassMap - RTMvals <- getValues(sim$rasterToMatch) - sim$rasterToMatch[!is.na(RTMvals)] <- 1 - sim$rasterToMatch <- Cache(writeOutputs, sim$rasterToMatch, - filename2 = .suffix(file.path(dPath, "rasterToMatch.tif"), - paste0("_", P(sim)$.studyAreaName)), - datatype = "INT2U", overwrite = TRUE, - userTags = c(cacheTags, "rasterToMatch"), - omitArgs = c("userTags")) - } + ## if we need rasterToMatchLarge, that means a) we don't have it, but b) we will have rawBiomassMap + + warning("rasterToMatch is missing and will be created", + " from rawBiomassMap and studyAreaLarge.", + " If this is wrong, provide raster.") + + sim$rasterToMatch <- rawBiomassMap + RTMvals <- getValues(sim$rasterToMatch) + sim$rasterToMatch[!is.na(RTMvals)] <- 1 + sim$rasterToMatch <- Cache(writeOutputs, sim$rasterToMatch, + filename2 = .suffix(file.path(dPath, "rasterToMatch.tif"), + paste0("_", P(sim)$.studyAreaName)), + datatype = "INT2U", overwrite = TRUE, + userTags = c(cacheTags, "rasterToMatch"), + omitArgs = c("userTags")) + } - if (!compareCRS(sim$studyArea, sim$rasterToMatch)) { - warning(paste0("studyArea and rasterToMatch projections differ.\n", - "studyArea will be projected to match rasterToMatch")) - sim$studyArea <- spTransform(sim$studyArea, crs(sim$rasterToMatch)) - sim$studyArea <- fixErrors(sim$studyArea) - } + if (!compareCRS(sim$studyArea, sim$rasterToMatch)) { + warning(paste0("studyArea and rasterToMatch projections differ.\n", + "studyArea will be projected to match rasterToMatch")) + sim$studyArea <- spTransform(sim$studyArea, crs(sim$rasterToMatch)) + sim$studyArea <- fixErrors(sim$studyArea) + } - if (!suppliedElsewhere("studyAreaReporting", sim)) { - if (getOption("LandR.verbose", TRUE) > 0) - message("'studyAreaReporting' was not provided by user. Using the same as 'studyArea'.") - sim$studyAreaReporting <- sim$studyArea - } + if (!suppliedElsewhere("studyAreaReporting", sim)) { + if (getOption("LandR.verbose", TRUE) > 0) + message("'studyAreaReporting' was not provided by user. Using the same as 'studyArea'.") + sim$studyAreaReporting <- sim$studyArea + } - ## make light requirements table - if (!suppliedElsewhere("sufficientLight", sim)) { - ## load the biomass_succession.txt to get shade tolerance parameters - mainInput <- prepInputsMainInput(url = extractURL("sufficientLight"), - dPath, - cacheTags = c(cacheTags, "mainInput")) ## uses default URL - - sufficientLight <- data.frame(mainInput, stringsAsFactors = FALSE) - startRow <- which(sufficientLight$col1 == "SufficientLight") - sufficientLight <- sufficientLight[(startRow + 1):(startRow + 5), 1:7] - sufficientLight <- data.table(sufficientLight) - sufficientLight <- sufficientLight[, lapply(.SD, function(x) as.numeric(x))] - - names(sufficientLight) <- c("speciesshadetolerance", - "X0", "X1", "X2", "X3", "X4", "X5") - sim$sufficientLight <- data.frame(sufficientLight, stringsAsFactors = FALSE) - } + ## make light requirements table + if (!suppliedElsewhere("sufficientLight", sim)) { + ## load the biomass_succession.txt to get shade tolerance parameters + mainInput <- prepInputsMainInput(url = extractURL("sufficientLight"), + dPath, + cacheTags = c(cacheTags, "mainInput")) ## uses default URL + + sufficientLight <- data.frame(mainInput, stringsAsFactors = FALSE) + startRow <- which(sufficientLight$col1 == "SufficientLight") + sufficientLight <- sufficientLight[(startRow + 1):(startRow + 5), 1:7] + sufficientLight <- data.table(sufficientLight) + sufficientLight <- sufficientLight[, lapply(.SD, function(x) as.numeric(x))] + + names(sufficientLight) <- c("speciesshadetolerance", + "X0", "X1", "X2", "X3", "X4", "X5") + sim$sufficientLight <- data.frame(sufficientLight, stringsAsFactors = FALSE) + } - if (!suppliedElsewhere("sppEquiv", sim)) { - if (!is.null(sim$sppColorVect)) - stop("If you provide sppColorVect, you MUST also provide sppEquiv") + if (!suppliedElsewhere("sppEquiv", sim)) { + if (!is.null(sim$sppColorVect)) + stop("If you provide sppColorVect, you MUST also provide sppEquiv") - data("sppEquivalencies_CA", package = "LandR", envir = environment()) - sim$sppEquiv <- as.data.table(sppEquivalencies_CA) - ## By default, Abies_las is renamed to Abies_sp - sim$sppEquiv[KNN == "Abie_Las", LandR := "Abie_sp"] + data("sppEquivalencies_CA", package = "LandR", envir = environment()) + sim$sppEquiv <- as.data.table(sppEquivalencies_CA) + ## By default, Abies_las is renamed to Abies_sp + sim$sppEquiv[KNN == "Abie_Las", LandR := "Abie_sp"] - ## check spp column to use - if (P(sim)$sppEquivCol == "Boreal") { - message(paste("There is no 'sppEquiv' table supplied;", - "will attempt to use species listed under 'Boreal'", - "in the 'LandR::sppEquivalencies_CA' table")) - } else { - if (grepl(P(sim)$sppEquivCol, names(sim$sppEquiv))) { - message(paste("There is no 'sppEquiv' table supplied,", - "will attempt to use species listed under", P(sim)$sppEquivCol, + ## check spp column to use + if (P(sim)$sppEquivCol == "Boreal") { + message(paste("There is no 'sppEquiv' table supplied;", + "will attempt to use species listed under 'Boreal'", "in the 'LandR::sppEquivalencies_CA' table")) } else { - stop("You changed 'sppEquivCol' without providing 'sppEquiv',", - "and the column name can't be found in the default table ('LandR::sppEquivalencies_CA').", - "Please provide conforming 'sppEquivCol', 'sppEquiv' and 'sppColorVect'") + if (grepl(P(sim)$sppEquivCol, names(sim$sppEquiv))) { + message(paste("There is no 'sppEquiv' table supplied,", + "will attempt to use species listed under", P(sim)$sppEquivCol, + "in the 'LandR::sppEquivalencies_CA' table")) + } else { + stop("You changed 'sppEquivCol' without providing 'sppEquiv',", + "and the column name can't be found in the default table ('LandR::sppEquivalencies_CA').", + "Please provide conforming 'sppEquivCol', 'sppEquiv' and 'sppColorVect'") + } } - } - ## remove empty lines/NAs - sim$sppEquiv <- sim$sppEquiv[!"", on = P(sim)$sppEquivCol] - sim$sppEquiv <- na.omit(sim$sppEquiv, P(sim)$sppEquivCol) + ## remove empty lines/NAs + sim$sppEquiv <- sim$sppEquiv[!"", on = P(sim)$sppEquivCol] + sim$sppEquiv <- na.omit(sim$sppEquiv, P(sim)$sppEquivCol) - ## add default colors for species used in model - sim$sppColorVect <- sppColors(sim$sppEquiv, P(sim)$sppEquivCol, - newVals = "Mixed", palette = "Accent") - } else { - if (is.null(sim$sppColorVect)) { - message("'sppEquiv' is provided without a 'sppColorVect'. Running: - LandR::sppColors with column ", P(sim)$sppEquivCol) + ## add default colors for species used in model sim$sppColorVect <- sppColors(sim$sppEquiv, P(sim)$sppEquivCol, newVals = "Mixed", palette = "Accent") + } else { + if (is.null(sim$sppColorVect)) { + message("'sppEquiv' is provided without a 'sppColorVect'. Running: + LandR::sppColors with column ", P(sim)$sppEquivCol) + sim$sppColorVect <- sppColors(sim$sppEquiv, P(sim)$sppEquivCol, + newVals = "Mixed", palette = "Accent") + } } - } - - if (P(sim)$vegLeadingProportion > 0 & is.na(sim$sppColorVect['Mixed'])) { - stop("vegLeadingProportion is > 0 but there is no 'Mixed' color in sim$sppColorVect. ", - "Please supply sim$sppColorVect with a 'Mixed' color or set vegLeadingProportion to zero.") - } + if (P(sim)$vegLeadingProportion > 0 & is.na(sim$sppColorVect['Mixed'])) { + stop("vegLeadingProportion is > 0 but there is no 'Mixed' color in sim$sppColorVect. ", + "Please supply sim$sppColorVect with a 'Mixed' color or set vegLeadingProportion to zero.") + } - if (!suppliedElsewhere("treedFirePixelTableSinceLastDisp", sim)) { - sim$treedFirePixelTableSinceLastDisp <- data.table(pixelIndex = integer(), - pixelGroup = integer(), - burnTime = numeric()) - } - if (!suppliedElsewhere("speciesLayers", sim)) { - message("No RasterStack map of biomass X species is provided; using KNN") - url <- paste0("http://ftp.maps.canada.ca/pub/nrcan_rncan/Forests_Foret/", - "canada-forests-attributes_attributs-forests-canada/2001-attributes_attributs-2001/") - sim$speciesLayers <- Cache(loadkNNSpeciesLayers, - dPath = dPath, - rasterToMatch = sim$rasterToMatch, - studyArea = sim$studyArea, - sppEquiv = sim$sppEquiv, - knnNamesCol = "KNN", - sppEquivCol = P(sim)$sppEquivCol, - thresh = 10, - url = url, - userTags = c(cacheTags, "speciesLayers"), - omitArgs = c("userTags")) - } + if (!suppliedElsewhere("treedFirePixelTableSinceLastDisp", sim)) { + sim$treedFirePixelTableSinceLastDisp <- data.table(pixelIndex = integer(), + pixelGroup = integer(), + burnTime = numeric()) + } - ## additional species traits - if (!suppliedElsewhere("species", sim)) { - speciesTable <- getSpeciesTable(dPath = dPath, url = extractURL("species"), - cacheTags = c(cacheTags, "speciesTable")) - sim$species <- prepSpeciesTable(speciesTable = speciesTable, - # speciesLayers = sim$speciesLayers, - sppEquiv = sim$sppEquiv[get(P(sim)$sppEquivCol) %in% - names(sim$speciesLayers)], - sppEquivCol = P(sim)$sppEquivCol) - } + if (!suppliedElsewhere("speciesLayers", sim)) { + message("No RasterStack map of biomass X species is provided; using KNN") + url <- paste0("http://ftp.maps.canada.ca/pub/nrcan_rncan/Forests_Foret/", + "canada-forests-attributes_attributs-forests-canada/2001-attributes_attributs-2001/") + sim$speciesLayers <- Cache(loadkNNSpeciesLayers, + dPath = dPath, + rasterToMatch = sim$rasterToMatch, + studyArea = sim$studyArea, + sppEquiv = sim$sppEquiv, + knnNamesCol = "KNN", + sppEquivCol = P(sim)$sppEquivCol, + thresh = 10, + url = url, + userTags = c(cacheTags, "speciesLayers"), + omitArgs = c("userTags")) + } - if (P(sim)$growthAndMortalityDrivers != 'LandR') { - if (!suppliedElsewhere("cceArgs", sim)) { - sim$cceArgs <- list(quote(CMI), - quote(ATA), - quote(CMInormal), - quote(mcsModel), - quote(gcsModel)) - names(sim$cceArgs) <- paste(sim$cceArgs) + ## additional species traits + if (!suppliedElsewhere("species", sim)) { + speciesTable <- getSpeciesTable(dPath = dPath, url = extractURL("species"), + cacheTags = c(cacheTags, "speciesTable")) + sim$species <- prepSpeciesTable(speciesTable = speciesTable, + # speciesLayers = sim$speciesLayers, + sppEquiv = sim$sppEquiv[get(P(sim)$sppEquivCol) %in% + names(sim$speciesLayers)], + sppEquivCol = P(sim)$sppEquivCol) } - #check for climate args - # if (!all(unlist(lapply(names(sim$cceArgs), suppliedElsewhere, sim = sim)))) { - # stop("Some or all of sim$cceArgs are not supplied") - # } - } + if (P(sim)$growthAndMortalityDrivers != 'LandR') { + if (!suppliedElsewhere("cceArgs", sim)) { + sim$cceArgs <- list(quote(CMI), + quote(ATA), + quote(CMInormal), + quote(mcsModel), + quote(gcsModel)) + names(sim$cceArgs) <- paste(sim$cceArgs) + } + #check for climate args + # if (!all(unlist(lapply(names(sim$cceArgs), suppliedElsewhere, sim = sim)))) { + # stop("Some or all of sim$cceArgs are not supplied") + # } + } - gc() ## AMC added this 2019-08-20 + # gc() ## AMC added this 2019-08-20 - return(invisible(sim)) -}) + return(invisible(sim)) + } +#) diff --git a/Biomass_core.Rmd b/Biomass_core.Rmd index b9b340d..0cea232 100644 --- a/Biomass_core.Rmd +++ b/Biomass_core.Rmd @@ -135,11 +135,13 @@ setPaths(inputPath = "inputs", times <- list(start = 0, end = 1) -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 @@ -157,10 +159,11 @@ successionTimestep <- 1L ## (ommitted from this list) parameters <- list( Biomass_core = list( - ".plotInitialTime" = times$start + ".plotInitialTime" = NA#times$start , "sppEquivCol" = speciesNameConvention - , "successionTimestep" = successionTimestep*10 - , ".saveInitialTime" = 1 +# , "seedingAlgorithm" = "universalDispersal" + , "successionTimestep" = successionTimestep*200 + , ".saveInitialTime" = NA#1 , ".useCache" = FALSE , ".useParallel" = FALSE ) diff --git a/R/age-cohorts.R b/R/age-cohorts.R index 003b625..96e994b 100644 --- a/R/age-cohorts.R +++ b/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) -}) +}#) diff --git a/R/helpers.R b/R/helpers.R index 41e6575..01b86ff 100644 --- a/R/helpers.R +++ b/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"]])) } @@ -144,7 +152,8 @@ calculateSumB <- compiler::cmpfun(function(cohortData, lastReg, currentTime, suc if (algo == 2 || isTRUE(doAssertion)) { ## this newer version is typically much faster than the older one above (Eliot June 2, 2019) cohortData2 <- copy(cohortData) - new1 <- Sys.time() + if (isTRUE(doAssertion)) + new1 <- Sys.time() oldKey <- checkAndChangeKey(cohortData2, "pixelGroup") wh <- which(cohortData2$age >= successionTimestep) sumBtmp <- cohortData2[wh, list(N = .N, sumB = sum(B, na.rm = TRUE)), by = "pixelGroup"] @@ -161,21 +170,21 @@ calculateSumB <- compiler::cmpfun(function(cohortData, lastReg, currentTime, suc set(cohortData2, NULL, "sumB", sumB) if (!is.null(oldKey)) setkeyv(cohortData2, oldKey) - new2 <- Sys.time() + if (isTRUE(doAssertion)) + new2 <- Sys.time() if (!is.integer(cohortData2[["sumB"]])) set(cohortData2, NULL, "sumB", asInteger(cohortData2[["sumB"]])) } 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")) @@ -192,11 +201,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 @@ -224,7 +233,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 @@ -233,7 +242,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] @@ -245,11 +255,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 @@ -259,7 +269,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] @@ -274,10 +285,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 @@ -287,7 +299,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)] @@ -321,7 +334,7 @@ calculateCompetition <- compiler::cmpfun(function(cohortData, stage = "nonSpinup set(cohortData, NULL, c("cMultiplier"), NULL) } return(cohortData) -}) +}#) checkAndChangeKey <- function(obj, key) { oldKey <- key(obj) diff --git a/R/spinup.R b/R/spinup.R index 969eb04..7f7fce9 100644 --- a/R/spinup.R +++ b/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() diff --git a/data/CHECKSUMS.txt b/data/CHECKSUMS.txt index c5475cd..e32a49e 100644 --- a/data/CHECKSUMS.txt +++ b/data/CHECKSUMS.txt @@ -1,54 +1,104 @@ "file" "checksum" "filesize" "algorithm" +"biomass-succession_test.txt" "50de5c70e52f192d" "1673" "xxhash64" "ecoregions.gis" "f3977826087e76eb" "9929" "xxhash64" "ecoregions.txt" "cd6d315d5bc6557b" "195" "xxhash64" "initial-communities.gis" "5f073a8aee9fc7f9" "9929" "xxhash64" "initial-communities.txt" "106bf32360487b16" "1101" "xxhash64" +"Beaudoin_2014_CJFR.pdf" "f1bde1a33abbd27e" "6719588" "xxhash64" "GADM_2.8_CAN_adm1.rds" "8103429fdb3d2f32" "17619981" "xxhash64" -"kNN-StructureBiomass.tar" "6a5e5faea8ef8f99" "2685040640" "xxhash64" -"biomass-succession_test.txt" "50de5c70e52f192d" "1673" "xxhash64" "kNN-Species.tar" "7906f46e0279659c" "2497034240" "xxhash64" -"NFI_MODIS250m_kNN_Species_Abie_Spp_v0.tif" "ec7b611b78669493" "27161128" "xxhash64" -"NFI_MODIS250m_kNN_Species_Pseu_Men_Gla_v0.tif" "6d2628751bb0854e" "9501525" "xxhash64" -"NFI_MODIS250m_kNN_Species_Pseu_Men_Men_v0.tif" "624056183313d61e" "8056430" "xxhash64" -"NFI_MODIS250m_kNN_Species_Pseu_Men_v0.tif" "674e3b24c7e91073" "24093314" "xxhash64" -"speciesTraits.csv" "155e633022e134cf" "9994" "xxhash64" -"NFI_MODIS250m_kNN_Structure_Biomass_TotalLiveAboveGround_v0.zip" "8e13ae321f43313a" "449276419" "xxhash64" -"NFI_MODIS250m_kNN_Structure_Biomass_TotalLiveAboveGround_v0.tif" "1a07864f573e0efb" "474053079" "xxhash64" +"kNN-StructureBiomass.tar" "6a5e5faea8ef8f99" "2685040640" "xxhash64" +"NFI_MAP_V0_metadata.xls" "79285734f8f2deb0" "74240" "xxhash64" +"NFI_MODIS250m_2001_kNN_LandCover_NonVeg_v1.tif" "490ee30afa55defd" "104776115" "xxhash64" +"NFI_MODIS250m_2001_kNN_Species_Abie_Bal_v1.tif" "711daecfeac24d25" "101620525" "xxhash64" +"NFI_MODIS250m_2001_kNN_Species_Abie_Las_v1.tif" "e72bf2b7a4037db3" "33855465" "xxhash64" +"NFI_MODIS250m_2001_kNN_Species_Acer_Neg_v1.tif" "707b6dbd08fb087c" "8635148" "xxhash64" +"NFI_MODIS250m_2001_kNN_Species_Acer_Pen_v1.tif" "9976ac43d138839b" "8953862" "xxhash64" +"NFI_MODIS250m_2001_kNN_Species_Acer_Sah_v1.tif" "2622dd6ae407809e" "30927110" "xxhash64" +"NFI_MODIS250m_2001_kNN_Species_Acer_Spi_v1.tif" "74ba839cf915eec1" "9522430" "xxhash64" +"NFI_MODIS250m_2001_kNN_Species_Acer_Spp_v1.tif" "b0bee5bd3ac2e778" "20244311" "xxhash64" +"NFI_MODIS250m_2001_kNN_Species_Alnu_Spp_v1.tif" "84aa030c2a8b20cf" "12604813" "xxhash64" +"NFI_MODIS250m_2001_kNN_Species_Betu_All_v1.tif" "0bc58c4e4c470941" "31430684" "xxhash64" +"NFI_MODIS250m_2001_kNN_Species_Betu_Pap_v1.tif" "b34f2f32b68ad9df" "117706133" "xxhash64" +"NFI_MODIS250m_2001_kNN_Species_Betu_Pop_v1.tif" "9cd2882bd3a70e06" "9908979" "xxhash64" +"NFI_MODIS250m_2001_kNN_Species_Betu_Spp_v1.tif" "2e361494c00799fd" "19396249" "xxhash64" +"NFI_MODIS250m_2001_kNN_Species_Fagu_Gra_v1.tif" "77fd137cd0bc1943" "19547795" "xxhash64" +"NFI_MODIS250m_2001_kNN_Species_Frax_Ame_v1.tif" "992afc21f1399531" "15438231" "xxhash64" +"NFI_MODIS250m_2001_kNN_Species_Frax_Nig_v1.tif" "85967d95ea3a832e" "18008283" "xxhash64" +"NFI_MODIS250m_2001_kNN_Species_Lari_Lar_v1.tif" "4887dde1295fdc45" "120966783" "xxhash64" +"NFI_MODIS250m_2001_kNN_Species_Lari_Lya_v1.tif" "0953ad3487728739" "8598986" "xxhash64" +"NFI_MODIS250m_2001_kNN_Species_Lari_Occ_v1.tif" "62602606c9939e51" "10473414" "xxhash64" +"NFI_MODIS250m_2001_kNN_Species_Lari_Spp_v1.tif" "28e4e36d5c501740" "9089808" "xxhash64" +"NFI_MODIS250m_2001_kNN_Species_Pice_Eng_v1.tif" "430be0b1e31d55f4" "16339203" "xxhash64" +"NFI_MODIS250m_2001_kNN_Species_Pice_Gla_v1.tif" "3843aca938161456" "130328501" "xxhash64" +"NFI_MODIS250m_2001_kNN_Species_Pice_Mar_v1.tif" "b5c505e5a05e430d" "213494895" "xxhash64" +"NFI_MODIS250m_2001_kNN_Species_Pice_Spp_v1.tif" "bf6066c60bebfa9d" "30490973" "xxhash64" +"NFI_MODIS250m_2001_kNN_Species_Pinu_Alb_v1.tif" "22d380448f1799d8" "9445948" "xxhash64" +"NFI_MODIS250m_2001_kNN_Species_Pinu_Ban_v1.tif" "ef21d19b1fb022e5" "110645324" "xxhash64" +"NFI_MODIS250m_2001_kNN_Species_Pinu_Con_v1.tif" "f47dcf0ec8beb544" "47198594" "xxhash64" +"NFI_MODIS250m_2001_kNN_Species_Pinu_Mon_v1.tif" "50ac1836f137fcbc" "8830689" "xxhash64" +"NFI_MODIS250m_2001_kNN_Species_Pinu_Res_v1.tif" "279b101398a516fb" "15335325" "xxhash64" +"NFI_MODIS250m_2001_kNN_Species_Pinu_Spp_v1.tif" "6cc23a3809601031" "9870936" "xxhash64" +"NFI_MODIS250m_2001_kNN_Species_Popu_Bal_v1.tif" "c3af40de96764ea8" "44626615" "xxhash64" +"NFI_MODIS250m_2001_kNN_Species_Popu_Gra_v1.tif" "142a6ca03e77309a" "16073480" "xxhash64" +"NFI_MODIS250m_2001_kNN_Species_Popu_Spp_v1.tif" "ca1c052c772c7706" "40064861" "xxhash64" +"NFI_MODIS250m_2001_kNN_Species_Popu_Tre_v1.tif" "6a13bc77d2145020" "142470805" "xxhash64" +"NFI_MODIS250m_2001_kNN_Species_Popu_Tri_v1.tif" "802fa0908bcf4460" "8307607" "xxhash64" +"NFI_MODIS250m_2001_kNN_Species_Tsug_Can_v1.tif" "039fd9ff45d8411a" "18479701" "xxhash64" +"NFI_MODIS250m_2001_kNN_Species_Tsug_Spp_v1.tif" "0c0a398d52bffa19" "14618212" "xxhash64" +"NFI_MODIS250m_2001_kNN_Structure_Biomass_TotalLiveAboveGround_v1.tif" "295106f5686a923b" "309928216" "xxhash64" "NFI_MODIS250m_kNN_Species_Abie_Ama_v0.zip" "b7d17be8deab4fad" "7924694" "xxhash64" +"NFI_MODIS250m_kNN_Species_Abie_Bal_v0.tif" "134eda15fa7152ba" "119879192" "xxhash64" "NFI_MODIS250m_kNN_Species_Abie_Bal_v0.zip" "8cfa355e0b7ff396" "113598290" "xxhash64" "NFI_MODIS250m_kNN_Species_Abie_Gra_v0.zip" "b46803b0d590845d" "1940242" "xxhash64" +"NFI_MODIS250m_kNN_Species_Abie_Las_v0.tif" "ae77900de22dad3a" "46393844" "xxhash64" "NFI_MODIS250m_kNN_Species_Abie_Las_v0.zip" "dd4c589d6a6b4c41" "39842269" "xxhash64" +"NFI_MODIS250m_kNN_Species_Abie_Spp_v0.tif" "ec7b611b78669493" "27161128" "xxhash64" "NFI_MODIS250m_kNN_Species_Abie_Spp_v0.zip" "5ac011e4b276fec5" "21370609" "xxhash64" "NFI_MODIS250m_kNN_Species_Acer_Cir_v0.zip" "82b4e8265fc855aa" "1911109" "xxhash64" "NFI_MODIS250m_kNN_Species_Acer_Mac_v0.zip" "41ab7f96688df078" "2302840" "xxhash64" +"NFI_MODIS250m_kNN_Species_Acer_Neg_v0.tif" "8ded28e52d8184a2" "8379017" "xxhash64" "NFI_MODIS250m_kNN_Species_Acer_Neg_v0.zip" "00bf42850d4edbc4" "2781064" "xxhash64" +"NFI_MODIS250m_kNN_Species_Acer_Pen_v0.tif" "d4f74c984fb0b8f0" "9316070" "xxhash64" "NFI_MODIS250m_kNN_Species_Acer_Pen_v0.zip" "d73737ede87ce0af" "3732727" "xxhash64" "NFI_MODIS250m_kNN_Species_Acer_Rub_v0.zip" "aa7d577941dd743d" "41031383" "xxhash64" "NFI_MODIS250m_kNN_Species_Acer_Sac_v0.zip" "62a021336e98d1d0" "6133342" "xxhash64" +"NFI_MODIS250m_kNN_Species_Acer_Sah_v0.tif" "1ca07dd90067903f" "39954107" "xxhash64" "NFI_MODIS250m_kNN_Species_Acer_Sah_v0.zip" "c092a623e267f811" "33254905" "xxhash64" +"NFI_MODIS250m_kNN_Species_Acer_Spi_v0.tif" "78aa649cdaed13dc" "9636115" "xxhash64" "NFI_MODIS250m_kNN_Species_Acer_Spi_v0.zip" "dacde4c281c91c51" "4015510" "xxhash64" +"NFI_MODIS250m_kNN_Species_Acer_Spp_v0.tif" "3c5a6e6124dba268" "25072821" "xxhash64" "NFI_MODIS250m_kNN_Species_Acer_Spp_v0.zip" "817342083916d1c8" "19157258" "xxhash64" "NFI_MODIS250m_kNN_Species_Alnu_Inc_Rug_v0.zip" "8d5981978f827d46" "6362390" "xxhash64" "NFI_MODIS250m_kNN_Species_Alnu_Inc_Ten_v0.zip" "6fe9aab606f1a27b" "2849719" "xxhash64" "NFI_MODIS250m_kNN_Species_Alnu_Inc_v0.zip" "32c3c32e3a73d2d2" "1877668" "xxhash64" "NFI_MODIS250m_kNN_Species_Alnu_Rub_v0.zip" "1a6a92776a26fdef" "3716691" "xxhash64" +"NFI_MODIS250m_kNN_Species_Alnu_Spp_v0.tif" "00e79196f7e7b412" "9116468" "xxhash64" "NFI_MODIS250m_kNN_Species_Alnu_Spp_v0.zip" "4ddce59d5fadfc95" "3527336" "xxhash64" "NFI_MODIS250m_kNN_Species_Arbu_Men_v0.zip" "196caae98e4626d3" "1944985" "xxhash64" "NFI_MODIS250m_kNN_Species_Asim_Tri_v0.zip" "49e6396daa7d7b6b" "1877666" "xxhash64" +"NFI_MODIS250m_kNN_Species_Betu_All_v0.tif" "4a995d0e2d28aefe" "43794475" "xxhash64" "NFI_MODIS250m_kNN_Species_Betu_All_v0.zip" "57e09f39236e6a7f" "36986320" "xxhash64" +"NFI_MODIS250m_kNN_Species_Betu_Pap_v0.tif" "d8f9de8858a1898e" "184753955" "xxhash64" "NFI_MODIS250m_kNN_Species_Betu_Pap_v0.zip" "e975f448c280988b" "174115930" "xxhash64" +"NFI_MODIS250m_kNN_Species_Betu_Pop_v0.tif" "a898b7e583950431" "10294181" "xxhash64" "NFI_MODIS250m_kNN_Species_Betu_Pop_v0.zip" "b4df023caf67eced" "4697453" "xxhash64" +"NFI_MODIS250m_kNN_Species_Betu_Spp_v0.tif" "f4e1fe4b52197128" "27682803" "xxhash64" "NFI_MODIS250m_kNN_Species_Betu_Spp_v0.zip" "c3b0e6a4994bf44b" "22074135" "xxhash64" "NFI_MODIS250m_kNN_Species_Carp_Car_v0.zip" "8aea9a241bf9a861" "2995395" "xxhash64" "NFI_MODIS250m_kNN_Species_Cary_Cor_v0.zip" "8e1442f308b4dcbf" "3039297" "xxhash64" "NFI_MODIS250m_kNN_Species_Cast_Den_v0.zip" "a5f8fe6f86614ef5" "1987796" "xxhash64" "NFI_MODIS250m_kNN_Species_Cham_Noo_v0.zip" "687dcb746d13f031" "7696446" "xxhash64" "NFI_MODIS250m_kNN_Species_Crat_Spp_v0.zip" "a45f4edec8849387" "1877666" "xxhash64" +"NFI_MODIS250m_kNN_Species_Fagu_Gra_v0.tif" "f9a2720f09bd7ab1" "24085130" "xxhash64" "NFI_MODIS250m_kNN_Species_Fagu_Gra_v0.zip" "50602adea13373ec" "18175903" "xxhash64" +"NFI_MODIS250m_kNN_Species_Frax_Ame_v0.tif" "881d37753b9f3917" "15418557" "xxhash64" "NFI_MODIS250m_kNN_Species_Frax_Ame_v0.zip" "2803ce8572712e21" "9812885" "xxhash64" +"NFI_MODIS250m_kNN_Species_Frax_Nig_v0.tif" "c0a32015e88e1aa3" "23665043" "xxhash64" "NFI_MODIS250m_kNN_Species_Frax_Nig_v0.zip" "c1c68ef6a9d243ba" "17978120" "xxhash64" "NFI_MODIS250m_kNN_Species_Frax_Pen_Sub_v0.zip" "f52111699054720e" "2001417" "xxhash64" "NFI_MODIS250m_kNN_Species_Frax_Pen_v0.zip" "2baa04d1b7edda3c" "2961701" "xxhash64" +"NFI_MODIS250m_kNN_Species_Frax_Spp_v0.tif" "2ca25a66b4d73763" "7623276" "xxhash64" "NFI_MODIS250m_kNN_Species_Frax_Spp_v0.zip" "0621b516386bbb2a" "1972731" "xxhash64" "NFI_MODIS250m_kNN_Species_Generic_BroadLeaf_Spp_v0.zip" "c5102010304677b1" "55067771" "xxhash64" "NFI_MODIS250m_kNN_Species_Generic_NeedleLeaf_Spp_v0.zip" "de06c2273c10a0a6" "44048575" "xxhash64" @@ -57,45 +107,69 @@ "NFI_MODIS250m_kNN_Species_Jugl_Nig_v0.zip" "4aaabb969b527ba5" "1877672" "xxhash64" "NFI_MODIS250m_kNN_Species_Juni_Vir_v0.zip" "806f92edaf763564" "1877669" "xxhash64" "NFI_MODIS250m_kNN_Species_Lari_Kae_v0.zip" "b97f170debb5d258" "1877666" "xxhash64" +"NFI_MODIS250m_kNN_Species_Lari_Lar_v0.tif" "c858c1808d25e252" "196774120" "xxhash64" "NFI_MODIS250m_kNN_Species_Lari_Lar_v0.zip" "320c51603323da95" "185766505" "xxhash64" +"NFI_MODIS250m_kNN_Species_Lari_Lya_v0.tif" "94bc94bbf04c90e6" "8531365" "xxhash64" "NFI_MODIS250m_kNN_Species_Lari_Lya_v0.zip" "21dd8c76173c7747" "2988214" "xxhash64" +"NFI_MODIS250m_kNN_Species_Lari_Occ_v0.tif" "5aa4f893bc2a45a4" "10327235" "xxhash64" "NFI_MODIS250m_kNN_Species_Lari_Occ_v0.zip" "93aa8e05fd2af443" "4700624" "xxhash64" +"NFI_MODIS250m_kNN_Species_Lari_Spp_v0.tif" "77b296085a94ccc2" "9104534" "xxhash64" "NFI_MODIS250m_kNN_Species_Lari_Spp_v0.zip" "f471aa649425e30c" "3542487" "xxhash64" "NFI_MODIS250m_kNN_Species_Malu_Fus_v0.zip" "e351742ee30d71b8" "1877671" "xxhash64" "NFI_MODIS250m_kNN_Species_Malu_Spp_v0.zip" "050d9c91614efd4b" "2064141" "xxhash64" "NFI_MODIS250m_kNN_Species_Ostr_Vir_v0.zip" "e7db244f644fd2e5" "4787604" "xxhash64" "NFI_MODIS250m_kNN_Species_Pice_Abi_v0.zip" "81cd2adbedd1cb41" "3589817" "xxhash64" +"NFI_MODIS250m_kNN_Species_Pice_Eng_Gla_v0.tif" "3d58f5095cc75f11" "8974864" "xxhash64" "NFI_MODIS250m_kNN_Species_Pice_Eng_Gla_v0.zip" "2781cfb333bf9252" "3354327" "xxhash64" +"NFI_MODIS250m_kNN_Species_Pice_Eng_v0.tif" "d671b3c7628517ed" "19608772" "xxhash64" "NFI_MODIS250m_kNN_Species_Pice_Eng_v0.zip" "ed54dfcb9e57693e" "13778280" "xxhash64" +"NFI_MODIS250m_kNN_Species_Pice_Gla_v0.tif" "76ff34659902fc5d" "214920877" "xxhash64" "NFI_MODIS250m_kNN_Species_Pice_Gla_v0.zip" "9de914719e369c22" "203485408" "xxhash64" +"NFI_MODIS250m_kNN_Species_Pice_Mar_v0.tif" "c11ae718d7510af8" "328900034" "xxhash64" "NFI_MODIS250m_kNN_Species_Pice_Mar_v0.zip" "c4fdba27669f6bb5" "312260446" "xxhash64" "NFI_MODIS250m_kNN_Species_Pice_Rub_v0.zip" "98a2e49c6fc4d3f3" "31358547" "xxhash64" "NFI_MODIS250m_kNN_Species_Pice_Sit_v0.zip" "fb6dc4711c19de7a" "3570051" "xxhash64" +"NFI_MODIS250m_kNN_Species_Pice_Spp_v0.tif" "cea70f8ce74239ce" "44316920" "xxhash64" "NFI_MODIS250m_kNN_Species_Pice_Spp_v0.zip" "ccfa633c37f3b0e7" "37840757" "xxhash64" +"NFI_MODIS250m_kNN_Species_Pinu_Alb_v0.tif" "2ca5225bb2a20ecb" "10017482" "xxhash64" "NFI_MODIS250m_kNN_Species_Pinu_Alb_v0.zip" "6330c1ac59ca6ad4" "4412600" "xxhash64" +"NFI_MODIS250m_kNN_Species_Pinu_Ban_v0.tif" "87abafa6c3eace5d" "183295505" "xxhash64" "NFI_MODIS250m_kNN_Species_Pinu_Ban_v0.zip" "55f42346b41888a3" "171989683" "xxhash64" +"NFI_MODIS250m_kNN_Species_Pinu_Con_Lat_v0.tif" "1cd250eb5a53083d" "21291662" "xxhash64" "NFI_MODIS250m_kNN_Species_Pinu_Con_Lat_v0.zip" "97e8f80dba60e9a0" "15546664" "xxhash64" +"NFI_MODIS250m_kNN_Species_Pinu_Con_v0.tif" "ffc7972f325a2383" "60905480" "xxhash64" "NFI_MODIS250m_kNN_Species_Pinu_Con_v0.zip" "a21fcc82350ab25a" "53967883" "xxhash64" "NFI_MODIS250m_kNN_Species_Pinu_Fle_v0.zip" "ca476d3b73b7792f" "1877671" "xxhash64" +"NFI_MODIS250m_kNN_Species_Pinu_Mon_v0.tif" "aade1c266dd4592f" "8616020" "xxhash64" "NFI_MODIS250m_kNN_Species_Pinu_Mon_v0.zip" "c9371a9d13344368" "3003402" "xxhash64" "NFI_MODIS250m_kNN_Species_Pinu_Pon_v0.zip" "414dab2e89a33758" "3833343" "xxhash64" +"NFI_MODIS250m_kNN_Species_Pinu_Res_v0.tif" "9d1d45450e856593" "19417450" "xxhash64" "NFI_MODIS250m_kNN_Species_Pinu_Res_v0.zip" "3177eaaa6e7c09fc" "13765993" "xxhash64" "NFI_MODIS250m_kNN_Species_Pinu_Rig_v0.zip" "c4dd9f14d6d2ccea" "1877671" "xxhash64" +"NFI_MODIS250m_kNN_Species_Pinu_Spp_v0.tif" "bd7623beb7aab8e8" "10687862" "xxhash64" "NFI_MODIS250m_kNN_Species_Pinu_Spp_v0.zip" "2c7820d851313b9f" "5184333" "xxhash64" "NFI_MODIS250m_kNN_Species_Pinu_Str_v0.zip" "b09f771f7cf522fd" "37598856" "xxhash64" "NFI_MODIS250m_kNN_Species_Pinu_Syl_v0.zip" "3e204c517f814ce2" "2079794" "xxhash64" "NFI_MODIS250m_kNN_Species_Plat_Occ_v0.zip" "bd6bfa9905a8dc13" "1877667" "xxhash64" +"NFI_MODIS250m_kNN_Species_Popu_Bal_v0.tif" "d21e3521c0fc74b2" "70031410" "xxhash64" "NFI_MODIS250m_kNN_Species_Popu_Bal_v0.zip" "8cc8f6995f2e0982" "63964089" "xxhash64" "NFI_MODIS250m_kNN_Species_Popu_Del_v0.zip" "192f287d797e42cc" "1957673" "xxhash64" +"NFI_MODIS250m_kNN_Species_Popu_Gra_v0.tif" "61ebdbb7351e083c" "20920687" "xxhash64" "NFI_MODIS250m_kNN_Species_Popu_Gra_v0.zip" "6a69e1e4804581f4" "15105999" "xxhash64" +"NFI_MODIS250m_kNN_Species_Popu_Spp_v0.tif" "8fbdf2260732d673" "58992467" "xxhash64" "NFI_MODIS250m_kNN_Species_Popu_Spp_v0.zip" "cf07eddb0bbc7dfd" "51770901" "xxhash64" +"NFI_MODIS250m_kNN_Species_Popu_Tre_v0.tif" "e871be8011844a74" "235379759" "xxhash64" "NFI_MODIS250m_kNN_Species_Popu_Tre_v0.zip" "558ca21bfc0de04c" "223049966" "xxhash64" +"NFI_MODIS250m_kNN_Species_Popu_Tri_v0.tif" "1700f1f8f92de714" "8062062" "xxhash64" "NFI_MODIS250m_kNN_Species_Popu_Tri_v0.zip" "51520ac9f9880970" "2452401" "xxhash64" "NFI_MODIS250m_kNN_Species_Prun_Pen_v0.zip" "57a3ae237f824708" "22868194" "xxhash64" "NFI_MODIS250m_kNN_Species_Prun_Ser_v0.zip" "72241a1abbe5d6f8" "5165249" "xxhash64" "NFI_MODIS250m_kNN_Species_Prun_Vir_v0.zip" "4eee1a1b7da90f23" "1877672" "xxhash64" +"NFI_MODIS250m_kNN_Species_Pseu_Men_Gla_v0.tif" "6d2628751bb0854e" "9501525" "xxhash64" "NFI_MODIS250m_kNN_Species_Pseu_Men_Gla_v0.zip" "af21f3f5228dc4f5" "3930008" "xxhash64" +"NFI_MODIS250m_kNN_Species_Pseu_Men_Men_v0.tif" "624056183313d61e" "8056430" "xxhash64" "NFI_MODIS250m_kNN_Species_Pseu_Men_Men_v0.zip" "ddcf4de2946a1a15" "2434045" "xxhash64" +"NFI_MODIS250m_kNN_Species_Pseu_Men_v0.tif" "674e3b24c7e91073" "24093314" "xxhash64" "NFI_MODIS250m_kNN_Species_Pseu_Men_v0.zip" "9b7610cfb29937fe" "18100160" "xxhash64" "NFI_MODIS250m_kNN_Species_Quer_Alb_v0.zip" "ea3a81da7749c0aa" "3351515" "xxhash64" "NFI_MODIS250m_kNN_Species_Quer_Bic_v0.zip" "09e56fc44fac1a00" "2095088" "xxhash64" @@ -114,54 +188,17 @@ "NFI_MODIS250m_kNN_Species_Thuj_Pli_v0.zip" "7e42bf10b321cba5" "13745794" "xxhash64" "NFI_MODIS250m_kNN_Species_Thuj_Spp_v0.zip" "4404b31292362529" "11561758" "xxhash64" "NFI_MODIS250m_kNN_Species_Tili_Ame_v0.zip" "6dfaaa32eeac5489" "10604517" "xxhash64" +"NFI_MODIS250m_kNN_Species_Tsug_Can_v0.tif" "188690797081bce8" "22860660" "xxhash64" "NFI_MODIS250m_kNN_Species_Tsug_Can_v0.zip" "2ba7599c51df3284" "16965829" "xxhash64" "NFI_MODIS250m_kNN_Species_Tsug_Het_v0.zip" "13e54649abe86c9e" "12567234" "xxhash64" "NFI_MODIS250m_kNN_Species_Tsug_Mer_Het_v0.zip" "f563565267b2dba7" "1937646" "xxhash64" "NFI_MODIS250m_kNN_Species_Tsug_Mer_v0.zip" "35043d31d7a5a59e" "5684141" "xxhash64" +"NFI_MODIS250m_kNN_Species_Tsug_Spp_v0.tif" "c0a7f6c4fad511dd" "17326652" "xxhash64" "NFI_MODIS250m_kNN_Species_Tsug_Spp_v0.zip" "0c2f79b0c41df76f" "11595332" "xxhash64" "NFI_MODIS250m_kNN_Species_Ulmu_Ame_v0.zip" "ca59300bdbe7577f" "4811851" "xxhash64" "NFI_MODIS250m_kNN_Species_Ulmu_Rub_v0.zip" "35c9555a4b08752f" "1930874" "xxhash64" "NFI_MODIS250m_kNN_Species_Ulmu_Spp_v0.zip" "4713bb1faca25077" "1877670" "xxhash64" "NFI_MODIS250m_kNN_Species_Ulmu_Tho_v0.zip" "0faf103268fc40c1" "1883250" "xxhash64" -"Beaudoin_2014_CJFR.pdf" "f1bde1a33abbd27e" "6719588" "xxhash64" -"NFI_MAP_V0_metadata.xls" "79285734f8f2deb0" "74240" "xxhash64" -"NFI_MODIS250m_kNN_Species_Abie_Bal_v0.tif" "134eda15fa7152ba" "119879192" "xxhash64" -"NFI_MODIS250m_kNN_Species_Abie_Las_v0.tif" "ae77900de22dad3a" "46393844" "xxhash64" -"NFI_MODIS250m_kNN_Species_Acer_Neg_v0.tif" "8ded28e52d8184a2" "8379017" "xxhash64" -"NFI_MODIS250m_kNN_Species_Acer_Pen_v0.tif" "d4f74c984fb0b8f0" "9316070" "xxhash64" -"NFI_MODIS250m_kNN_Species_Acer_Sah_v0.tif" "1ca07dd90067903f" "39954107" "xxhash64" -"NFI_MODIS250m_kNN_Species_Acer_Spi_v0.tif" "78aa649cdaed13dc" "9636115" "xxhash64" -"NFI_MODIS250m_kNN_Species_Acer_Spp_v0.tif" "3c5a6e6124dba268" "25072821" "xxhash64" -"NFI_MODIS250m_kNN_Species_Alnu_Spp_v0.tif" "00e79196f7e7b412" "9116468" "xxhash64" -"NFI_MODIS250m_kNN_Species_Betu_All_v0.tif" "4a995d0e2d28aefe" "43794475" "xxhash64" -"NFI_MODIS250m_kNN_Species_Betu_Pap_v0.tif" "d8f9de8858a1898e" "184753955" "xxhash64" -"NFI_MODIS250m_kNN_Species_Betu_Pop_v0.tif" "a898b7e583950431" "10294181" "xxhash64" -"NFI_MODIS250m_kNN_Species_Betu_Spp_v0.tif" "f4e1fe4b52197128" "27682803" "xxhash64" -"NFI_MODIS250m_kNN_Species_Fagu_Gra_v0.tif" "f9a2720f09bd7ab1" "24085130" "xxhash64" -"NFI_MODIS250m_kNN_Species_Frax_Ame_v0.tif" "881d37753b9f3917" "15418557" "xxhash64" -"NFI_MODIS250m_kNN_Species_Frax_Nig_v0.tif" "c0a32015e88e1aa3" "23665043" "xxhash64" -"NFI_MODIS250m_kNN_Species_Frax_Spp_v0.tif" "2ca25a66b4d73763" "7623276" "xxhash64" -"NFI_MODIS250m_kNN_Species_Lari_Lar_v0.tif" "c858c1808d25e252" "196774120" "xxhash64" -"NFI_MODIS250m_kNN_Species_Lari_Lya_v0.tif" "94bc94bbf04c90e6" "8531365" "xxhash64" -"NFI_MODIS250m_kNN_Species_Lari_Occ_v0.tif" "5aa4f893bc2a45a4" "10327235" "xxhash64" -"NFI_MODIS250m_kNN_Species_Lari_Spp_v0.tif" "77b296085a94ccc2" "9104534" "xxhash64" -"NFI_MODIS250m_kNN_Species_Pice_Eng_Gla_v0.tif" "3d58f5095cc75f11" "8974864" "xxhash64" -"NFI_MODIS250m_kNN_Species_Pice_Eng_v0.tif" "d671b3c7628517ed" "19608772" "xxhash64" -"NFI_MODIS250m_kNN_Species_Pice_Gla_v0.tif" "76ff34659902fc5d" "214920877" "xxhash64" -"NFI_MODIS250m_kNN_Species_Pice_Mar_v0.tif" "c11ae718d7510af8" "328900034" "xxhash64" -"NFI_MODIS250m_kNN_Species_Pice_Spp_v0.tif" "cea70f8ce74239ce" "44316920" "xxhash64" -"NFI_MODIS250m_kNN_Species_Pinu_Alb_v0.tif" "2ca5225bb2a20ecb" "10017482" "xxhash64" -"NFI_MODIS250m_kNN_Species_Pinu_Ban_v0.tif" "87abafa6c3eace5d" "183295505" "xxhash64" -"NFI_MODIS250m_kNN_Species_Pinu_Con_Lat_v0.tif" "1cd250eb5a53083d" "21291662" "xxhash64" -"NFI_MODIS250m_kNN_Species_Pinu_Con_v0.tif" "ffc7972f325a2383" "60905480" "xxhash64" -"NFI_MODIS250m_kNN_Species_Pinu_Mon_v0.tif" "aade1c266dd4592f" "8616020" "xxhash64" -"NFI_MODIS250m_kNN_Species_Pinu_Res_v0.tif" "9d1d45450e856593" "19417450" "xxhash64" -"NFI_MODIS250m_kNN_Species_Pinu_Spp_v0.tif" "bd7623beb7aab8e8" "10687862" "xxhash64" -"NFI_MODIS250m_kNN_Species_Popu_Bal_v0.tif" "d21e3521c0fc74b2" "70031410" "xxhash64" -"NFI_MODIS250m_kNN_Species_Popu_Gra_v0.tif" "61ebdbb7351e083c" "20920687" "xxhash64" -"NFI_MODIS250m_kNN_Species_Popu_Spp_v0.tif" "8fbdf2260732d673" "58992467" "xxhash64" -"NFI_MODIS250m_kNN_Species_Popu_Tre_v0.tif" "e871be8011844a74" "235379759" "xxhash64" -"NFI_MODIS250m_kNN_Species_Popu_Tri_v0.tif" "1700f1f8f92de714" "8062062" "xxhash64" -"NFI_MODIS250m_kNN_Species_Tsug_Can_v0.tif" "188690797081bce8" "22860660" "xxhash64" -"NFI_MODIS250m_kNN_Species_Tsug_Spp_v0.tif" "c0a7f6c4fad511dd" "17326652" "xxhash64" -"NFI_MODIS250m_2001_kNN_Structure_Biomass_TotalLiveAboveGround_v1.tif" "295106f5686a923b" "309928216" "xxhash64" +"NFI_MODIS250m_kNN_Structure_Biomass_TotalLiveAboveGround_v0.tif" "1a07864f573e0efb" "474053079" "xxhash64" +"NFI_MODIS250m_kNN_Structure_Biomass_TotalLiveAboveGround_v0.zip" "8e13ae321f43313a" "449276419" "xxhash64" +"speciesTraits.csv" "155e633022e134cf" "9994" "xxhash64" diff --git a/tests/testthat/test-Biomass_coreFireDisturbance.R b/tests/testthat/test-Biomass_coreFireDisturbance.R index 296dae5..b0ffd5e 100644 --- a/tests/testthat/test-Biomass_coreFireDisturbance.R +++ b/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), diff --git a/tests/testthat/test-Biomass_coreInit.R b/tests/testthat/test-Biomass_coreInit.R index 939ba69..3ad5280 100644 --- a/tests/testthat/test-Biomass_coreInit.R +++ b/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 diff --git a/tests/testthat/test-Biomass_coreMortalityAndGrowth.R b/tests/testthat/test-Biomass_coreMortalityAndGrowth.R index 5d100af..6bdfbb6 100644 --- a/tests/testthat/test-Biomass_coreMortalityAndGrowth.R +++ b/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 diff --git a/tests/testthat/test-Biomass_coreNoDispersalSeeding.R b/tests/testthat/test-Biomass_coreNoDispersalSeeding.R index faf5b97..bda89d6 100644 --- a/tests/testthat/test-Biomass_coreNoDispersalSeeding.R +++ b/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, diff --git a/tests/testthat/test-Biomass_coreSummaryBGM.R b/tests/testthat/test-Biomass_coreSummaryBGM.R index 5344b13..17463cf 100644 --- a/tests/testthat/test-Biomass_coreSummaryBGM.R +++ b/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), diff --git a/tests/testthat/test-Biomass_coreSummaryRegen.R b/tests/testthat/test-Biomass_coreSummaryRegen.R index f3750e2..06b47a5 100644 --- a/tests/testthat/test-Biomass_coreSummaryRegen.R +++ b/tests/testthat/test-Biomass_coreSummaryRegen.R @@ -1,10 +1,21 @@ test_that("test summary regeneration. ",{ - 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(age = c(1, 10, 15), pixelGroup = 1:5))[,B:=10000] cohortData[age == 1, B := seq(100, by = 50, length = 5)] diff --git a/tests/testthat/test-Biomass_coreUniversalDispersalSeeding.R b/tests/testthat/test-Biomass_coreUniversalDispersalSeeding.R index cec6b11..bc1b431 100644 --- a/tests/testthat/test-Biomass_coreUniversalDispersalSeeding.R +++ b/tests/testthat/test-Biomass_coreUniversalDispersalSeeding.R @@ -1,11 +1,20 @@ test_that("test universal 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, diff --git a/tests/testthat/test-Biomass_coreWardDispersalSeeding.R b/tests/testthat/test-Biomass_coreWardDispersalSeeding.R index 20e863b..76dbd87 100644 --- a/tests/testthat/test-Biomass_coreWardDispersalSeeding.R +++ b/tests/testthat/test-Biomass_coreWardDispersalSeeding.R @@ -1,26 +1,65 @@ test_that("test Ward 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") + require("LandR") + require("SpaDES.core") + 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)) # 1. testing how the species seeds spread into the neighbor empty cells # the cohort data is set to not allow on site regeneration - ecoregionMap <- raster(xmn = 50, xmx = 50 + 99 * 100, - ymn = 50, ymx = 50 + 99 * 100, + + + sppEquiv <- LandR::sppEquivalencies_CA[nzchar(LANDIS_test)] + speciesURL <- moduleInputs(module, modulePath)[objectName == "species"]$sourceURL + species <- getSpeciesTable(dPath = outputPath, url = speciesURL)[Area == "BSW"] + species <- species[sppEquiv, on = c("LandisCode" = "LANDIS_traits"), nomatch = 0] + setnames(species, c("Maturity", "SeedEffDist", "SeedMaxDist", "Shade", "Longevity", "MortalityCurve", "GrowthCurve"), + c("sexualmature", "seeddistance_eff", "seeddistance_max", "shadetolerance", "longevity", "mortalityshape", "growthcurve")) + spFac <- factor(species$LandR) + species[, speciesCode := spFac] + + cohortData <- data.table(pixelGroup = 1, ecoregionGroup = factor(1L), + speciesCode = spFac[7:10], age = 41, B = 8000L, + mortality = 50, aNPPAct = 1079.75965551773) + + + # sim$studyArea <- randomStudyArea(seed = 1234, size = (250^2)*100) # Jan 2021 we agreed to force user to provide a SA/SAL + rasterToMatch <- raster(xmn = 50 - 1.3e6, xmx = 50 + 99 * 100 - 1.3e6, + ymn = 50 + 6.9e6, ymx = 50 + 99 * 100 + 6.9e6, res = c(100, 100), val = 1) - pixelGroupMap <- setValues(ecoregionMap,2) + crs(rasterToMatch) <- CRS("+proj=lcc +lat_0=0 +lon_0=-95 +lat_1=49 +lat_2=77 +x_0=0 +y_0=0 +datum=NAD83 +units=m +no_defs") + studyArea <- rasterToPolygons(rasterToMatch) + + ecoregionFiles <- makeDummyEcoregionFiles(rasterToMatch, rasterToMatch, rasterToMatch) + ecoregionMap <- ecoregionFiles$ecoregionMap + levs <- raster::levels(ecoregionMap)[[1]] + colnames(levs) <- gsub("^ecoregion$", "ecoregionGroup", colnames(levs)) + levels(ecoregionMap) <- levs + + pixelGroupMap <- setValues(raster(ecoregionMap), 2) + nPixelsBurned <- 3000 + pixelGroupMap[1:nPixelsBurned] <- 0 c <- expand.grid(data.frame(a = seq(5, 99, by = 9), b = seq(5, 99, by = 9))) pixelindex <- (c$a - 1) * 99 + c$b #121 pixelGroupMap[pixelindex] <- 1 minRelativeB <- data.table(ecoregion = "eco1", X1 = 0.15, X2 = 0.25, X3 = 0.5, X4 = 0.8, - X5 = 0.95, ecoregionGroup = 1) - sufficientLight <- read.csv("~/GitHub/nrv-succession/code blitz succession/modeltesting-data/sufficientLight.csv", - header = TRUE, stringsAsFactor = FALSE) + X5 = 0.95, ecoregionGroup = factor(1)) + # sufficientLight <- read.csv("~/GitHub/nrv-succession/code blitz succession/modeltesting-data/sufficientLight.csv", + # header = TRUE, stringsAsFactor = FALSE) lastFireYear <- "noFire" activePixelIndex <- 1:9801 lastReg <- 0 @@ -28,143 +67,63 @@ test_that("test Ward dispersal seeding algorithm",{ calibrate <- TRUE regenerationOutput <- data.table(seedingAlgorithm = character(), species = character(), Year = numeric(), numberOfReg = numeric()) - species <- read.csv("~/GitHub/nrv-succession/code blitz succession/modeltesting-data/species.csv", - header = TRUE, stringsAsFactors = FALSE) - species <- data.table(species)[, speciesCode := 1:16] - speciesEcoregion <- read.csv("~/GitHub/nrv-succession/code blitz succession/modeltesting-data/speciesEcoregion.csv", - header = TRUE, stringsAsFactors = FALSE) - speciesEcoregion <- data.table(speciesEcoregion)[, ecoregionGroup := as.numeric(as.factor(ecoregion))] - tempsp <- setkey(species[,.(species,speciesCode)], species) - speciesEcoregion <- setkey(speciesEcoregion,species)[tempsp] - sufficientLight <- read.csv("~/GitHub/nrv-succession/code blitz succession/modeltesting-data/sufficientLight.csv", - header = TRUE, stringsAsFactors = FALSE) + + + speciesEcoregion <- data.table(year = 0, + ecoregionGroup = factor(1), + speciesCode = spFac, + establishprob = 0.22, + maxANPP = 1096, + maxB = 32880L) + # #species <- read.csv("~/GitHub/nrv-succession/code blitz succession/modeltesting-data/species.csv", + # # header = TRUE, stringsAsFactors = FALSE) + # species <- data.table(species)[, speciesCode := 1:16] + # speciesEcoregion <- read.csv("~/GitHub/nrv-succession/code blitz succession/modeltesting-data/speciesEcoregion.csv", + # header = TRUE, stringsAsFactors = FALSE) + # speciesEcoregion <- data.table(speciesEcoregion)[, ecoregionGroup := as.numeric(as.factor(ecoregion))] + # tempsp <- setkey(species[,.(species,speciesCode)], species) + # speciesEcoregion <- setkey(speciesEcoregion,species)[tempsp] + # sufficientLight <- read.csv("~/GitHub/nrv-succession/code blitz succession/modeltesting-data/sufficientLight.csv", + # header = TRUE, stringsAsFactors = FALSE) seedingAlgorithm <- "wardDispersal" - cohortData <- data.table(pixelGroup = 1, ecoregionGroup = 1L, - speciesCode = 7:10, age = 41, B = 8000L, - mortality = 50, aNPPAct = 1079.75965551773) - objects <- list("pixelGroupMap" = pixelGroupMap, - "speciesEcoregion" = speciesEcoregion, - "species" = species, - "successionTimestep" = successionTimestep, - "calibrate" = calibrate, - "seedingAlgorithm" = seedingAlgorithm, - "minRelativeB" = minRelativeB, - "sufficientLight" = sufficientLight, - "lastFireYear" = lastFireYear, - "activePixelIndex" = activePixelIndex, - "lastReg" = lastReg, - "regenerationOutput" = regenerationOutput, - "cohortData" = cohortData, - "ecoregionMap" = ecoregionMap) - mySim <- simInit(times = list(start = 0, end = 2), - params = parameters, - modules = module, - objects = objects, - paths = path) - set.seed(1) - - source(file.path(modulePath(mySim), "Biomass_core", "R", "seedDispersalLANDIS.R")) - if (exists("Biomass_coreWardDispersalSeeding")) { - output <- Biomass_coreWardDispersalSeeding(mySim) - } else { - output <- mySim$.mods$Biomass_core$Biomass_coreWardDispersalSeeding(mySim) - } - output <- output$regenerationOutput$numberOfReg - expect_equal(output,c(283,483,288,358)) - rm(pixelGroupMap, output,activePixelIndex,cohortData,objects,mySim) - - pixelGroupMap <- setValues(ecoregionMap,0) - pixelGroupMap[pixelindex] <- 1 - pixelGroupMap[1:297] <- -1 - activePixelIndex <- 298:9801 - pixelGroupMap[sort(pixelindex)[1:11]] <- 3 - lastFireYear <- 0 - cohortData <- rbind(data.table(pixelGroup = 1, ecoregionGroup = 1L, - speciesCode = 7:10, age = 41, B = 8000L, - mortality = 50, aNPPAct = 1080), - data.table(pixelGroup = 3, ecoregionGroup = 1L, - speciesCode = 7:10, age = 1, B = 8000L, - mortality = 50, aNPPAct = 1090)) - inactivePixelIndex <- 1:297 - postFirePixel <- sort(pixelindex)[1:11] - objects <- list("pixelGroupMap" = pixelGroupMap, - "speciesEcoregion" = speciesEcoregion, - "species" = species, - "successionTimestep" = successionTimestep, - "calibrate" = calibrate, - "seedingAlgorithm" = seedingAlgorithm, - "minRelativeB" = minRelativeB, - "sufficientLight" = sufficientLight, - "lastFireYear" = lastFireYear, - "activePixelIndex" = activePixelIndex, - "lastReg" = lastReg, - "regenerationOutput" = regenerationOutput, - "cohortData" = cohortData, - "ecoregionMap" = ecoregionMap, - "inactivePixelIndex" = inactivePixelIndex, - "postFirePixel" = postFirePixel) - mySim <- simInit(times = list(start = 0, end = 2), - params = parameters, - modules = module, - objects = objects, - paths = path) - set.seed(1) - - source(file.path(modulePath(mySim), "Biomass_core", "R", "seedDispersalLANDIS.R")) - if(exists("Biomass_coreWardDispersalSeeding")){ - output <- Biomass_coreWardDispersalSeeding(mySim) - } else { - output <- mySim$.mods$Biomass_core$Biomass_coreWardDispersalSeeding(mySim) - } - expect_equal(output$regenerationOutput$numberOfReg, - c(239, 439, 254, 337)) - expect_equal(unique(output$pixelGroupMap[1:297]), -1) - rm(pixelGroupMap, ecoregionMap, objects, cohortData, mySim, activePixelIndex) - - # 2. testing on site regeneration in ward dispersal algorithm - # the neiboring cells are inactive - ecoregionMap <- raster(xmn = 50, xmx = 50 + 99 * 100, - ymn = 50, ymx = 50 + 99 * 100, - res = c(100, 100), val = 2) - pixelGroupMap <- ecoregionMap - pixelGroupMap[pixelindex] <- 1 - ecoregionMap[pixelindex] <- 1 - activePixelIndex <- pixelindex - cohortData <- data.table(pixelGroup = 1, ecoregionGroup = 1L, - speciesCode = 7:10, age = 41, B = 80L, - mortality = 50, aNPPAct = 1079.75965551773) - objects <- list("pixelGroupMap" = pixelGroupMap, - "speciesEcoregion" = speciesEcoregion, - "species" = species, - "successionTimestep" = successionTimestep, - "calibrate" = calibrate, - "seedingAlgorithm" = seedingAlgorithm, - "minRelativeB" = minRelativeB, - "sufficientLight" = sufficientLight, - "lastFireYear" = lastFireYear, - "activePixelIndex" = activePixelIndex, - "lastReg" = lastReg, - "regenerationOutput" = regenerationOutput, - "cohortData" = cohortData, - "ecoregionMap" = ecoregionMap) + + sppEquivCol <- "LANDIS_test" + sppEquiv <- LandR::sppEquivalencies_CA[LANDIS_test == "poputrem"] + sppColorVect <- LandR::sppColors(sppEquiv, sppEquivCol, palette = "Accent") + initialBiomassSource <- "cohortData" + + pixelCohortData <- LandR::addPixels2CohortData(cohortData, pixelGroupMap) + ecoregion <- LandR::makeEcoregionDT(pixelCohortData, speciesEcoregion) + + objects <- mget(c("pixelGroupMap", "studyArea", "ecoregion", + "rasterToMatch", "speciesEcoregion", + "species", "sppEquiv", "successionTimestep", "calibrate", + "seedingAlgorithm", "minRelativeB", "lastFireYear", + "activePixelIndex", "lastReg", "regenerationOutput", "cohortData", + "ecoregionMap")) + + parameters$Biomass_core$initialBiomassSource = initialBiomassSource + mySim <- simInit(times = list(start = 0, end = 2), params = parameters, modules = module, objects = objects, paths = path) - set.seed(1) - if(exists("Biomass_coreWardDispersalSeeding")){ - output <- Biomass_coreWardDispersalSeeding(mySim) - } else { - output <- mySim$.mods$Biomass_core$Biomass_coreWardDispersalSeeding(mySim) - } - output <- output$regenerationOutput$numberOfReg - expect_equal(output,c(64,121,69,84)) - + # set.seed(1) -# test ward dispersal seeding after fire disturbance + # source(file.path(modulePath(mySim), "Biomass_core", "R", "seedDispersalLANDIS.R")) + mySim$treedFirePixelTableSinceLastDisp <- + rbindlist(list(mySim$treedFirePixelTableSinceLastDisp, + data.table(pixelIndex = 1:nPixelsBurned, pixelGroup = pixelGroupMap[][1:nPixelsBurned], burnTime = time(mySim)))) + output <- spades(mySim) + expect_is(output$cohortData, "data.table") + news <- output$cohortData[!cohortData, on = c("speciesCode", "age")] + expect_true(NROW(new) > 0) + # Each pixel group is unique + expect_true(all(!duplicated(news[, fastdigest::fastdigest(speciesCode), by = "pixelGroup"]$V1))) + # remainder of seed dispersal testing is in LandR package }) diff --git a/tests/testthat/test-addNewCohorts.R b/tests/testthat/test-addNewCohorts.R index 178e4d5..b572252 100644 --- a/tests/testthat/test-addNewCohorts.R +++ b/tests/testthat/test-addNewCohorts.R @@ -1,20 +1,27 @@ test_that("test add new cohort function",{ - # define the module and path + 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)) - module <- list("Biomass_core") - path <- list(modulePath = "..", # TODO: use general path - outputPath = "~/output") # TODO: use general path - parameters <- list(.progress = list(type = "graphical", interval = 1), - .globals = list(verbose = FALSE), - Biomass_core = list(.saveInitialTime = NA)) - + successionTimestep <- 10 pixelGroupMap <- raster(xmn = 50, xmx = 50 + 3 * 100, ymn = 50, ymx = 50 + 3 * 100, res = c(100, 100), val = 1) pixelGroupMap[1] <- -1 - pixelGroupMap[2:6] <- 2 + pixelGroupMap[2:6] <- 0 cohortData <- data.table(pixelGroup = 1, ecoregionGroup = 1L, speciesCode = 7, age = 31, B = 30000L, @@ -23,7 +30,7 @@ test_that("test add new cohort function",{ , ':='(speciesCode = c(7, 1, 7), pixelIndex = c(7:8, 8))] newcohortdata2 <- rbindlist(list(cohortData, cohortData, cohortData, cohortData))[ - ,':='(pixelGroup = 2, + ,':='(pixelGroup = 0, speciesCode = c(7, 7, 7, 1), pixelIndex = c(4:6, 6))] newcohortdata <- rbindlist(list(newcohortdata1,newcohortdata2))[ @@ -42,18 +49,25 @@ test_that("test add new cohort function",{ modules = module, objects = objects, paths = path) - output <- addNewCohorts(newcohortdata, cohortData, pixelGroupMap, - currentTime = time(mySim), speciesEcoregion = speciesEcoregion) + output <- updateCohortData(newcohortdata, cohortData, pixelGroupMap, + currentTime = time(mySim), speciesEcoregion = speciesEcoregion, + successionTimestep = successionTimestep) mapOutput <- getValues(output$pixelGroupMap) mapOutput_compared <- c(-1, 2, 2, 4, 4, 6, 3, 5, 1) + mapOutput_compared <- c(-1, 0, 0, 1, 1, 2, 5, 4, 3) expect_equal(mapOutput,mapOutput_compared) cohortdataOutput <- output$cohortData[,.(pixelGroup, speciesCode, age, B)] - cohortdataOutput_compared <- data.table(pixelGroup = c(1, 3, 3, 4, 5, 5, 5, 6, 6), - speciesCode = c(rep(7, 4), 1, 7, 7, 1, 7), - age = c(31, 1, 31, 1, 1, 1, 31, 1, 1), - B = c(30000L, 225L, 30000L, 969L, 205L, 225L, 30000L, 886L, 969L)) + cohortdataOutput_compared <- + setDT(list(pixelGroup = c(5L, 4L, 3L, 5L, 4L, 4L, 1L, 2L, 2L), + speciesCode = c(7, 7, 7, 7, 1, 7, 7, 7, 1), + age = c(31, 31, 31, 1, 1, 1, 1, 1, 1), + B = c(30000L, 30000L, 30000L, 225L, 206L, 225L, 969L, 969L, 886L))) + # cohortdataOutput_compared <- data.table(pixelGroup = c(1, 3, 3, 4, 5, 5, 5, 6, 6), + # speciesCode = c(rep(7, 4), 1, 7, 7, 1, 7), + # age = c(31, 1, 31, 1, 1, 1, 31, 1, 1), + # B = c(30000L, 225L, 30000L, 969L, 205L, 225L, 30000L, 886L, 969L)) expect_equal(cohortdataOutput,cohortdataOutput_compared) }) diff --git a/tests/testthat/test-agereclassification.R b/tests/testthat/test-agereclassification.R index 76a9a8d..de353ce 100644 --- a/tests/testthat/test-agereclassification.R +++ b/tests/testthat/test-agereclassification.R @@ -1,11 +1,21 @@ test_that("test process of age reclassification",{ - # 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)) + successionTimestep <- 10 objects <- list() mySim <- simInit(times=list(start=0, end=1), @@ -39,7 +49,7 @@ test_that("test process of age reclassification",{ cohortData_output <- setkey(output,age) cohortData_output_compared <- setkey(data.table(pixelGroup = 1, ecoregionGroup = 1, - speciesCode = 16, age = c(9,49), B = c(55,11), + speciesCode = 16, age = c(11,49), B = c(55,11), mortality = c(1500,150), aNPPAct = c(9990,999)),age) expect_equal(cohortData_output,cohortData_output_compared) diff --git a/tests/testthat/test-assignLightProb.R b/tests/testthat/test-assignLightProb.R index 98e81b8..fd90e1b 100644 --- a/tests/testthat/test-assignLightProb.R +++ b/tests/testthat/test-assignLightProb.R @@ -1,12 +1,21 @@ test_that("test assign light probability for a given species tolerance and site shade",{ - library(SpaDES) - # 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)) + sufficientLight <- data.frame(speciesshadetolerance=1:5, X0=seq(1,0.8,length=5), X1=seq(0.8,0.6,length=5), diff --git a/tests/testthat/test-cacheSpinUpFunction.R b/tests/testthat/test-cacheSpinUpFunction.R index 6c57b2c..d3364b9 100644 --- a/tests/testthat/test-cacheSpinUpFunction.R +++ b/tests/testthat/test-cacheSpinUpFunction.R @@ -1,10 +1,21 @@ test_that("test cache function for spinUp",{ - 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)) + useCache <- TRUE objects <- list("useCache"=useCache) mySim <- simInit(times=list(start=0, end=2), diff --git a/tests/testthat/test-calcSiteShade.R b/tests/testthat/test-calcSiteShade.R index 235f181..2db9e38 100644 --- a/tests/testthat/test-calcSiteShade.R +++ b/tests/testthat/test-calcSiteShade.R @@ -1,12 +1,21 @@ test_that("test site shade calculation",{ - library(SpaDES) - # 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)) + minRelativeB <- data.table(ecoregion = c("eco1", "eco2"), X1 = c(0.145, 0.15), X2 = c(0.217, 0.25), X3 = c(0.288, 0.5), X4 = c(0.359, 0.8), X5 = c(0.430, 0.95), ecoregionGroup = 1:2) diff --git a/tests/testthat/test-calculateANPP.R b/tests/testthat/test-calculateANPP.R index 5525749..9e82de5 100644 --- a/tests/testthat/test-calculateANPP.R +++ b/tests/testthat/test-calculateANPP.R @@ -1,12 +1,21 @@ test_that("test ANPP calculation",{ - library(SpaDES) - # 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)) + objects <- list() mySim <- simInit(times=list(start=0, end=1), params=parameters, diff --git a/tests/testthat/test-calculateAgeMortality.R b/tests/testthat/test-calculateAgeMortality.R index 63212a1..bc0727f 100644 --- a/tests/testthat/test-calculateAgeMortality.R +++ b/tests/testthat/test-calculateAgeMortality.R @@ -1,12 +1,21 @@ test_that("test process of age reclassification",{ - library(SpaDES) - # 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)) + spinupMortalityfraction <- 0.001 objects <- list() mySim <- simInit(times=list(start=0, end=1), diff --git a/tests/testthat/test-calculateCompetition.R b/tests/testthat/test-calculateCompetition.R index a128acf..d7862ab 100644 --- a/tests/testthat/test-calculateCompetition.R +++ b/tests/testthat/test-calculateCompetition.R @@ -1,12 +1,21 @@ test_that("test competition calculation at both spinup stage and main simulation stage",{ - library(SpaDES) - # 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)) + objects <- list() mySim <- simInit(times=list(start=0, end=1), params=parameters, diff --git a/tests/testthat/test-calculateGrowthMortality.R b/tests/testthat/test-calculateGrowthMortality.R index 026e324..7dff4f9 100644 --- a/tests/testthat/test-calculateGrowthMortality.R +++ b/tests/testthat/test-calculateGrowthMortality.R @@ -1,12 +1,20 @@ test_that("test Growth-related Mortality calculation",{ - library(SpaDES) - # 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)) objects <- list() mySim <- simInit(times=list(start=0, end=1), params=parameters, diff --git a/tests/testthat/test-calculateSumB.R b/tests/testthat/test-calculateSumB.R index 7993579..b571b2f 100644 --- a/tests/testthat/test-calculateSumB.R +++ b/tests/testthat/test-calculateSumB.R @@ -1,12 +1,20 @@ test_that("test total site biomass (sumB) ",{ - library(SpaDES) - # 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)) successionTimestep <- 10 objects <- list() mySim <- simInit(times=list(start=0, end=1), diff --git a/tests/testthat/test-spinUp.R b/tests/testthat/test-spinUp.R index ed0cbe4..a1c0a73 100644 --- a/tests/testthat/test-spinUp.R +++ b/tests/testthat/test-spinUp.R @@ -1,11 +1,20 @@ test_that("test growth and mortality at spinup stage",{ - # 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)) spinupMortalityfraction <- 0.001 calibrate <- TRUE successionTimestep <- 1 diff --git a/tests/testthat/test-timeScheduleofAgeReclassificationandSumB.R b/tests/testthat/test-timeScheduleofAgeReclassificationandSumB.R index ba95045..00b09af 100644 --- a/tests/testthat/test-timeScheduleofAgeReclassificationandSumB.R +++ b/tests/testthat/test-timeScheduleofAgeReclassificationandSumB.R @@ -1,12 +1,20 @@ test_that("test scheduled time for age classification and sumB at spinup stage",{ - library(SpaDES) - # 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)) spinupMortalityfraction <- 0.001 calibrate <- TRUE successionTimestep <- 1 diff --git a/tests/unitTests.R b/tests/unitTests.R index 26a0cc1..cd2e4bf 100644 --- a/tests/unitTests.R +++ b/tests/unitTests.R @@ -3,7 +3,5 @@ # please specify the package you need to run the sim function in the test files. # to test all the test files in the tests folder: -test_dir("../Biomass_core/tests/testthat") +try(test_dir("../Biomass_core/tests/testthat")) -# Alternative, you can use test_file to test individual test file, e.g.: -test_file("../Biomass_core/tests/testthat/test-template.R") From 710822fc11996288a704f041243cd5ad52e3201c Mon Sep 17 00:00:00 2001 From: Eliot McIntire Date: Thu, 25 Nov 2021 10:55:33 -0800 Subject: [PATCH 02/11] possible mini speedup --- R/helpers.R | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/R/helpers.R b/R/helpers.R index 91c10b3..b622b92 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -143,9 +143,14 @@ calculateSumB <- compiler::cmpfun(function(cohortData, lastReg, currentTime, suc if (algo == 2 || isTRUE(doAssertion)) { ## this newer version is typically much faster than the older one above (Eliot June 2, 2019) - cohortData2 <- copy(cohortData) + oldKey <- key(cohortData) + keepCols <- union(c("B", "pixelGroup", "age"), oldKey) + cohortData2 <- copy(cohortData[, ..keepCols]) + #cohortData2 <- copy(cohortData) + set(cohortData2, NULL, "origOrd", seq(NROW(cohortData))) new1 <- Sys.time() - oldKey <- checkAndChangeKey(cohortData2, "pixelGroup") + oldKeyToDelete <- checkAndChangeKey(cohortData2, "pixelGroup") + #oldKey <- checkAndChangeKey(cohortData2, "pixelGroup") wh <- which(cohortData2$age >= successionTimestep) sumBtmp <- cohortData2[wh, list(N = .N, sumB = sum(B, na.rm = TRUE)), by = "pixelGroup"] if ("sumB" %in% names(cohortData2)) set(cohortData2, NULL, "sumB", NULL) @@ -161,6 +166,11 @@ calculateSumB <- compiler::cmpfun(function(cohortData, lastReg, currentTime, suc set(cohortData2, NULL, "sumB", sumB) if (!is.null(oldKey)) setkeyv(cohortData2, oldKey) + setorderv(cohortData2, "origOrd") + set(cohortData2, NULL, "origOrd", NULL) + rejoinCols <- setdiff(colnames(cohortData), keepCols) + cohortData2 <- data.table(cohortData2, cohortData[, ..rejoinCols]) + setcolorder(cohortData2, colnames(cohortData)) new2 <- Sys.time() if (!is.integer(cohortData2[["sumB"]])) set(cohortData2, NULL, "sumB", asInteger(cohortData2[["sumB"]])) From 162c2f7a92e3c99699c1eda7f48a40a0523de07a Mon Sep 17 00:00:00 2001 From: Eliot McIntire Date: Thu, 25 Nov 2021 11:07:50 -0800 Subject: [PATCH 03/11] noSeeding option --- Biomass_core.R | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/Biomass_core.R b/Biomass_core.R index 3ff5657..79291a1 100644 --- a/Biomass_core.R +++ b/Biomass_core.R @@ -83,7 +83,8 @@ defineModule(sim, list( defineParameter("plotOverstory", "logical", FALSE, NA, NA, desc = "swap max age plot with overstory biomass"), defineParameter("seedingAlgorithm", "character", "wardDispersal", NA_character_, NA_character_, desc = paste("choose which seeding algorithm will be used among", - "noDispersal, universalDispersal, and wardDispersal (default).", + "noSeeding (no horizontal, nor vertical seeding), noDispersal (no horizontal disperal),", + "universalDispersal, and wardDispersal (default).", "Species dispersal distances (in the 'species' table) are based", "on LANDIS-II parameters.")), defineParameter("spinupMortalityfraction", "numeric", 0.001, @@ -1211,7 +1212,9 @@ Dispersal <- function(sim) { sim <- UniversalDispersalSeeding(sim, tempActivePixel, pixelsFromCurYrBurn) } else if (P(sim)$seedingAlgorithm == "wardDispersal") { sim <- WardDispersalSeeding(sim, tempActivePixel, pixelsFromCurYrBurn) - } else stop("Undefined seed dispersal type!") + } else if (!P(sim)$seedingAlgorithm == "noSeeding") { + stop("Undefined seed dispersal type!") + } sim$treedFirePixelTableSinceLastDisp <- treedFirePixelTableCurYr return(invisible(sim)) From 1eb5520573f18af0ce10a85c5192b37d5970650e Mon Sep 17 00:00:00 2001 From: Eliot McIntire Date: Thu, 25 Nov 2021 11:10:56 -0800 Subject: [PATCH 04/11] summaryBGM skipping option: calcSummaryBGM = NULL --- Biomass_core.R | 22 +++++++++++++--------- 1 file changed, 13 insertions(+), 9 deletions(-) diff --git a/Biomass_core.R b/Biomass_core.R index 79291a1..2404dad 100644 --- a/Biomass_core.R +++ b/Biomass_core.R @@ -35,7 +35,8 @@ defineModule(sim, list( "'postDisp' - after dispersal, 'postRegen' - after post-disturbance regeneration (currently the same as 'start'),", "'postGM' - after growth and mortality, 'postAging' - after aging,", "'end' - at the end of vegetation succesion events, before plotting and saving.", - "The 'end' option is always active, being also the default option.")), + "The 'end' option is always active, being also the default option.", + "If NULL, then will skip all summaryBGM related events")), defineParameter("calibrate", "logical", FALSE, desc = "Do calibration? Defaults to FALSE"), defineParameter("cohortDefinitionCols", "character", c("pixelGroup", "speciesCode", "age"), NA, NA, @@ -283,8 +284,9 @@ doEvent.Biomass_core <- function(sim, eventTime, eventType, debug = FALSE) { postAging = agingEvtPriotity + 0.25, end = summRegenPriority + 0.25) ## add "end" to parameter vector if necessary - if (!any(P(sim)$calcSummaryBGM == "end")) - params(sim)$Biomass_core$calcSummaryBGM <- c(P(sim)$calcSummaryBGM, "end") + if (!is.null(P(sim)$calcSummaryBGM)) + if (!any(P(sim)$calcSummaryBGM == "end")) + params(sim)$Biomass_core$calcSummaryBGM <- c(P(sim)$calcSummaryBGM, "end") summBGMPriority <- summBGMPriority[P(sim)$calcSummaryBGM] ## filter necessary priorities plotPriority <- 9 @@ -374,14 +376,16 @@ doEvent.Biomass_core <- function(sim, eventTime, eventType, debug = FALSE) { } ## note that summaryBGM and summaryBySpecies, will occur during init too - sim <- scheduleEvent(sim, start(sim), - "Biomass_core", "summaryBGM", eventPriority = summBGMPriority$end) - sim <- scheduleEvent(sim, start(sim) + P(sim)$successionTimestep, + if (!is.null(P(sim)$calcSummaryBGM)) { + sim <- scheduleEvent(sim, start(sim), + "Biomass_core", "summaryBGM", eventPriority = summBGMPriority$end) + sim <- scheduleEvent(sim, start(sim) + P(sim)$successionTimestep, "Biomass_core", "summaryRegen", eventPriority = summRegenPriority) sim <- scheduleEvent(sim, start(sim), - "Biomass_core", "plotSummaryBySpecies", eventPriority = plotPriority) ## only occurs before summaryRegen in init. - sim <- scheduleEvent(sim, end(sim), - "Biomass_core", "plotSummaryBySpecies", eventPriority = plotPriority) ## schedule the last plotting events (so that it doesn't depend on plot interval) + "Biomass_core", "plotSummaryBySpecies", eventPriority = plotPriority) ## only occurs before summaryRegen in init. + sim <- scheduleEvent(sim, end(sim), + "Biomass_core", "plotSummaryBySpecies", eventPriority = plotPriority) ## schedule the last plotting events (so that it doesn't depend on plot interval) + } if (anyPlotting(P(sim)$.plots)) { if (P(sim)$.plotMaps) { From a74f34e84d3a6bcbb43144c111cf7e56d89c4dd1 Mon Sep 17 00:00:00 2001 From: Eliot McIntire Date: Thu, 25 Nov 2021 11:11:23 -0800 Subject: [PATCH 05/11] Warning about putting successionTimestep > 10 ... --- Biomass_core.R | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/Biomass_core.R b/Biomass_core.R index 2404dad..236f5c6 100644 --- a/Biomass_core.R +++ b/Biomass_core.R @@ -94,7 +94,8 @@ defineModule(sim, list( "The column in sim$specieEquivalency data.table to use as a naming convention"), defineParameter("successionTimestep", "numeric", 10, NA, NA, paste("defines the simulation time step, default is 10 years.", - "Note that growth and mortality always happen on a yearly basis.")), + "Note that growth and mortality always happen on a yearly basis.", + "Cohorts younger than this age will not be included in competitive interactions")), defineParameter("vegLeadingProportion", "numeric", 0.8, 0, 1, desc = "a number that define whether a species is leading for a given pixel"), defineParameter(".maxMemory", "numeric", 5, NA, NA, @@ -510,6 +511,13 @@ Init <- function(sim, verbose = getOption("LandR.verbose", TRUE)) { # stop("the species in sim$cohortData are not the same as the species in sim$species; these must match") cacheTags <- c(currentModule(sim), "init") + # Check some parameter values + if (P(sim)$successionTimestep > 10) + warning("successionTimestep parameter is > 10. Make sure this intended, ", + "keeping in mind that growth in the model depends on estimating 'sumB'. ", + "Only trees that are older than successionTimestep are included in the ", + "calculation of sumB, i.e., trees younger than this do not contribute ", + "to competitive interactions") ############################################## ## Prepare individual objects ############################################## From cd3b156a2dbdd60325b48a43aae5bcc4dfb86227 Mon Sep 17 00:00:00 2001 From: Eliot McIntire Date: Thu, 25 Nov 2021 11:15:42 -0800 Subject: [PATCH 06/11] fine tuning `gc()` use ... not required when "small" --- Biomass_core.R | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/Biomass_core.R b/Biomass_core.R index 236f5c6..dd04012 100644 --- a/Biomass_core.R +++ b/Biomass_core.R @@ -692,7 +692,7 @@ Init <- function(sim, verbose = getOption("LandR.verbose", TRUE)) { modelBiomass = modelBiomass, successionTimestep = P(sim)$successionTimestep, currentYear = time(sim)) - if (ncell(sim$rasterToMatch) > 3e6) .gc() + if (ncell(sim$rasterToMatch) > 3e7) .gc() ######################################################################## # Create initial communities, i.e., pixelGroups @@ -1193,13 +1193,13 @@ MortalityAndGrowth <- compiler::cmpfun(function(sim) { } else { sim$cohortData <- rbindlist(list(sim$cohortData, subCohortData), fill = TRUE) } - rm(subCohortData) - } - rm(cohortData) - gc() ## restored this gc call 2019-08-20 (AMC) + rm(subCohortData) + } + rm(cohortData) + if (ncell(sim$rasterToMatch) > 3e7) gc() ## restored this gc call 2019-08-20 (AMC) - ## now age this year's recruits - sim$cohortData[age == 1, age := age + 1L] + ## now age this year's recruits + sim$cohortData[age == 1, age := age + 1L] if (isTRUE(getOption("LandR.assertions"))) { From 58556111fd5261f07f276503eb7b1978990b2710 Mon Sep 17 00:00:00 2001 From: Eliot McIntire Date: Thu, 25 Nov 2021 11:16:25 -0800 Subject: [PATCH 07/11] corrected message about DTthreads --- Biomass_core.R | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/Biomass_core.R b/Biomass_core.R index dd04012..e45b0ea 100644 --- a/Biomass_core.R +++ b/Biomass_core.R @@ -266,8 +266,7 @@ doEvent.Biomass_core <- function(sim, eventTime, eventType, debug = FALSE) { if (is.numeric(P(sim)$.useParallel)) { a <- data.table::setDTthreads(P(sim)$.useParallel) if (getOption("LandR.verbose", TRUE) > 0) { - message("Biomass_core should be using >100% CPU") - if (data.table::getDTthreads() == 1L) crayon::red(message("Only using 1 thread.")) + if (data.table::getDTthreads() > 1L) message("Biomass_core should be using >100% CPU") } on.exit(data.table::setDTthreads(a), add = TRUE) } @@ -1026,7 +1025,7 @@ MortalityAndGrowth <- compiler::cmpfun(function(sim) { if (is.numeric(P(sim)$.useParallel)) { data.table::setDTthreads(P(sim)$.useParallel) - message("Mortality and Growth should be using >100% CPU") + if (data.table::getDTthreads() > 1L) message("Mortality and Growth should be using >100% CPU") } ## Install climate-sensitive functions (or not) From 16d1a35e0b9cfd0e5ce4157c01666162a15d0d49 Mon Sep 17 00:00:00 2001 From: Eliot McIntire Date: Thu, 25 Nov 2021 11:17:02 -0800 Subject: [PATCH 08/11] deal with edge case where `NROW(cohortData) = 0` --- Biomass_core.R | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/Biomass_core.R b/Biomass_core.R index e45b0ea..2de8c38 100644 --- a/Biomass_core.R +++ b/Biomass_core.R @@ -1022,9 +1022,11 @@ SummaryBGM <- compiler::cmpfun(function(sim) { }) MortalityAndGrowth <- compiler::cmpfun(function(sim) { + # If cohortData has length 0, don't do this -- this can happen in more theoretical use cases where e.g., end(sim) is longer than longevity + if (NROW(sim$cohortData)) { - if (is.numeric(P(sim)$.useParallel)) { - data.table::setDTthreads(P(sim)$.useParallel) + if (is.numeric(P(sim)$.useParallel)) { + data.table::setDTthreads(P(sim)$.useParallel) if (data.table::getDTthreads() > 1L) message("Mortality and Growth should be using >100% CPU") } @@ -1204,9 +1206,10 @@ MortalityAndGrowth <- compiler::cmpfun(function(sim) { if (!identical(NROW(sim$cohortData), NROW(unique(sim$cohortData, by = P(sim)$cohortDefinitionCols)))) { stop("sim$cohortData has duplicated rows, i.e., multiple rows with the same pixelGroup, speciesCode and age") + } } + LandR::assertCohortData(sim$cohortData, sim$pixelGroupMap, cohortDefinitionCols = P(sim)$cohortDefinitionCols) } - LandR::assertCohortData(sim$cohortData, sim$pixelGroupMap, cohortDefinitionCols = P(sim)$cohortDefinitionCols) return(invisible(sim)) }) From 3f840bcb317ed6d970c3cad2e3cf72d8c5a7f16b Mon Sep 17 00:00:00 2001 From: Eliot McIntire Date: Thu, 25 Nov 2021 11:20:49 -0800 Subject: [PATCH 09/11] commenting about the apparent duplicated counting of mAge --- Biomass_core.R | 31 +++++++++++++++++++++---------- 1 file changed, 21 insertions(+), 10 deletions(-) diff --git a/Biomass_core.R b/Biomass_core.R index 2de8c38..0b19c80 100644 --- a/Biomass_core.R +++ b/Biomass_core.R @@ -1126,11 +1126,14 @@ MortalityAndGrowth <- compiler::cmpfun(function(sim) { set(subCohortData, NULL, "sumB", NULL) } - subCohortData <- calculateANPP(cohortData = subCohortData) ## competition effect on aNPP via bPM - set(subCohortData, NULL, "growthcurve", NULL) - set(subCohortData, NULL, "aNPPAct", pmax(1, subCohortData$aNPPAct - subCohortData$mAge)) + subCohortData <- calculateANPP(cohortData = subCohortData) ## competition effect on aNPP via bPM + set(subCohortData, NULL, "growthcurve", NULL) - ## generate climate-sensitivity predictions - this will no longer run if LandR pkg is the driver + # This next line is step one of a double removal of mAge ... see comments a few + # lines down to discuss this double counting + set(subCohortData, NULL, "aNPPAct", pmax(1, subCohortData$aNPPAct - subCohortData$mAge)) + + ## generate climate-sensitivity predictions - this will no longer run if LandR pkg is the driver if (!P(sim)$growthAndMortalityDrivers == "LandR") { #necessary due to column joining if (!is.null(subCohortData$growthPred)) { @@ -1153,12 +1156,20 @@ MortalityAndGrowth <- compiler::cmpfun(function(sim) { #Join must be done this way commonNames <- names(predObj)[names(predObj) %in% names(subCohortData)] subCohortData <- subCohortData[predObj, on = commonNames] - subCohortData[, aNPPAct := pmax(0, asInteger(aNPPAct * growthPred/100))] #changed from ratio to pct for memory - } - subCohortData <- calculateGrowthMortality(cohortData = subCohortData) - set(subCohortData, NULL, "mBio", pmax(0, subCohortData$mBio - subCohortData$mAge)) - set(subCohortData, NULL, "mBio", pmin(subCohortData$mBio, subCohortData$aNPPAct)) - set(subCohortData, NULL, "mortality", subCohortData$mBio + subCohortData$mAge) + subCohortData[, aNPPAct := pmax(0, asInteger(aNPPAct * growthPred/100))] #changed from ratio to pct for memory + } + subCohortData <- calculateGrowthMortality(cohortData = subCohortData) + + + # NOTE RE: double removal of mAge -- it is a correct implementation of the LANDIS source# + # We already tried to purge the double removal... but reverted: https://github.com/PredictiveEcology/Biomass_core/commit/5227ae9acfe291bcb8596fd9e63c79602de5d2c6 + ## LANDIS BSExt v3.2 (implemented in LandR): + ## https://github.com/LANDIS-II-Foundation/Extensions-Succession-Archive/blob/master/biomass-succession-archive/tags/release-3.2/src/CohortBiomass.cs + ## LANDIS BSExt current version: + ## https://github.com/LANDIS-II-Foundation/Extension-Biomass-Succession/blob/master/src/CohortBiomass.cs + set(subCohortData, NULL, "mBio", pmax(0, subCohortData$mBio - subCohortData$mAge)) + set(subCohortData, NULL, "mBio", pmin(subCohortData$mBio, subCohortData$aNPPAct)) + set(subCohortData, NULL, "mortality", subCohortData$mBio + subCohortData$mAge) ## this line will return mortality unchanged unless LandR_BiomassGMCS is also run if (!P(sim)$growthAndMortalityDrivers == "LandR") { From 1676b0a2d37fd80d2f11eef7a755eaec4660a5ac Mon Sep 17 00:00:00 2001 From: Eliot McIntire Date: Thu, 25 Nov 2021 11:23:45 -0800 Subject: [PATCH 10/11] minor speedup -- setkey(cohortData, "pixelGroup") --- Biomass_core.R | 1 + 1 file changed, 1 insertion(+) diff --git a/Biomass_core.R b/Biomass_core.R index 0b19c80..6d9e091 100644 --- a/Biomass_core.R +++ b/Biomass_core.R @@ -1068,6 +1068,7 @@ MortalityAndGrowth <- compiler::cmpfun(function(sim) { currentTime = round(time(sim)), cohortData = subCohortData) subCohortData <- updateSpeciesAttributes(species = sim$species, cohortData = subCohortData) + setkeyv(subCohortData, "pixelGroup") subCohortData <- calculateSumB(cohortData = subCohortData, lastReg = sim$lastReg, currentTime = time(sim), From 1a33769144810a8404cc1fc6f4dbab1ee26a9a96 Mon Sep 17 00:00:00 2001 From: Eliot McIntire Date: Thu, 25 Nov 2021 11:51:32 -0800 Subject: [PATCH 11/11] minor speedup --- Biomass_core.R | 302 ++++++++++++++++++++++++------------------------- 1 file changed, 151 insertions(+), 151 deletions(-) diff --git a/Biomass_core.R b/Biomass_core.R index 6d9e091..8f5b259 100644 --- a/Biomass_core.R +++ b/Biomass_core.R @@ -380,8 +380,8 @@ doEvent.Biomass_core <- function(sim, eventTime, eventType, debug = FALSE) { sim <- scheduleEvent(sim, start(sim), "Biomass_core", "summaryBGM", eventPriority = summBGMPriority$end) sim <- scheduleEvent(sim, start(sim) + P(sim)$successionTimestep, - "Biomass_core", "summaryRegen", eventPriority = summRegenPriority) - sim <- scheduleEvent(sim, start(sim), + "Biomass_core", "summaryRegen", eventPriority = summRegenPriority) + sim <- scheduleEvent(sim, start(sim), "Biomass_core", "plotSummaryBySpecies", eventPriority = plotPriority) ## only occurs before summaryRegen in init. sim <- scheduleEvent(sim, end(sim), "Biomass_core", "plotSummaryBySpecies", eventPriority = plotPriority) ## schedule the last plotting events (so that it doesn't depend on plot interval) @@ -1028,104 +1028,104 @@ MortalityAndGrowth <- compiler::cmpfun(function(sim) { if (is.numeric(P(sim)$.useParallel)) { data.table::setDTthreads(P(sim)$.useParallel) if (data.table::getDTthreads() > 1L) message("Mortality and Growth should be using >100% CPU") - } + } - ## Install climate-sensitive functions (or not) - #a <- try(requireNamespace(P(sim)$growthAndMortalityDrivers, quietly = TRUE)) ## Fixed (Eliot) TODO: this is not working. requireNamespace overrides try - #if (class(a) == "try-error") { - if (!requireNamespace(P(sim)$growthAndMortalityDrivers, quietly = TRUE)) { - stop(paste0("The package specified for growthAndMortalityDrivers, ", - P(sim)$growthAndMortalityDrivers, ", must be installed")) - } + ## Install climate-sensitive functions (or not) + #a <- try(requireNamespace(P(sim)$growthAndMortalityDrivers, quietly = TRUE)) ## Fixed (Eliot) TODO: this is not working. requireNamespace overrides try + #if (class(a) == "try-error") { + if (!requireNamespace(P(sim)$growthAndMortalityDrivers, quietly = TRUE)) { + stop(paste0("The package specified for growthAndMortalityDrivers, ", + P(sim)$growthAndMortalityDrivers, ", must be installed")) + } - calculateClimateEffect <- getFromNamespace("calculateClimateEffect", P(sim)$growthAndMortalityDrivers) - - cohortData <- sim$cohortData - pgs <- unique(cohortData$pixelGroup) - groupSize <- maxRowsDT(maxLen = 1e7, maxMem = P(sim)$.maxMemory) - numGroups <- ceiling(length(pgs) / groupSize) - groupNames <- paste0("Group", seq(numGroups)) - if (length(pgs) > groupSize) { - sim$cohortData <- cohortData[0, ] - pixelGroups <- data.table(pixelGroupIndex = unique(cohortData$pixelGroup), - temID = 1:length(unique(cohortData$pixelGroup))) - cutpoints <- sort(unique(c(seq(1, max(pixelGroups$temID), by = groupSize), max(pixelGroups$temID)))) - #cutpoints <- c(1,max(pixelGroups$temID)) - if (length(cutpoints) == 1) - cutpoints <- c(cutpoints, cutpoints + 1) - - pixelGroups[, groups := rep(groupNames, each = groupSize, length.out = NROW(pixelGroups))] - } - for (subgroup in groupNames) { - if (numGroups == 1) { - subCohortData <- cohortData + calculateClimateEffect <- getFromNamespace("calculateClimateEffect", P(sim)$growthAndMortalityDrivers) + + cohortData <- sim$cohortData + pgs <- unique(cohortData$pixelGroup) + groupSize <- maxRowsDT(maxLen = 1e7, maxMem = P(sim)$.maxMemory) + numGroups <- ceiling(length(pgs) / groupSize) + groupNames <- paste0("Group", seq(numGroups)) + if (length(pgs) > groupSize) { + sim$cohortData <- cohortData[0, ] + pixelGroups <- data.table(pixelGroupIndex = unique(cohortData$pixelGroup), + temID = 1:length(unique(cohortData$pixelGroup))) + cutpoints <- sort(unique(c(seq(1, max(pixelGroups$temID), by = groupSize), max(pixelGroups$temID)))) + #cutpoints <- c(1,max(pixelGroups$temID)) + if (length(cutpoints) == 1) + cutpoints <- c(cutpoints, cutpoints + 1) + + pixelGroups[, groups := rep(groupNames, each = groupSize, length.out = NROW(pixelGroups))] + } + for (subgroup in groupNames) { + if (numGroups == 1) { + subCohortData <- cohortData } else { - subCohortData <- cohortData[pixelGroup %in% pixelGroups[groups == subgroup, ]$pixelGroupIndex, ] + subCohortData <- cohortData[cohortData$pixelGroup %in% pixelGroups$pixelGroupIndex[pixelGroups$groups == subgroup], ] } subCohortData[age > 1, age := age + 1L] subCohortData <- updateSpeciesEcoregionAttributes(speciesEcoregion = sim$speciesEcoregion, - currentTime = round(time(sim)), - cohortData = subCohortData) - subCohortData <- updateSpeciesAttributes(species = sim$species, cohortData = subCohortData) + currentTime = round(time(sim)), + cohortData = subCohortData) + subCohortData <- updateSpeciesAttributes(species = sim$species, cohortData = subCohortData) setkeyv(subCohortData, "pixelGroup") - subCohortData <- calculateSumB(cohortData = subCohortData, - lastReg = sim$lastReg, - currentTime = time(sim), - successionTimestep = P(sim)$successionTimestep) - startNumCohorts <- NROW(subCohortData) - - ######################################################### - # Die from old age or low biomass -- rm from cohortData - ######################################################### - keep <- (subCohortData$age <= subCohortData$longevity) & (subCohortData$B >= P(sim)$minCohortBiomass) - subCohortPostLongevity <- subCohortData[keep,] - diedCohortData <- subCohortData[!keep] - numCohortsDied <- NROW(diedCohortData) - - if (numCohortsDied > 0) { - # Identify the PGs that are totally gone, not just an individual cohort that died - pgsToRm <- diedCohortData[!pixelGroup %in% subCohortPostLongevity$pixelGroup] - - pixelsToRm <- which(getValues(sim$pixelGroupMap) %in% unique(pgsToRm$pixelGroup)) - # RM from the pixelGroupMap -- since it is a whole pixelGroup that is gone, not just a cohort, this is necessary - if (isTRUE(getOption("LandR.assertions"))) { - a <- subCohortPostLongevity$pixelGroup %in% na.omit(getValues(sim$pixelGroupMap)) - if (!all(a)) { - stop("Post longevity-based mortality, there is a divergence between pixelGroupMap and cohortData pixelGroups") + subCohortData <- calculateSumB(cohortData = subCohortData, + lastReg = sim$lastReg, + currentTime = time(sim), + successionTimestep = P(sim)$successionTimestep) + startNumCohorts <- NROW(subCohortData) + + ######################################################### + # Die from old age or low biomass -- rm from cohortData + ######################################################### + keep <- (subCohortData$age <= subCohortData$longevity) & (subCohortData$B >= P(sim)$minCohortBiomass) + subCohortPostLongevity <- subCohortData[keep,] + diedCohortData <- subCohortData[!keep] + numCohortsDied <- NROW(diedCohortData) + + if (numCohortsDied > 0) { + # Identify the PGs that are totally gone, not just an individual cohort that died + pgsToRm <- diedCohortData[!pixelGroup %in% subCohortPostLongevity$pixelGroup] + + pixelsToRm <- which(getValues(sim$pixelGroupMap) %in% unique(pgsToRm$pixelGroup)) + # RM from the pixelGroupMap -- since it is a whole pixelGroup that is gone, not just a cohort, this is necessary + if (isTRUE(getOption("LandR.assertions"))) { + a <- subCohortPostLongevity$pixelGroup %in% na.omit(getValues(sim$pixelGroupMap)) + if (!all(a)) { + stop("Post longevity-based mortality, there is a divergence between pixelGroupMap and cohortData pixelGroups") + } } - } - if (length(pixelsToRm) > 0) { - if (getOption("LandR.verbose", TRUE) > 0) { - numPixelGrps <- sum(sim$pixelGroupMap[] != 0, na.rm = TRUE) - } - sim$pixelGroupMap[pixelsToRm] <- 0L - if (getOption("LandR.verbose", TRUE) > 1) { - message(blue("Death due to old age:", - "\n ", numCohortsDied, "cohorts died of old age (i.e., due to passing longevity) or biomass <= 1; ", - sum(is.na(diedCohortData$age)), " of those because age == NA; ", - "\n ", NROW(unique(pgsToRm$pixelGroup)), "pixelGroups to be removed (i.e., ", - "\n ", length(pixelsToRm), "pixels; ")) - } - if (getOption("LandR.verbose", TRUE) > 0) { - message(blue("\n Total number of pixelGroups -- Was:", numPixelGrps, - ", Now:", magenta(sum(sim$pixelGroupMap[] != 0, na.rm = TRUE)))) + if (length(pixelsToRm) > 0) { + if (getOption("LandR.verbose", TRUE) > 0) { + numPixelGrps <- sum(sim$pixelGroupMap[] != 0, na.rm = TRUE) + } + sim$pixelGroupMap[pixelsToRm] <- 0L + if (getOption("LandR.verbose", TRUE) > 1) { + message(blue("Death due to old age:", + "\n ", numCohortsDied, "cohorts died of old age (i.e., due to passing longevity) or biomass <= 1; ", + sum(is.na(diedCohortData$age)), " of those because age == NA; ", + "\n ", NROW(unique(pgsToRm$pixelGroup)), "pixelGroups to be removed (i.e., ", + "\n ", length(pixelsToRm), "pixels; ")) + } + if (getOption("LandR.verbose", TRUE) > 0) { + message(blue("\n Total number of pixelGroups -- Was:", numPixelGrps, + ", Now:", magenta(sum(sim$pixelGroupMap[] != 0, na.rm = TRUE)))) + } } } - } - subCohortData <- subCohortPostLongevity + subCohortData <- subCohortPostLongevity - ######################################################### - # Calculate age and competition effects - ######################################################### - subCohortData <- calculateAgeMortality(cohortData = subCohortData) + ######################################################### + # Calculate age and competition effects + ######################################################### + subCohortData <- calculateAgeMortality(cohortData = subCohortData) - set(subCohortData, NULL, c("longevity", "mortalityshape"), NULL) - subCohortData <- calculateCompetition(cohortData = subCohortData) - if (!P(sim)$calibrate) { - set(subCohortData, NULL, "sumB", NULL) - } + set(subCohortData, NULL, c("longevity", "mortalityshape"), NULL) + subCohortData <- calculateCompetition(cohortData = subCohortData) + if (!P(sim)$calibrate) { + set(subCohortData, NULL, "sumB", NULL) + } subCohortData <- calculateANPP(cohortData = subCohortData) ## competition effect on aNPP via bPM set(subCohortData, NULL, "growthcurve", NULL) @@ -1135,28 +1135,28 @@ MortalityAndGrowth <- compiler::cmpfun(function(sim) { set(subCohortData, NULL, "aNPPAct", pmax(1, subCohortData$aNPPAct - subCohortData$mAge)) ## generate climate-sensitivity predictions - this will no longer run if LandR pkg is the driver - if (!P(sim)$growthAndMortalityDrivers == "LandR") { - #necessary due to column joining - if (!is.null(subCohortData$growthPred)) { - set(subCohortData, NULL, c('growthPred', 'mortPred'), NULL) - } - #get arguments from sim environment - this way Biomass_core is blind to whatever is used by calculateClimateEffect fxns - #as long as the function is called 'calculateClimateEffect', represents a multiplier, and uses growth, mortality and age limits - cceArgs <- lapply(sim$cceArgs, FUN = function(x) { - arg <- eval(x, envir = sim) - }) - names(cceArgs) <- paste(sim$cceArgs) - - predObj <- calculateClimateEffect(cceArgs = cceArgs, - cohortData = subCohortData, - pixelGroupMap = sim$pixelGroupMap, - gmcsGrowthLimits = P(sim)$gmcsGrowthLimits, - gmcsMortLimits = P(sim)$gmcsMortLimits, - gmcsMinAge = P(sim)$gmcsMinAge, - cohortDefinitionCols = P(sim)$cohortDefinitionCols) - #Join must be done this way - commonNames <- names(predObj)[names(predObj) %in% names(subCohortData)] - subCohortData <- subCohortData[predObj, on = commonNames] + if (!P(sim)$growthAndMortalityDrivers == "LandR") { + #necessary due to column joining + if (!is.null(subCohortData$growthPred)) { + set(subCohortData, NULL, c('growthPred', 'mortPred'), NULL) + } + #get arguments from sim environment - this way Biomass_core is blind to whatever is used by calculateClimateEffect fxns + #as long as the function is called 'calculateClimateEffect', represents a multiplier, and uses growth, mortality and age limits + cceArgs <- lapply(sim$cceArgs, FUN = function(x) { + arg <- eval(x, envir = sim) + }) + names(cceArgs) <- paste(sim$cceArgs) + + predObj <- calculateClimateEffect(cceArgs = cceArgs, + cohortData = subCohortData, + pixelGroupMap = sim$pixelGroupMap, + gmcsGrowthLimits = P(sim)$gmcsGrowthLimits, + gmcsMortLimits = P(sim)$gmcsMortLimits, + gmcsMinAge = P(sim)$gmcsMinAge, + cohortDefinitionCols = P(sim)$cohortDefinitionCols) + #Join must be done this way + commonNames <- names(predObj)[names(predObj) %in% names(subCohortData)] + subCohortData <- subCohortData[predObj, on = commonNames] subCohortData[, aNPPAct := pmax(0, asInteger(aNPPAct * growthPred/100))] #changed from ratio to pct for memory } subCohortData <- calculateGrowthMortality(cohortData = subCohortData) @@ -1172,40 +1172,40 @@ MortalityAndGrowth <- compiler::cmpfun(function(sim) { set(subCohortData, NULL, "mBio", pmin(subCohortData$mBio, subCohortData$aNPPAct)) set(subCohortData, NULL, "mortality", subCohortData$mBio + subCohortData$mAge) - ## this line will return mortality unchanged unless LandR_BiomassGMCS is also run - if (!P(sim)$growthAndMortalityDrivers == "LandR") { + ## this line will return mortality unchanged unless LandR_BiomassGMCS is also run + if (!P(sim)$growthAndMortalityDrivers == "LandR") { - subCohortData[, mortality := pmax(0, asInteger(mortality * mortPred/100))] - subCohortData[, mortality := pmin(mortality, B + aNPPAct)] #this prevents negative biomass, but allows B = 0 for 1 year - if (!P(sim)$keepClimateCols) { - set(subCohortData, NULL, c("growthPred", "mortPred"), NULL) - } + subCohortData[, mortality := pmax(0, asInteger(mortality * mortPred/100))] + subCohortData[, mortality := pmin(mortality, B + aNPPAct)] #this prevents negative biomass, but allows B = 0 for 1 year + if (!P(sim)$keepClimateCols) { + set(subCohortData, NULL, c("growthPred", "mortPred"), NULL) + } } set(subCohortData, NULL, c("mBio", "mAge", "maxANPP", "maxB", "maxB_eco", "bAP", "bPM"), NULL) if (P(sim)$calibrate) { set(subCohortData, NULL, "deltaB", asInteger(subCohortData$aNPPAct - subCohortData$mortality)) set(subCohortData, NULL, "B", subCohortData$B + subCohortData$deltaB) - tempcohortdata <- subCohortData[,.(pixelGroup, Year = time(sim), siteBiomass = sumB, speciesCode, - Age = age, iniBiomass = B - deltaB, ANPP = round(aNPPAct, 1), - Mortality = round(mortality,1), deltaB, finBiomass = B)] - tempcohortdata <- setkey(tempcohortdata, speciesCode)[ - setkey(sim$species[, .(species, speciesCode)], speciesCode), - nomatch = 0][, ':='(speciesCode = species, species = NULL, pixelGroup = NULL)] - setnames(tempcohortdata, "speciesCode", "Species") - sim$simulationTreeOutput <- rbind(sim$simulationTreeOutput, tempcohortdata) - set(subCohortData, NULL, c("deltaB", "sumB"), NULL) - } else { - set(subCohortData, NULL, "B", - subCohortData$B + asInteger(subCohortData$aNPPAct - subCohortData$mortality)) - } - subCohortData[, `:=`(mortality = asInteger(mortality), aNPPAct = asInteger(aNPPAct))] + tempcohortdata <- subCohortData[,.(pixelGroup, Year = time(sim), siteBiomass = sumB, speciesCode, + Age = age, iniBiomass = B - deltaB, ANPP = round(aNPPAct, 1), + Mortality = round(mortality,1), deltaB, finBiomass = B)] + tempcohortdata <- setkey(tempcohortdata, speciesCode)[ + setkey(sim$species[, .(species, speciesCode)], speciesCode), + nomatch = 0][, ':='(speciesCode = species, species = NULL, pixelGroup = NULL)] + setnames(tempcohortdata, "speciesCode", "Species") + sim$simulationTreeOutput <- rbind(sim$simulationTreeOutput, tempcohortdata) + set(subCohortData, NULL, c("deltaB", "sumB"), NULL) + } else { + set(subCohortData, NULL, "B", + subCohortData$B + asInteger(subCohortData$aNPPAct - subCohortData$mortality)) + } + subCohortData[, `:=`(mortality = asInteger(mortality), aNPPAct = asInteger(aNPPAct))] - if (numGroups == 1) { - sim$cohortData <- subCohortData - } else { - sim$cohortData <- rbindlist(list(sim$cohortData, subCohortData), fill = TRUE) - } + if (numGroups == 1) { + sim$cohortData <- subCohortData + } else { + sim$cohortData <- rbindlist(list(sim$cohortData, subCohortData), fill = TRUE) + } rm(subCohortData) } rm(cohortData) @@ -1214,10 +1214,10 @@ MortalityAndGrowth <- compiler::cmpfun(function(sim) { ## now age this year's recruits sim$cohortData[age == 1, age := age + 1L] - if (isTRUE(getOption("LandR.assertions"))) { + if (isTRUE(getOption("LandR.assertions"))) { - if (!identical(NROW(sim$cohortData), NROW(unique(sim$cohortData, by = P(sim)$cohortDefinitionCols)))) { - stop("sim$cohortData has duplicated rows, i.e., multiple rows with the same pixelGroup, speciesCode and age") + if (!identical(NROW(sim$cohortData), NROW(unique(sim$cohortData, by = P(sim)$cohortDefinitionCols)))) { + stop("sim$cohortData has duplicated rows, i.e., multiple rows with the same pixelGroup, speciesCode and age") } } LandR::assertCohortData(sim$cohortData, sim$pixelGroupMap, cohortDefinitionCols = P(sim)$cohortDefinitionCols) @@ -1927,20 +1927,20 @@ CohortAgeReclassification <- function(sim) { "NFI_MODIS250m_2001_kNN_Structure_Biomass_TotalLiveAboveGround_v1.tif") rawBiomassMapFilename <- "NFI_MODIS250m_2001_kNN_Structure_Biomass_TotalLiveAboveGround_v1.tif" # httr::with_config(config = httr::config(ssl_verifypeer = 0L), { ## TODO: re-enable verify - #necessary for KNN - rawBiomassMap <- Cache(prepInputs, - targetFile = rawBiomassMapFilename, - url = rawBiomassMapURL, - destinationPath = dPath, - studyArea = sim$studyArea, - rasterToMatch = NULL, - maskWithRTM = FALSE, - useSAcrs = FALSE, ## never use SA CRS - method = "bilinear", - datatype = "INT2U", - filename2 = NULL, - userTags = c(cacheTags, "rawBiomassMap"), - omitArgs = c("destinationPath", "targetFile", "userTags", "stable")) + #necessary for KNN + rawBiomassMap <- Cache(prepInputs, + targetFile = rawBiomassMapFilename, + url = rawBiomassMapURL, + destinationPath = dPath, + studyArea = sim$studyArea, + rasterToMatch = NULL, + maskWithRTM = FALSE, + useSAcrs = FALSE, ## never use SA CRS + method = "bilinear", + datatype = "INT2U", + filename2 = NULL, + userTags = c(cacheTags, "rawBiomassMap"), + omitArgs = c("destinationPath", "targetFile", "userTags", "stable")) # }) } else { rawBiomassMap <- Cache(postProcess,