Merge remote-tracking branch 'upstream/development' into development

.Rbuildignore

@@ -10,3 +10,4 @@
 ^J4RTmpFile$
 ^LICENSE$
 ^man-roxygen$
+^\.secret$

.gitignore

@@ -1,45 +1,34 @@
 # History files
 .Rhistory
 .Rapp.history
-
 # Session Data files
 .RData
-
 # Example code in package build process
 *-Ex.R
-
 # Output files from R CMD build
 /*.tar.gz
-
 # Output files from R CMD check
 /*.Rcheck/
-
 # RStudio files
 .Rproj.user/
 .Rproj.user
-
 # produced vignettes
 vignettes/*.html
 vignettes/*.pdf
-
 # OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3
 .httr-oauth
-
 # knitr and R markdown default cache directories
 /*_cache/
 /cache/
-
 # Temporary files created by R markdown
 *.utf8.md
 *.knit.md
-
 # Shiny token, see https://shiny.rstudio.com/articles/shinyapps.html
 rsconnect/
-
 # Rcpp files
 *.dll
 *.so
 *.o
-
 inputs/
 J4RTmpFile
+.secret

DESCRIPTION

@@ -8,15 +8,15 @@ Description: Utilities for 'LandR' suite of landscape simulation models.
 URL: 
  http:https://landr.predictiveecology.org,
  https://github.com/PredictiveEcology/LandR
-Date: 2022-02-28
-Version: 1.0.7.9007
+Date: 2022-03-11
+Version: 1.0.7.9012
 Authors@R: c(
  person("Eliot J B", "McIntire", email = "[email protected]",
- role = c("aut", "cre"), comment = c(ORCID = "0000-0002-6914-8316")),
+  role = c("aut", "cre"), comment = c(ORCID = "0000-0002-6914-8316")),
  person("Alex M", "Chubaty", email = "[email protected]",
- role = c("aut"), comment = c(ORCID = "0000-0001-7146-8135")),
+  role = c("aut"), comment = c(ORCID = "0000-0001-7146-8135")),
  person("Her Majesty the Queen in Right of Canada, as represented by the Minister of Natural Resources Canada",
- role = "cph")
+  role = "cph")
  )
 Depends:
  R (>= 4.0)
@@ -101,6 +101,7 @@ Collate:
  'prepSpeciesLayers.R'
  'seedDispersalLANDIS.R'
  'serotiny-resprouting.R'
+ 'speciesPresentFromKNN.R'
  'speciesTable.R'
  'sppEquivalencies_CA.R'
  'studyArea.R'

NAMESPACE

@@ -100,6 +100,8 @@ export(rescale)
 export(rmMissingCohorts)
 export(scheduleDisturbance)
 export(speciesEcoregionLatestYear)
+export(speciesInStudyArea)
+export(speciesPresentFromKNN)
 export(speciesTableUpdate)
 export(sppColors)
 export(sppEquivCheck)
@@ -134,6 +136,7 @@ importFrom(data.table,data.table)
 importFrom(data.table,fread)
 importFrom(data.table,is.data.table)
 importFrom(data.table,melt)
+importFrom(data.table,melt.data.table)
 importFrom(data.table,rbindlist)
 importFrom(data.table,set)
 importFrom(data.table,setDT)
@@ -174,6 +177,7 @@ importFrom(lme4,lmer)
 importFrom(magrittr,"%>%")
 importFrom(map,mapAdd)
 importFrom(map,maps)
+importFrom(parallel,mclapply)
 importFrom(pemisc,createPrjFile)
 importFrom(pemisc,factorValues2)
 importFrom(pemisc,termsInData)
@@ -238,10 +242,13 @@ importFrom(reproducible,postProcessTerra)
 importFrom(reproducible,preProcess)
 importFrom(reproducible,prepInputs)
 importFrom(reproducible,projectInputs)
+importFrom(sf,as_Spatial)
 importFrom(sf,st_as_sf)
 importFrom(sf,st_cast)
 importFrom(sf,st_coordinates)
 importFrom(sf,st_crs)
+importFrom(sf,st_intersects)
+importFrom(sf,st_read)
 importFrom(sf,st_transform)
 importFrom(sp,CRS)
 importFrom(sp,SpatialPoints)

NEWS.md

@@ -4,8 +4,10 @@ version 1.0.7.9000
 =============
 * drop support for R 3.6
 * update Eliot's email address
+* new functions: `speciesInStudyArea` and `species
 * remove undeclared dependency package `Require`
 * age imputation in `makeAndCleanInitialCohortData` can now be turned off.
+* fix bug in `LANDISDisp()`: skip dispersal when src or rcv data.tables are empty
 
 version 1.0.7
 =============

R/cohorts.R

@@ -1539,14 +1539,15 @@ makeCohortDataFiles <- function(pixelCohortData, columnsForPixelGroups, speciesE
 #' @template currentTime
 #' @param successionTimestep succession timestep used in the simulation
 #' @param trackPlanting adds column that tracks planted cohorts if \code{TRUE}
+#' @param initialB the initial biomass of new cohorts. Defaults to ten.
 #'
 #' @return A \code{data.table} with a new \code{cohortData}
 #'
 #' @importFrom data.table copy rbindlist set setkey
 #' @importFrom raster getValues
 #' @importFrom stats na.omit
 #' @export
-plantNewCohorts <- function(newPixelCohortData, cohortData, pixelGroupMap,
+plantNewCohorts <- function(newPixelCohortData, cohortData, pixelGroupMap, initialB = 10,
  currentTime, successionTimestep, trackPlanting = FALSE) {
  ## get spp "productivity traits" per ecoregion/present year
 
@@ -1569,8 +1570,8 @@ plantNewCohorts <- function(newPixelCohortData, cohortData, pixelGroupMap,
 
  # Plant trees
  newCohortData[, age := 2]
- # Give the planted trees 2 * maxANPP - newly regenerating cohorts receive 1x maxANPP. 2x seems overkill
- newCohortData[, B := asInteger(2 * maxANPP)]
+
+ newCohortData[, B := initialB]
 
  # Here we subset cohortData instead of setting added columns to NULL. However, as these are 'new' cohorts, this is okay
  newCohortData <- newCohortData[, .(pixelGroup, ecoregionGroup, speciesCode, age, B, Provenance,
@@ -1624,6 +1625,7 @@ plantNewCohorts <- function(newPixelCohortData, cohortData, pixelGroupMap,
 #' @param provenanceTable A \code{data.table} with three columns:
 #' New cohorts are initiated at the \code{ecoregionGroup} \code{speciesEcoregion} from the
 #' corresponding \code{speciesEcoregion} listed in the \code{Provenance} column
+#' @param initialB the initial biomass of new cohorts. Defaults to ten.
 #' @param trackPlanting if true, planted cohorts in \code{cohortData} are tracked with \code{TRUE}
 #' in column 'planted'
 #'
@@ -1646,6 +1648,7 @@ plantNewCohorts <- function(newPixelCohortData, cohortData, pixelGroupMap,
 updateCohortDataPostHarvest <- function(newPixelCohortData, cohortData, pixelGroupMap, currentTime,
  speciesEcoregion, treedHarvestPixelTable = NULL,
  successionTimestep, provenanceTable, trackPlanting = FALSE,
+ initialB = 10,
  cohortDefinitionCols = c("pixelGroup", "age", "speciesCode"),
  verbose = getOption("LandR.verbose", TRUE),
  doAssertion = getOption("LandR.assertions", TRUE)) {
@@ -1720,6 +1723,7 @@ updateCohortDataPostHarvest <- function(newPixelCohortData, cohortData, pixelGro
  pixelGroupMap,
  currentTime = currentTime,
  successionTimestep = successionTimestep,
+ initialB = initialB,
  trackPlanting = trackPlanting
  )
 

R/maps.R

@@ -567,7 +567,10 @@ vegTypeMapGenerator.data.table <- function(x, pixelGroupMap, vegLeadingProportio
 #' to be considered present in the study area.
 #' Defaults to 10.
 #'
-#' @param url the source url for the data, passed to \code{\link[reproducible]{prepInputs}}
+#' @param url the source url for the data, default is KNN 2011 dataset
+#' \url{paste0("https://ftp.maps.canada.ca/pub/nrcan_rncan/Forests_Foret/",}
+#' \url{"canada-forests-attributes_attributs-forests-canada/2011-",}
+#' \url{"attributes_attributs-2011/")}
 #'
 #' @param ... Additional arguments passed to \code{\link[reproducible]{Cache}}
 #' and \code{\link{equivalentName}}. Also valid: \code{outputPath}, and \code{studyAreaName}.
@@ -580,8 +583,9 @@ vegTypeMapGenerator.data.table <- function(x, pixelGroupMap, vegLeadingProportio
 #' @importFrom reproducible Cache .prefix preProcess basename2
 #' @importFrom tools file_path_sans_ext
 #' @importFrom utils capture.output untar
-loadkNNSpeciesLayers <- function(dPath, rasterToMatch, studyArea, sppEquiv, year = 2001,
- knnNamesCol = "KNN", sppEquivCol, thresh = 10, url, ...) {
+loadkNNSpeciesLayers <- function(dPath, rasterToMatch = NULL, studyArea = NULL, sppEquiv, year = 2001,
+ knnNamesCol = "KNN", sppEquivCol = "Boreal", thresh = 10, url = NULL,
+ ...) {
  rcurl <- requireNamespace("RCurl", quietly = TRUE)
  xml <- requireNamespace("XML", quietly = TRUE)
  if (!rcurl || !xml) {
@@ -598,6 +602,11 @@ loadkNNSpeciesLayers <- function(dPath, rasterToMatch, studyArea, sppEquiv, year
  if ("shared_drive_url" %in% names(dots)) {
  shared_drive_url <- dots[["shared_drive_url"]]
  }
+ if (missing(sppEquiv)) {
+ message("sppEquiv argument is missing, using LandR::sppEquivalencies_CA, with ",
+ sppEquivCol," column (taken from sppEquivCol arg value)")
+ sppEquiv <- sppEquivalencies_CA[get(sppEquivCol) != ""]
+ }
 
  sppEquiv <- sppEquiv[, lapply(.SD, as.character)]
  sppEquiv <- sppEquiv[!is.na(sppEquiv[[sppEquivCol]]), ]
@@ -613,6 +622,11 @@ loadkNNSpeciesLayers <- function(dPath, rasterToMatch, studyArea, sppEquiv, year
  cachePath <- getOption("reproducible.cachePath")
  }
 
+ if (is.null(url))
+ url <- paste0("https://ftp.maps.canada.ca/pub/nrcan_rncan/Forests_Foret/",
+ "canada-forests-attributes_attributs-forests-canada/2011-",
+ "attributes_attributs-2011/")
+
  ## get all online file names
  if (RCurl::url.exists(url)) { ## ping the website first
  ## is it a google drive url?
@@ -697,7 +711,12 @@ loadkNNSpeciesLayers <- function(dPath, rasterToMatch, studyArea, sppEquiv, year
 
  ## define suffix to append to file names
  suffix <- if (basename(cachePath) == "cache") {
- paste0(as.character(ncell(rasterToMatch)), "px")
+ if (is.null(rasterToMatch)) {
+ ""
+ } else {
+ paste0(as.character(ncell(rasterToMatch)), "px")
+ }
+
  } else {
  basename(cachePath)
  }
@@ -799,7 +818,7 @@ loadkNNSpeciesLayers <- function(dPath, rasterToMatch, studyArea, sppEquiv, year
 
  ## return stack and updated species names vector
  if (length(speciesLayers)) {
- stack(speciesLayers)
+ raster::stack(speciesLayers)
  }
 }
 

R/plot_summaries.R

@@ -13,7 +13,7 @@
 #' Plot effects on conifer-to-deciduous or deciduous-to-conifer conversions.
 #'
 #' @template summary_plots
-#' @param Nreps TODO
+#' @template Nreps
 #' @param years TODO
 #' @param treeSpecies TODO
 #' @param defineLeading TODO
@@ -26,6 +26,7 @@
 #' @export
 #' @importFrom data.table data.table
 #' @importFrom grDevices dev.off png
+#' @importFrom parallel mclapply
 #' @importFrom raster calc maxValue minValue raster stack setValues writeRaster
 #' @importFrom RColorBrewer brewer.pal
 #' @importFrom SpaDES.tools rasterizeReduced
@@ -48,7 +49,7 @@ plotLeadingSpecies <- function(studyAreaName, climateScenario, Nreps, years, out
  # 1. for each rep within a scenario, calculate difference -->
  # if conifer to decid = 1, if decid to conifer = -1, otherwise 0
  # 2. Create one single map of "proportion net conversion" sum of difference / Nreps
- allReps <- lapply(1:Nreps, function(rep) {
+ allReps <- parallel::mclapply(1:Nreps, function(rep) {
  runName <- sprintf("%s_%s_run%02d", studyAreaName, climateScenario, rep)
  resultsDir <- file.path(outputDir, runName)
 
@@ -103,7 +104,7 @@ plotLeadingSpecies <- function(studyAreaName, climateScenario, Nreps, years, out
 
  fmeanLeadingChange <- file.path(outputDir, studyAreaName,
  paste0("leadingChange_", studyAreaName, "_", climateScenario, ".tif"))
- if (length() > 1) {
+ if (length(allReps) > 1) {
  meanLeadingChange <- raster::calc(raster::stack(allReps), mean, na.rm = TRUE)
  } else {
  meanLeadingChange <- allReps[[1]]
@@ -117,11 +118,17 @@ plotLeadingSpecies <- function(studyAreaName, climateScenario, Nreps, years, out
  pal <- RColorBrewer::brewer.pal(11, "RdYlBu")
  pal[6] <- "#f7f4f2"
 
- b <- rasterVis::levelplot(
+ fmeanLeadingChange_gg <- file.path(outputDir, studyAreaName, "figures",
+ paste0("leadingChange_", studyAreaName, "_", climateScenario, ".png"))
+
+ fig <- rasterVis::levelplot(
  meanLeadingChange,
- sub = paste0("Proportional change in leading species\n",
- " Red: conversion to conifer\n",
- " Blue: conversion to deciduous."),
+ sub = list(
+ paste0("Proportional change in leading species\n",
+ " Red: conversion to conifer\n",
+ " Blue: conversion to deciduous."),
+ cex = 2
+ ),
  margin = FALSE,
  maxpixels = 7e6,
  at = AT,
@@ -140,11 +147,9 @@ plotLeadingSpecies <- function(studyAreaName, climateScenario, Nreps, years, out
  par.strip.text = list(cex = 0.8, lines = 1, col = "black")
  )
 
- fmeanLeadingChange_gg <- file.path(outputDir, studyAreaName, "figures",
- paste0("leadingChange_", studyAreaName, "_", climateScenario, ".png"))
-
- png(filename = fmeanLeadingChange_gg, width = 1000, height = 1000, res = 300)
- b
+ ## levelplot (trellis grahpics more generally) won't plot correctly inside loop w/o print()
+ png(filename = fmeanLeadingChange_gg, width = 1000, height = 1000)
+ print(fig)
  dev.off()
 
  return(list(fmeanLeadingChange, fmeanLeadingChange_gg))

R/prepInputObjects.R

@@ -410,8 +410,7 @@ prepInputsStandAgeMap <- function(..., ageURL = NULL,
 
  imputedPixID <- integer(0)
  if (!is.null(rasterToMatch)) {
- if (!(is.null(fireURL) || is.na(fireURL))) {
- message("No fireURL supplied, so ages NOT adjusted using fire data.")
+ if (!(is.null(fireURL) | is.na(fireURL))) {
  fireYear <- Cache(prepInputsFireYear, ...,
  url = fireURL,
  fun = fireFun,
@@ -424,6 +423,8 @@ prepInputsStandAgeMap <- function(..., ageURL = NULL,
  standAgeMap[toChange] <- asInteger(startTime) - asInteger(fireYear[][toChange])
  imputedPixID <- which(toChange)
  }
+ } else {
+ message("No fireURL supplied, so ages NOT adjusted using fire data.")
  }
  } else {
  message("No rasterToMatch supplied, so ages NOT adjusted using fire data.")

R/prepSpeciesLayers.R

@@ -551,11 +551,6 @@ prepSpeciesLayers_KNN2011 <- function(destinationPath, outputPath, url = NULL, s
  msg = paste("prepSpeciesLayers_KNN2011 is deprecated.",
  "Please use 'loadkNNSpeciesLayers' and supply URL/year to validation layers."))
 
- if (is.null(url))
- url <- paste0("https://ftp.maps.canada.ca/pub/nrcan_rncan/Forests_Foret/",
- "canada-forests-attributes_attributs-forests-canada/2011-",
- "attributes_attributs-2011/")
-
  loadkNNSpeciesLayers(
  dPath = destinationPath,
  rasterToMatch = rasterToMatch,