spadesCBMdb & plot reorganization

DESCRIPTION

@@ -5,7 +5,7 @@ Description: Implementation of several components of the Carbon Budget Model of
     Canadian Forest Service (v3).
 URL:
     https://github.com/PredictiveEcology/CBMutils
-Version: 2.5.4.9001
+Version: 2.5.3.9002
 Authors@R: c(
     person("Céline",    "Boisvenue", email = "celine.boisvenue@nrcan-rncan.gc.ca", role = c("aut", "cre")),
     person("Alex M",    "Chubaty",   email = "achubaty@for-cast.ca",               role = c("aut"), comment = c(ORCID = "0000-0001-7146-8135")),

NAMESPACE

@@ -37,6 +37,10 @@ export(simMapNPP)
 export(simMapTotalCarbon)
 export(simPlotEmissionsProducts)
 export(simPlotPoolProportions)
+export(spadesCBMdbMapNPP)
+export(spadesCBMdbMapTotalCarbon)
+export(spadesCBMdbPlotEmissionsProducts)
+export(spadesCBMdbPlotPoolProportions)
 export(spadesCBMdbReadRaw)
 export(spadesCBMdbReadSummary)
 export(spadesCBMdbReadTable)

R/CBM-plots_mapNPP.R

@@ -4,11 +4,9 @@ utils::globalVariables(c(
 
 #' `mapNPP`
 #'
-#' Map net primary productivity (NPP) across a study area.
+#' Map Net Primary Productivity (NPP) across a study area.
 #'
-#' @param flux data.table. Table of flux for each cohort or for each pixel.
-#' Must include the 'pixelIndex' column.
-#' @template masterRaster
+#' @param rastNPP SpatRaster. Pixel values represent NPP (t/ha).
 #' @param year numeric. Year that the map represents.
 #' If provided, it will be included in the plot title.
 #'
@@ -20,42 +18,17 @@ utils::globalVariables(c(
 #' @importFrom ggplot2 coord_sf ggplot ggtitle labs scale_fill_gradient2 scale_x_continuous scale_y_continuous
 #' @importFrom tidyterra geom_spatraster
 #' @importFrom terra rast unwrap
-mapNPP <- function(flux, masterRaster, year = NULL) {
-
-  if (!"pixelIndex" %in% names(flux)) stop("flux requires column 'pixelIndex'")
-
-  if (is.null(masterRaster)) stop("masterRaster not found")
-  masterRaster <- terra::unwrap(terra::rast(masterRaster))
-
-  # Calculate NPP
-  if (!identical(names(flux), c("pixelIndex", "NPP"))){
+mapNPP <- function(rastNPP, year = NULL) {
 
-    if (!is.data.table(flux)) flux <- as.data.table(flux)
-    flux <- flux[, .(
-      pixelIndex,
-      NPP = rowSums(flux[, .(
-        DeltaBiomass_AG, DeltaBiomass_BG,
-        TurnoverMerchLitterInput, TurnoverFolLitterInput,
-        TurnoverOthLitterInput, TurnoverCoarseLitterInput, TurnoverFineLitterInput
-      )])
-    )][, lapply(.SD, sum), by = "pixelIndex"]
-  }
+  withr::local_envvar(tidyterra.quiet = TRUE)
 
-  # Plot
   plotTitle <- "Net Primary Productivity (NPP)"
   if (!is.null(year)) plotTitle <- paste(plotTitle, "in", year)
 
-  withr::local_envvar(tidyterra.quiet = TRUE)
-
-  plotRast <- terra::rast(
-    res  = 1,
-    xmin = 0, xmax = terra::ncol(masterRaster),
-    ymin = 0, ymax = terra::nrow(masterRaster)
-  )
-  terra::set.values(plotRast, flux$pixelIndex, round(flux$NPP))
+  meanNPP <- terra::global(rastNPP, "mean", na.rm = TRUE)[[1]]
 
   ggplot() +
-    tidyterra::geom_spatraster(data = plotRast) +
+    tidyterra::geom_spatraster(data = rastNPP) +
     coord_sf() +
     theme_no_axes() +
     scale_x_continuous(expand = c(0, 0)) +
@@ -64,32 +37,61 @@ mapNPP <- function(flux, masterRaster, year = NULL) {
       low = "#D73027",       # red for low
       mid = "#FEE08B",       # yellow for middle
       high = "#1A9850",      # green for high
-      midpoint = mean(flux$NPP, na.rm = TRUE),
+      midpoint = meanNPP,
       na.value = "transparent",
       guide = "colorbar"
     ) +
     labs(fill = "Carbon\n(t/ha)") +
-    ggtitle(paste0(plotTitle, "\n", "Landscape average: ", round(mean(flux$NPP), 3), " t/ha."))
+    ggtitle(paste0(plotTitle, "\n", "Landscape average: ", round(meanNPP, 3), " t/ha."))
 }
 
 
 #' `simMapNPP`
 #'
-#' @inheritParams simCBMdbReadSummary
+#' @template simCBM
+#' @param year numeric. Year of simulation results. Defaults to the current simulation year.
+#' @inheritParams spadesCBMdbReadSummary
 #' @inherit mapNPP description return
 #' @export
-simMapNPP <- function(simCBM, year, useCache = TRUE){
+simMapNPP <- function(simCBM, year = NULL, useCache = TRUE){
 
-  if (missing(year)){
+  if (is.null(year)){
     year <- SpaDES.core::convertTimeunit(SpaDES.core::times(simCBM)$current, "year")
   }
 
-  mapNPP(
-    simCBMdbReadSummary(
-      simCBM, "NPP", units = "t/ha", by = "pixelIndex",
-      year = year, useCache = useCache),
-    year = year,
-    masterRaster = simCBM$masterRaster
+  spadesCBMdbMapNPP(
+    simCBM$spadesCBMdb,
+    masterRaster = simCBM$masterRaster,
+    year         = year,
+    useCache     = useCache
   )
 }
 
+
+#' spadesCBMdb: `mapNPP`
+#'
+#' @inheritParams spadesCBMdbReadSummary
+#' @template masterRaster
+#' @param year numeric. Year of simulation results.
+#' @inherit mapNPP description return
+#' @export
+spadesCBMdbMapNPP <- function(spadesCBMdb, masterRaster, year, useCache = TRUE){
+
+  tblNPP <- spadesCBMdbReadSummary(
+    spadesCBMdb, "NPP", by = "pixelIndex",
+    year = year, useCache = useCache)
+
+  rastNPP <- terra::rast(
+    res  = 1,
+    xmin = 0, xmax = terra::ncol(masterRaster),
+    ymin = 0, ymax = terra::nrow(masterRaster)
+  )
+  terra::set.values(rastNPP, tblNPP$pixelIndex, tblNPP$NPP)
+
+  rm(tblNPP)
+
+  mapNPP(rastNPP, year = year)
+}
+
+
+

R/CBM-plots_mapTotalCarbon.R

@@ -6,9 +6,7 @@ utils::globalVariables(c(
 #'
 #' Map total carbon across a study area.
 #'
-#' @param pools data.table. Table of pools for each cohort or for each pixel.
-#' Must include the 'pixelIndex' column.
-#' @template masterRaster
+#' @param rastTC SpatRaster. Pixel values represent total carbon (t/ha).
 #' @param year numeric. Year that the map represents.
 #' If provided, it will be included in the plot title.
 #'
@@ -20,43 +18,15 @@ utils::globalVariables(c(
 #' @importFrom ggplot2 coord_sf ggplot ggtitle labs scale_fill_gradient2 scale_x_continuous scale_y_continuous
 #' @importFrom tidyterra geom_spatraster
 #' @importFrom terra rast unwrap
-mapTotalCarbon <- function(pools, masterRaster, year = NULL){
-
-  if (!"pixelIndex" %in% names(pools)) stop("pools requires column 'pixelIndex'")
-
-  if (is.null(masterRaster)) stop("masterRaster not found")
-  masterRaster <- terra::unwrap(terra::rast(masterRaster))
-
-  # Calculate total carbon for each pixel
-  if (!identical(names(pools), c("pixelIndex", "totalCarbon"))){
-
-    if (!is.data.table(pools)) pools <- as.data.table(pools)
-    pools <- pools[, .(
-      pixelIndex,
-      totalCarbon = rowSums(pools[, .(
-        Merch, Foliage, Other, CoarseRoots, FineRoots,
-        AboveGroundVeryFastSoil, BelowGroundVeryFastSoil, AboveGroundFastSoil,
-        BelowGroundFastSoil, MediumSoil, AboveGroundSlowSoil, BelowGroundSlowSoil,
-        StemSnag, BranchSnag
-      )])
-    )][, lapply(.SD, sum), by = "pixelIndex"]
-  }
-
-  # Plot
-  plotTitle <- "Total Carbon"
-  if (!is.null(year)) plotTitle <- paste(plotTitle, "in", year)
+mapTotalCarbon <- function(rastTC, year = NULL){
 
   withr::local_envvar(tidyterra.quiet = TRUE)
 
-  plotRast <- terra::rast(
-    res  = 1,
-    xmin = 0, xmax = terra::ncol(masterRaster),
-    ymin = 0, ymax = terra::nrow(masterRaster)
-  )
-  terra::set.values(plotRast, pools$pixelIndex, round(pools$totalCarbon))
+  plotTitle <- "Total Carbon"
+  if (!is.null(year)) plotTitle <- paste(plotTitle, "in", year)
 
   ggplot() +
-    tidyterra::geom_spatraster(data = plotRast) +
+    tidyterra::geom_spatraster(data = rastTC) +
     coord_sf() +
     theme_no_axes() +
     scale_x_continuous(expand = c(0, 0)) +
@@ -65,7 +35,7 @@ mapTotalCarbon <- function(pools, masterRaster, year = NULL){
       low = "#D73027",       # red for low
       mid = "#FEE08B",       # yellow for middle
       high = "#1A9850",      # green for high
-      midpoint = mean(pools$totalCarbon, na.rm = TRUE),
+      midpoint = terra::global(rastTC, "mean", na.rm = TRUE)[[1]],
       na.value = "transparent",
       guide = "colorbar"
     ) +
@@ -76,21 +46,51 @@ mapTotalCarbon <- function(pools, masterRaster, year = NULL){
 
 #' `simMapTotalCarbon`
 #'
+#' @template simCBM
+#' @param year numeric. Year of simulation results. Defaults to the current simulation year.
 #' @inheritParams simCBMdbReadSummary
 #' @inherit mapTotalCarbon description return
 #' @export
-simMapTotalCarbon <- function(simCBM, year, useCache = TRUE){
+simMapTotalCarbon <- function(simCBM, year = NULL, useCache = TRUE){
 
-  if (missing(year)){
+  if (is.null(year)){
     year <- SpaDES.core::convertTimeunit(SpaDES.core::times(simCBM)$current, "year")
   }
 
-  mapTotalCarbon(
-    simCBMdbReadSummary(
-      simCBM, "totalCarbon", units = "t/ha", by = "pixelIndex",
-      year = year, useCache = useCache),
-    year = year,
-    masterRaster = simCBM$masterRaster
+  spadesCBMdbMapTotalCarbon(
+    simCBM$spadesCBMdb,
+    masterRaster = simCBM$masterRaster,
+    year         = year,
+    useCache     = useCache
   )
 }
 
+
+#' spadesCBMdb `simMapTotalCarbon`
+#'
+#' @inheritParams spadesCBMdbReadSummary
+#' @template masterRaster
+#' @param year numeric. Year of simulation results.
+#' @inherit mapTotalCarbon description return
+#' @export
+spadesCBMdbMapTotalCarbon <- function(spadesCBMdb, masterRaster, year, useCache = TRUE){
+
+  tblTC <- spadesCBMdbReadSummary(
+    spadesCBMdb, "totalCarbon", units = "t/ha", by = "pixelIndex",
+    year = year, useCache = useCache)
+
+  rastTC <- terra::rast(
+    res  = 1,
+    xmin = 0, xmax = terra::ncol(masterRaster),
+    ymin = 0, ymax = terra::nrow(masterRaster)
+  )
+  terra::set.values(rastTC, tblTC$pixelIndex, tblTC$totalCarbon)
+
+  rm(tblTC)
+
+  mapTotalCarbon(rastTC, year = year)
+}
+
+
+
+

R/CBM-plots_plotEmissionsProducts.R

@@ -43,32 +43,56 @@ plotEmissionsProducts <- function(emissionsProducts) {
 
 #' `simPlotEmissionsProducts`
 #'
-#' @inheritParams simCBMdbReadSummary
+#' @template simCBM
+#' @param years numeric. Simulation years to include in plot. Defaults to all simulation years.
+#' @inheritParams spadesCBMdbReadSummary
 #' @inherit plotEmissionsProducts description return
 #' @export
 simPlotEmissionsProducts <- function(simCBM, years = NULL, useCache = TRUE){
 
   if ("emissionsProducts" %in% names(simCBM)){
     emissionsProducts <- simCBM$emissionsProducts
+    if (!is.null(years)) emissionsProducts <- subset(emissionsProducts, year %in% years)
+    plotEmissionsProducts(emissionsProducts)
 
   }else{
 
-    emissionsProducts <- merge(
-      simCBMdbReadSummary(
-        simCBM, "products", by = "year", units = "t",
-        years = if (!is.null(years)) min(years):max(years), useCache = useCache),
-      simCBMdbReadSummary(
-        simCBM, "emissions", by = "year", units = "t",
-        years = if (!is.null(years)) min(years):max(years), useCache = useCache),
-      by = "year", all = TRUE)
-
-    # Summarize yearly (non-cumulative) products
-    for (i in setdiff(1:nrow(emissionsProducts), 1)){
-      emissionsProducts$Products[[i]] <- emissionsProducts$Products[[i]] - sum(emissionsProducts$Products[1:(i - 1)])
-    }
+    if (is.null(years)) years <- SpaDES.core::start(simCBM):SpaDES.core::end(simCBM)
+
+    spadesCBMdbPlotEmissionsProducts(
+      simCBM$spadesCBMdb,
+      years    = years,
+      useCache = useCache
+    )
+  }
+}
+
+
+#' spadesCBMdb `plotEmissionsProducts`
+#'
+#' @inheritParams spadesCBMdbReadSummary
+#' @param years numeric. Simulation years to include in plot.
+#' @inherit plotEmissionsProducts description return
+#' @export
+spadesCBMdbPlotEmissionsProducts <- function(spadesCBMdb, years, useCache = TRUE){
+
+  emissionsProducts <- merge(
+    spadesCBMdbReadSummary(
+      spadesCBMdb, "products", by = "year", units = "t",
+      years = min(years):max(years), useCache = useCache),
+    spadesCBMdbReadSummary(
+      spadesCBMdb, "emissions", by = "year", units = "t",
+      years = min(years):max(years), useCache = useCache),
+    by = "year", all = TRUE)
+
+  # Summarize yearly (non-cumulative) products
+  for (i in setdiff(1:nrow(emissionsProducts), 1)){
+    emissionsProducts$Products[[i]] <- emissionsProducts$Products[[i]] - sum(emissionsProducts$Products[1:(i - 1)])
   }
+  emissionsProducts <- subset(emissionsProducts, year %in% years)
 
-  if (!is.null(years)) emissionsProducts <- subset(emissionsProducts, year %in% years)
   plotEmissionsProducts(emissionsProducts)
 }
 
+
+

R/CBM-plots_plotPoolProportions.R

@@ -72,15 +72,38 @@ plotPoolProportions <- function(pools){
 
 #' `simPlotPoolProportions`
 #'
-#' @inheritParams simCBMdbReadSummary
+#' @template simCBM
 #' @param years numeric. Simulation years to include in plot. Defaults to all simulation years.
+#' @inheritParams spadesCBMdbReadSummary
 #' @inherit plotPoolProportions description return
 #' @export
 simPlotPoolProportions <- function(simCBM, years = NULL, useCache = TRUE){
 
+  if (is.null(years)) years <- c(0, SpaDES.core::start(simCBM):SpaDES.core::end(simCBM))
+
+  spadesCBMdbPlotPoolProportions(
+    simCBM$spadesCBMdb,
+    years    = years,
+    useCache = useCache
+  )
+}
+
+
+#' spadesCBMdb `simPlotPoolProportions`
+#'
+#' @inheritParams spadesCBMdbReadSummary
+#' @param years numeric. Simulation years to include in plot.
+#' @inherit plotPoolProportions description return
+#' @export
+spadesCBMdbPlotPoolProportions <- function(spadesCBMdb, years, useCache = TRUE){
+
   plotPoolProportions(
-    simCBMdbReadSummary(
-      simCBM, "poolTypes", units = "t/ha", by = "year",
-      years = years, useCache = useCache)
+    spadesCBMdbReadSummary(
+      spadesCBMdb, "poolTypes", units = "t/ha", by = "year",
+      years = years,
+      useCache = useCache)
   )
 }
+
+
+