From 1f2a4325b160aa97cd751dfaf0da55dd7b34d474 Mon Sep 17 00:00:00 2001 From: Alex Chubaty Date: Tue, 30 Apr 2024 21:06:41 -0600 Subject: [PATCH] fix R CMD check issues --- DESCRIPTION | 4 +- NAMESPACE | 6 -- NEWS.md | 2 + R/plot_summaries.R | 10 +- R/rasterFireFunctions.R | 191 ++++++++++++++++++++------------------ R/stackAndExtract.R | 2 +- man/rasterFireBufferDT.Rd | 15 ++- 7 files changed, 117 insertions(+), 113 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index f6a6ed8..4d28a70 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,8 +2,8 @@ Package: fireSenseUtils Type: Package Title: Utilities for Working With the 'fireSense' Group of 'SpaDES' Modules Description: Utilities for working with the 'fireSense' group of 'SpaDES' modules. -Date: 2024-02-28 -Version: 0.0.5.9059 +Date: 2024-04-30 +Version: 0.0.5.9060 Authors@R: c( person("Jean", "Marchal", email = "jean.d.marchal@gmail.com", role = c("aut")), diff --git a/NAMESPACE b/NAMESPACE index 10e7a79..5bc50b4 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -121,12 +121,6 @@ importFrom(quickPlot,clearPlot) importFrom(quickPlot,dev) importFrom(quickPlot,gpar) importFrom(quickPlot,isRstudioServer) -importFrom(raster,calc) -importFrom(raster,crop) -importFrom(raster,mask) -importFrom(raster,maxValue) -importFrom(raster,raster) -importFrom(raster,stack) importFrom(reproducible,Cache) importFrom(reproducible,Checksums) importFrom(reproducible,checkPath) diff --git a/NEWS.md b/NEWS.md index c1c441b..f51a36b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,5 @@ +# fireSenseUtils (development version) + # Version 0.0.6 diff --git a/R/plot_summaries.R b/R/plot_summaries.R index ed755c9..6ee6e76 100644 --- a/R/plot_summaries.R +++ b/R/plot_summaries.R @@ -95,20 +95,20 @@ plotHistoricFires <- function(climateScenario, studyAreaName, outputDir, firePol #' #' @export #' @importFrom parallel mclapply -#' @importFrom raster calc crop mask maxValue raster stack plotCumulativeBurns <- function(studyAreaName, climateScenario, outputDir, Nreps, rasterToMatch) { if (requireNamespace("ggplot2", quietly = TRUE) && + requireNamespace("raster", quietly = TRUE) && requireNamespace("rasterVis", quietly = TRUE) && requireNamespace("RColorBrewer", quietly = TRUE)) { burnMapAllReps <- parallel::mclapply(1:Nreps, function(rep) { runName <- sprintf("%s_%s", studyAreaName, climateScenario) resultsDir <- file.path(outputDir, runName, sprintf("rep%02d", rep)) - burnMap <- raster(file.path(resultsDir, "burnMap_2100_year2100.tif")) + burnMap <- raster::raster(file.path(resultsDir, "burnMap_2100_year2100.tif")) }) - cumulBurnMap <- calc(stack(burnMapAllReps), fun = sum) / Nreps - cumulBurnMap <- mask(crop(cumulBurnMap, rasterToMatch), rasterToMatch) + cumulBurnMap <- raster::calc(raster::stack(burnMapAllReps), fun = sum) / Nreps + cumulBurnMap <- raster::mask(raster::crop(cumulBurnMap, rasterToMatch), rasterToMatch) myPal <- RColorBrewer::brewer.pal("Reds", n = Nreps + 1) ## include 0 ## TODO: max 9 cols! myTheme <- rasterVis::rasterTheme(region = myPal) @@ -119,7 +119,7 @@ plotCumulativeBurns <- function(studyAreaName, climateScenario, outputDir, Nreps fig <- rasterVis::levelplot(cumulBurnMap, margin = list(FUN = "mean"), ## median? main = paste0("Cumulative burn map 2011-2100 under ", climateScenario), colorkey = list( - at = seq(0, maxValue(cumulBurnMap), length.out = Nreps + 1), + at = seq(0, raster::maxValue(cumulBurnMap), length.out = Nreps + 1), space = "bottom", axis.line = list(col = "black"), width = 0.75 diff --git a/R/rasterFireFunctions.R b/R/rasterFireFunctions.R index b646834..ae1b44f 100644 --- a/R/rasterFireFunctions.R +++ b/R/rasterFireFunctions.R @@ -2,21 +2,30 @@ utils::globalVariables(c( "pixelID", "fireID", "ids", "id", ".N", "x", "y" )) -#' this is a wrapper to simplify caching of lapply with bufferForFireRaster. +#' this is a wrapper to simplify caching of `lapply` with `bufferForFireRaster`. #' Years are iteratively processed by `makeFireID`. +#' #' @param years numeric fire years +#' #' @param fireRaster a `SpatRaster` with values representing fire years +#' #' @template flammableRTM +#' #' @param bufferForFireRaster buffer size used to group discrete patches of burned pixels as -#' belonging to the same fire +#' belonging to the same fire +#' #' @param areaMultiplier A scalar that will buffer `areaMultiplier * fireSize` -#' @param verb Logical or numeric related to how much verbosity is printed. `FALSE` or -#' `0` is none. `TRUE` or `1` is some. `2` is much more. -#' @param minSize The absolute minimum size of the buffer & non-buffer together. This will -#' be imposed after `areaMultiplier`. +#' +#' @param verb Logical or numeric related to how much verbosity is printed. +#' `FALSE` or `0` is none. `TRUE` or `1` is some. `2` is much more. +#' +#' @param minSize The absolute minimum size of the buffer & non-buffer together. +#' This will be imposed after `areaMultiplier`. +#' #' @param cores number of processor cores to use -#' @return a list of data.table named by year, with cols `ids`, `buffer`, -#' and `pixelID` +#' +#' @return a list of `data.table`s named by year, with cols `ids`, `buffer`, and `pixelID` +#' #' @export #' @importFrom parallelly availableCores rasterFireBufferDT <- function(years, fireRaster, flammableRTM, bufferForFireRaster, areaMultiplier, @@ -95,99 +104,99 @@ makeFireIDs <- function(year, fireRaster, flammableRTM, bufferForFireRaster, are #' @importFrom terra buffer res values #' @importFrom SpaDES.tools spread bufferToAreaRast <- function(fireIDraster, areaMultiplier, minSize, flammableRTM, verb = 1) { + if (requireNamespace("raster", quietly = TRUE)) { + am <- if (is(areaMultiplier, "function")) { + areaMultiplier + } else { + function(x) areaMultiplier * x + } - am <- if (is(areaMultiplier, "function")) { - areaMultiplier - } else { - function(x) areaMultiplier * x - } + loci <- which(!is.na(fireIDraster[])) + ids <- as.integer(values(fireIDraster, data.frame = FALSE)[loci]) + initialDf <- data.table(loci, ids, id = seq(ids)) - ########## - loci <- which(!is.na(fireIDraster[])) - ids <- as.integer(values(fireIDraster, data.frame = FALSE)[loci]) - - initialDf <- data.table(loci, ids, id = seq(ids)) - - fireSize <- initialDf[, list( - actualSize = .N, - # simSize = .N,# needed for numIters - goalSize = asInteger(pmax(minSize, am(.N))) - ), by = "ids"] - - out <- list() - simSizes <- initialDf[, list(simSize = .N), by = "ids"] - simSizes <- fireSize[simSizes, on = "ids"] - spreadProb <- 1 - it <- 1L - maxIts <- 100L ## TODO: what's reasonable here??? - - temp <- fireIDraster - fireIDraster <- raster(fireIDraster) - emptyDT <- data.table(pixelID = integer(0), buffer = integer(0), ids = integer(0)) - - while ((length(loci) > 0) & (it <= maxIts)) { - dups <- duplicated(loci) - df <- data.table(loci = loci[!dups], ids = ids[!dups], id = seq_along(ids[!dups])) - r1 <- SpaDES.tools::spread(fireIDraster, - loci = df$loci, iterations = 1, - spreadProb = flammableRTM, quick = TRUE, - returnIndices = TRUE) - df <- df[r1, on = "id"] - simSizes <- df[, list(simSize = .N), by = "ids"] + fireSize <- initialDf[, list( + actualSize = .N, + # simSize = .N,# needed for numIters + goalSize = asInteger(pmax(minSize, am(.N))) + ), by = "ids"] + + out <- list() + simSizes <- initialDf[, list(simSize = .N), by = "ids"] simSizes <- fireSize[simSizes, on = "ids"] - bigger <- simSizes$simSize > simSizes$goalSize - - - if (any(bigger)) { - idsBigger <- simSizes$ids[bigger] - names(idsBigger) <- idsBigger - out1 <- lapply(idsBigger, function(idBig) { - wh <- which(df$ids %in% idBig) - if (as.integer(verb) >= 2) { - print(paste( - " Fire id:,", idBig, "finished. Num pixels in buffer:", - simSizes[ids == idBig]$goalSize - simSizes[ids == idBig]$actualSize, - ", in fire:", simSizes[ids == idBig]$actualSize - )) - } - lastIters <- !df[wh]$active - needMore <- simSizes[ids == idBig]$goalSize - sum(lastIters) - if (needMore > 0) { - dt <- try(rbindlist(list( - df[wh][lastIters], - df[wh][sample(which(df[wh]$active), needMore)] - ))) - } else { - dt <- df[wh][lastIters][sample(sum(lastIters), simSizes[ids == idBig]$goalSize)] + spreadProb <- 1 + it <- 1L + maxIts <- 100L ## TODO: what's reasonable here??? + + temp <- fireIDraster + fireIDraster <- raster::raster(fireIDraster) + emptyDT <- data.table(pixelID = integer(0), buffer = integer(0), ids = integer(0)) + + while ((length(loci) > 0) & (it <= maxIts)) { + dups <- duplicated(loci) + df <- data.table(loci = loci[!dups], ids = ids[!dups], id = seq_along(ids[!dups])) + r1 <- SpaDES.tools::spread(fireIDraster, + loci = df$loci, iterations = 1, + spreadProb = flammableRTM, quick = TRUE, + returnIndices = TRUE) + df <- df[r1, on = "id"] + simSizes <- df[, list(simSize = .N), by = "ids"] + simSizes <- fireSize[simSizes, on = "ids"] + bigger <- simSizes$simSize > simSizes$goalSize + + if (any(bigger)) { + idsBigger <- simSizes$ids[bigger] + names(idsBigger) <- idsBigger + out1 <- lapply(idsBigger, function(idBig) { + wh <- which(df$ids %in% idBig) + if (as.integer(verb) >= 2) { + print(paste( + " Fire id:,", idBig, "finished. Num pixels in buffer:", + simSizes[ids == idBig]$goalSize - simSizes[ids == idBig]$actualSize, + ", in fire:", simSizes[ids == idBig]$actualSize + )) + } + lastIters <- !df[wh]$active + needMore <- simSizes[ids == idBig]$goalSize - sum(lastIters) + if (needMore > 0) { + dt <- try(rbindlist(list( + df[wh][lastIters], + df[wh][sample(which(df[wh]$active), needMore)] + ))) + } else { + dt <- df[wh][lastIters][sample(sum(lastIters), simSizes[ids == idBig]$goalSize)] + } + if (is(dt, "try-error")) browser() # stop("try error here") + dtOut <- dt[, list(buffer = 0L, pixelID = indices, ids)] + + dtOut[dtOut$pixelID %in% initialDf$loci[initialDf$ids %in% idBig], buffer := 1L] + dtOut + }) + out <- append(out, out1) + } + if (any(!bigger)) { + if (!all(!bigger)) { + simSizes <- simSizes[simSize <= goalSize] + df <- df[df$ids %in% simSizes$ids] } - if (is(dt, "try-error")) browser() # stop("try error here") - dtOut <- dt[, list(buffer = 0L, pixelID = indices, ids)] - - dtOut[dtOut$pixelID %in% initialDf$loci[initialDf$ids %in% idBig], buffer := 1L] - dtOut - }) - out <- append(out, out1) - } - if (any(!bigger)) { - if (!all(!bigger)) { - simSizes <- simSizes[simSize <= goalSize] - df <- df[df$ids %in% simSizes$ids] + loci <- df$indices + ids <- df$ids + it <- it + 1L + } else { + loci <- integer(0) } - loci <- df$indices - ids <- df$ids - it <- it + 1L + } + out3 <- if (length(out) > 0) { + rbindlist(out) } else { - loci <- integer(0) + emptyDT } - } - out3 <- if (length(out) > 0) { - rbindlist(out) + + return(out3) } else { - emptyDT + stop("Suggested package 'raster' is required but not installed.") } - - return(out3) } #' create a list of annual ignition points based on fire raster diff --git a/R/stackAndExtract.R b/R/stackAndExtract.R index e25cafa..5d30458 100644 --- a/R/stackAndExtract.R +++ b/R/stackAndExtract.R @@ -15,7 +15,7 @@ utils::globalVariables(c( #' #' @export #' @importFrom data.table as.data.table data.table rbindlist setnames -#' @importFrom terra extract ncell rbindlist +#' @importFrom terra extract ncell rast values #' @importFrom sf %>% #' @importFrom stats na.omit stackAndExtract <- function(years, fuel, LCC, climate, fires) { diff --git a/man/rasterFireBufferDT.Rd b/man/rasterFireBufferDT.Rd index e4127b5..3857e9d 100644 --- a/man/rasterFireBufferDT.Rd +++ b/man/rasterFireBufferDT.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/rasterFireFunctions.R \name{rasterFireBufferDT} \alias{rasterFireBufferDT} -\title{this is a wrapper to simplify caching of lapply with bufferForFireRaster. +\title{this is a wrapper to simplify caching of \code{lapply} with \code{bufferForFireRaster}. Years are iteratively processed by \code{makeFireID}.} \usage{ rasterFireBufferDT( @@ -28,19 +28,18 @@ belonging to the same fire} \item{areaMultiplier}{A scalar that will buffer \code{areaMultiplier * fireSize}} -\item{minSize}{The absolute minimum size of the buffer & non-buffer together. This will -be imposed after \code{areaMultiplier}.} +\item{minSize}{The absolute minimum size of the buffer & non-buffer together. +This will be imposed after \code{areaMultiplier}.} -\item{verb}{Logical or numeric related to how much verbosity is printed. \code{FALSE} or -\code{0} is none. \code{TRUE} or \code{1} is some. \code{2} is much more.} +\item{verb}{Logical or numeric related to how much verbosity is printed. +\code{FALSE} or \code{0} is none. \code{TRUE} or \code{1} is some. \code{2} is much more.} \item{cores}{number of processor cores to use} } \value{ -a list of data.table named by year, with cols \code{ids}, \code{buffer}, -and \code{pixelID} +a list of \code{data.table}s named by year, with cols \code{ids}, \code{buffer}, and \code{pixelID} } \description{ -this is a wrapper to simplify caching of lapply with bufferForFireRaster. +this is a wrapper to simplify caching of \code{lapply} with \code{bufferForFireRaster}. Years are iteratively processed by \code{makeFireID}. }