From 40ab4b412b63b1990a71d6b921c9d640b741bdc3 Mon Sep 17 00:00:00 2001 From: Eliot McIntire Date: Fri, 7 Jun 2024 17:18:15 -0700 Subject: [PATCH 1/5] rm `globals(sim)` from sampleModules Bump --- DESCRIPTION | 2 +- NEWS.md | 3 ++- inst/sampleModules/fireSpread/fireSpread.R | 17 +++++++++-------- tests/testthat/test-simulation.R | 2 +- 4 files changed, 13 insertions(+), 11 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 40e546fb..ebbdf31b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -15,7 +15,7 @@ URL: https://spades-core.predictiveecology.org/, https://github.com/PredictiveEcology/SpaDES.core Date: 2024-06-07 -Version: 2.1.4 +Version: 2.1.5 Authors@R: c( person("Alex M", "Chubaty", , "achubaty@for-cast.ca", role = c("aut"), comment = c(ORCID = "0000-0001-7146-8135")), diff --git a/NEWS.md b/NEWS.md index 8e66a390..d32b7a4b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,7 +1,8 @@ -# SpaDES.core 2.1.3 +# SpaDES.core 2.1.5 * fix issue with Windows short paths in tests; * improved documentation; +* removal of `globals(sim)` in Sample modules # SpaDES.core 2.1.2 diff --git a/inst/sampleModules/fireSpread/fireSpread.R b/inst/sampleModules/fireSpread/fireSpread.R index 7343679f..5f8b1797 100644 --- a/inst/sampleModules/fireSpread/fireSpread.R +++ b/inst/sampleModules/fireSpread/fireSpread.R @@ -30,6 +30,7 @@ defineModule(sim, list( reqdPkgs = list("methods", "RColorBrewer", "SpaDES.tools (>= 2.0.0)", "terra"), parameters = rbind( defineParameter("stackName", "character", "landscape", NA, NA, "name of the RasterStack"), + defineParameter("burnStats", "character", "nPixelsBurned", NA, NA, "name of the burn statistics reported"), defineParameter("nFires", "numeric", 10L, 1L, 100L, "number of fires to initiate"), defineParameter("its", "numeric", 1e6, 1e6, 1e6, "number of iterations for fire spread"), defineParameter("persistprob", "numeric", 0.00, 0, 1, "probability of fire persisting in a pixel"), @@ -51,13 +52,13 @@ defineModule(sim, list( inputObjects = bindrows( expectsInput(objectName = SpaDES.core::P(sim, module = "fireSpread")$stackName, objectClass = "SpatRaster", desc = NA_character_, sourceURL = NA_character_), - expectsInput(objectName = SpaDES.core::globals(sim)$burnStats, objectClass = "numeric", + expectsInput(objectName = P(sim)$burnStats, objectClass = "numeric", desc = NA_character_, sourceURL = NA_character_) ), outputObjects = bindrows( - createsOutput(objectName = SpaDES.core::P(sim, module = "fireSpread")$stackName, + createsOutput(objectName = P(sim, module = "fireSpread")$stackName, objectClass = "SpatRaster", desc = NA_character_, other = NA_character_), - createsOutput(objectName = SpaDES.core::globals(sim)$burnStats, objectClass = "numeric", + createsOutput(objectName = P(sim)$burnStats, objectClass = "numeric", desc = NA_character_, other = NA_character_) ) )) @@ -72,10 +73,10 @@ doEvent.fireSpread <- function(sim, eventTime, eventType, debug = FALSE) { ### (use `checkObject` or similar) SpaDES.core::checkObject(sim, Par$stackName, layer = "habitatQuality") - if (is.null(sim[[SpaDES.core::globals(sim)$burnStats]])) { - sim[[SpaDES.core::globals(sim)$burnStats]] <- numeric() + if (is.null(sim[[P(sim)$burnStats]])) { + sim[[P(sim)$burnStats]] <- numeric() } else { - npix <- sim[[(SpaDES.core::globals(sim)$burnStats)]] + npix <- sim[[(P(sim)$burnStats)]] stopifnot("numeric" %in% is(npix), "vector" %in% is(npix)) } @@ -189,11 +190,11 @@ Burn <- function(sim) { } Stats <- function(sim) { - npix <- sim[[SpaDES.core::globals(sim)$burnStats]] + npix <- sim[[P(sim)$burnStats]] landscapes <- sim[[Par$stackName]] - sim[[SpaDES.core::globals(sim)$burnStats]] <- c(npix, length(which(values(landscapes$Fires) > 0))) + sim[[P(sim)$burnStats]] <- c(npix, length(which(values(landscapes$Fires) > 0))) return(invisible(sim)) } diff --git a/tests/testthat/test-simulation.R b/tests/testthat/test-simulation.R index a040f5b0..e229dbaf 100644 --- a/tests/testthat/test-simulation.R +++ b/tests/testthat/test-simulation.R @@ -6,7 +6,7 @@ test_that("simulation runs with simInit and spades with set.seed; events arg", { times <- list(start = 0.0, end = 1, timeunit = "year") params <- list( - .globals = list(burnStats = "npixelsburned", stackName = "landscape"), + # .globals = list(burnStats = "npixelsburned", stackName = "landscape"), randomLandscapes = list(.plotInitialTime = NA, .plotInterval = NA, .seed = list("init" = 321)), caribouMovement = list(.plotInitialTime = NA, .plotInterval = NA, torus = TRUE), fireSpread = list(.plotInitialTime = NA, .plotInterval = NA) From eb94939c303a6154770fc157873e753dc562329e Mon Sep 17 00:00:00 2001 From: Eliot McIntire Date: Fri, 7 Jun 2024 19:17:32 -0700 Subject: [PATCH 2/5] convertPackage bugfixe --- R/convertToPackage.R | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/R/convertToPackage.R b/R/convertToPackage.R index 3347948b..27a5d4ab 100644 --- a/R/convertToPackage.R +++ b/R/convertToPackage.R @@ -252,9 +252,6 @@ makeActiveBinding('Par', SpaDES.core:::activeParBindingFunction, ", missingSpace <- !grepl("[[:space:]]", inequality) if (any(missingSpace)) inequality[missingSpace] <- gsub("([=><]+)", "\\1 ", inequality[missingSpace]) - hasSC <- grepl("SpaDES.core", d$Imports) - if (all(!hasSC)) - d$Imports <- c("SpaDES.core", d$Imports) namespaceImports <- d$Imports # Create "import all" for each of the packages, unless it is already in an @importFrom @@ -273,6 +270,10 @@ makeActiveBinding('Par', SpaDES.core:::activeParBindingFunction, ", d$Imports[hasVersionNumb] <- paste(d$Imports[hasVersionNumb], inequality) + hasSC <- grepl("SpaDES.core", d$Imports) + if (all(!hasSC)) + d$Imports <- c("SpaDES.core", d$Imports) + dFile <- filenameFromFunction(packageFolderName, "DESCRIPTION", fileExt = "") cat(paste("Package:", d$Package), file = dFile, sep = "\n") From d0458a6f32f7a6f17c3191dcf63574f3161c7511 Mon Sep 17 00:00:00 2001 From: Eliot McIntire Date: Fri, 7 Jun 2024 19:25:23 -0700 Subject: [PATCH 3/5] Plot -- Don't plot and print when it is `terra::plot` or `plot` --- R/Plots.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/Plots.R b/R/Plots.R index c4f54fc4..453f7617 100644 --- a/R/Plots.R +++ b/R/Plots.R @@ -307,7 +307,8 @@ Plots <- function(data, fn, filename, names(ggListToScreen) <- gsub(names(ggListToScreen), pattern = " |(\\\n)|[[:punct:]]", replacement = "_") Plot(ggListToScreen, addTo = gg$labels$title) } else { - print(gg) + if (!(identical(fn, plot) || identical(fn, terra::plot))) + print(gg) } } } From 9e51f29f17b720299b73273c97b6263fc800a76e Mon Sep 17 00:00:00 2001 From: Eliot McIntire Date: Fri, 7 Jun 2024 19:40:01 -0700 Subject: [PATCH 4/5] test updates --- tests/testthat/test-module-deps-methods.R | 5 +++-- tests/testthat/test-simList.R | 2 +- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test-module-deps-methods.R b/tests/testthat/test-module-deps-methods.R index 20a943e4..d5206314 100644 --- a/tests/testthat/test-module-deps-methods.R +++ b/tests/testthat/test-module-deps-methods.R @@ -127,8 +127,9 @@ test_that("depsEdgeList and depsGraph work", { } , add = TRUE) } times <- list(start = 0.0, end = 10) + npb <- "nPixelsBurned" params <- list( - .globals = list(burnStats = "npixelsburned", stackName = "landscape"), + .globals = list(burnStats = npb, stackName = "landscape"), randomLandscapes = list(.plotInitialTime = NA, .plotInterval = NA), caribouMovement = list(.plotInitialTime = NA, .plotInterval = NA), fireSpread = list(.plotInitialTime = NA, .plotInterval = NA) @@ -147,7 +148,7 @@ test_that("depsEdgeList and depsGraph work", { "fireSpread", "fireSpread", "caribouMovement", "caribouMovement") el_objName <- c("landscape", "landscape", "landscape", - "npixelsburned", "landscape", + npb, "landscape", "caribou") el_objClass <- c("SpatRaster", "SpatRaster", "SpatRaster", "numeric", "SpatRaster", diff --git a/tests/testthat/test-simList.R b/tests/testthat/test-simList.R index c8cde333..7f39d68e 100644 --- a/tests/testthat/test-simList.R +++ b/tests/testthat/test-simList.R @@ -35,7 +35,7 @@ test_that("simList object initializes correctly (1)", { options(width = 100L) out <- utils::capture.output(show(mySim)) - expect_equal(length(out), 81) + expect_equal(length(out), 82) options(width = w) rm(w) From 54785c00ea09b6a313293f1d2b40e3bc4e1a371e Mon Sep 17 00:00:00 2001 From: Eliot McIntire Date: Fri, 7 Jun 2024 21:24:50 -0700 Subject: [PATCH 5/5] DESCRIPTIONfileFromModule --- R/convertToPackage.R | 177 +++++++++++++++++++++++++++++++------------ 1 file changed, 127 insertions(+), 50 deletions(-) diff --git a/R/convertToPackage.R b/R/convertToPackage.R index 27a5d4ab..6a08f23c 100644 --- a/R/convertToPackage.R +++ b/R/convertToPackage.R @@ -234,6 +234,126 @@ makeActiveBinding('Par', SpaDES.core:::activeParBindingFunction, ", # cat(format(aa[[whDefModule]]), file = mainModuleFile, sep = "\n") md <- aa[[whDefModule]][[3]] + deps <- unlist(eval(md$reqdPkgs)) + + + dFile <- DESCRIPTIONfileFromModule(module, md, deps, hasNamespaceFile, NAMESPACEFile, filePathImportSpadesCore, + packageFolderName) + # d <- list() + # d$Package <- .moduleNameNoUnderscore(module) + # d$Type <- "Package" + # + # d$Title <- md$name + # d$Description <- md$description + # d$Version <- as.character(eval(md$version[[2]])) + # d$Date <- Sys.Date() + # d$Authors <- md$authors + # d$Authors <- c(paste0(" ", format(d$Authors)[1]), format(d$Authors)[-1]) + # + # + # hasSC <- grepl("SpaDES.core", deps) + # if (all(!hasSC)) + # deps <- c("SpaDES.core", deps) + # + # d$Imports <- Require::extractPkgName(deps) + # versionNumb <- Require::extractVersionNumber(deps) + # hasVersionNumb <- !is.na(versionNumb) + # inequality <- paste0("(", gsub("(.+)\\((.+)\\)", "\\2", deps[hasVersionNumb]), ")") + # missingSpace <- !grepl("[[:space:]]", inequality) + # if (any(missingSpace)) + # inequality[missingSpace] <- gsub("([=><]+)", "\\1 ", inequality[missingSpace]) + # + # namespaceImports <- d$Imports + # # Create "import all" for each of the packages, unless it is already in an @importFrom + # if (hasNamespaceFile) { + # nsTxt <- readLines(NAMESPACEFile) + # hasImportFrom <- grepl("importFrom", nsTxt) + # if (any(hasImportFrom)) { + # pkgsNotNeeded <- unique(gsub(".+\\((.+)\\,.+\\)", "\\1", nsTxt[hasImportFrom])) + # namespaceImports <- grep(paste(pkgsNotNeeded, collapse = "|"), + # namespaceImports, invert = TRUE, value = TRUE) + # } + # } + # + # cat(paste0("#' @import ", namespaceImports, "\nNULL\n"), sep = "\n", + # file = filePathImportSpadesCore, fill = TRUE) + # + # d$Imports[hasVersionNumb] <- paste(d$Imports[hasVersionNumb], inequality) + # + # dFile <- filenameFromFunction(packageFolderName, "DESCRIPTION", fileExt = "") + # + # cat(paste("Package:", d$Package), file = dFile, sep = "\n") + # cat(paste("Type:", d$Type), file = dFile, sep = "\n", append = TRUE) + # cat(paste("Title:", d$Title), file = dFile, sep = "\n", append = TRUE) + # cat(paste("Version:", d$Version), file = dFile, sep = "\n", append = TRUE) + # cat(paste("Description:", paste(d$Description, collapse = " ")), file = dFile, sep = "\n", append = TRUE) + # cat(paste("Date:", d$Date), file = dFile, sep = "\n", append = TRUE) + # cat(c("Authors@R: ", format(d$Authors)), file = dFile, sep = "\n", append = TRUE) + # + # if (length(d$Imports)) + # cat(c("Imports:", paste(" ", d$Imports, collapse = ",\n")), sep = "\n", file = dFile, append = TRUE) + # + # Suggests <- c('knitr', 'rmarkdown') + # cat(c("Suggests:", paste(" ", Suggests, collapse = ",\n")), sep = "\n", file = dFile, append = TRUE) + # + # cat("Encoding: UTF-8", sep = "\n", file = dFile, append = TRUE) + # cat("License: GPL-3", sep = "\n", file = dFile, append = TRUE) + # cat("VignetteBuilder: knitr, rmarkdown", sep = "\n", file = dFile, append = TRUE) + # cat("ByteCompile: yes", sep = "\n", file = dFile, append = TRUE) + # cat("Roxygen: list(markdown = TRUE)", sep = "\n", file = dFile, append = TRUE) + # + # + # message("New/updated DESCRIPTION file is: ", dFile) + + if (isTRUE(buildDocuments)) { + message("Building documentation") + m <- packageFolderName + roxygen2::roxygenise(m, roclets = NULL) # This builds documentation, but also exports all functions ... + pkgload::dev_topic_index_reset(m) + pkgload::unload(.moduleNameNoUnderscore(basename2(m))) # so, unload here before reloading without exporting + } + + RBuildIgnoreFile <- filenameFromFunction(packageFolderName, "", fileExt = ".Rbuildignore") + cat("^.*\\.Rproj$ +^\\.Rproj\\.user$ +^_pkgdown\\.yml$ +.*\\.tar\\.gz$ +.*\\.toc$ +.*\\.zip$ +^\\.lintr$ +CONTRIBUTING\\.md +cran-comments\\.md +^docs$ +^LICENSE$ +vignettes/.*_cache$ +vignettes/.*\\.log$ +^\\.httr-oauth$ +^revdep$ +^\\.github$ +^codecov\\.yml$ +^CRAN-RELEASE$ +^data/* +^.git +^.gitignore +^.gitmodules + ", sep = "\n", + file = RBuildIgnoreFile, fill = TRUE) + + return(invisible()) +} + +filenameFromFunction <- function(packageFolderName, fn = "", subFolder = "", fileExt = ".R") { + normPath(file.path(packageFolderName, subFolder, paste0(gsub("\\.", "", fn), fileExt))) +} + +filenameForMainFunctions <- function(module, modulePath = ".") + normPath(file.path(modulePath, unlist(module), "R", paste0(unlist(basename(module)), "Fns.R"))) + + + + +DESCRIPTIONfileFromModule <- function(module, md, deps, hasNamespaceFile, NAMESPACEFile, filePathImportSpadesCore, + packageFolderName) { d <- list() d$Package <- .moduleNameNoUnderscore(module) d$Type <- "Package" @@ -244,7 +364,12 @@ makeActiveBinding('Par', SpaDES.core:::activeParBindingFunction, ", d$Date <- Sys.Date() d$Authors <- md$authors d$Authors <- c(paste0(" ", format(d$Authors)[1]), format(d$Authors)[-1]) - deps <- unlist(eval(md$reqdPkgs)) + + + hasSC <- grepl("SpaDES.core", deps) + if (all(!hasSC)) + deps <- c("SpaDES.core", deps) + d$Imports <- Require::extractPkgName(deps) versionNumb <- Require::extractVersionNumber(deps) hasVersionNumb <- !is.na(versionNumb) @@ -270,10 +395,6 @@ makeActiveBinding('Par', SpaDES.core:::activeParBindingFunction, ", d$Imports[hasVersionNumb] <- paste(d$Imports[hasVersionNumb], inequality) - hasSC <- grepl("SpaDES.core", d$Imports) - if (all(!hasSC)) - d$Imports <- c("SpaDES.core", d$Imports) - dFile <- filenameFromFunction(packageFolderName, "DESCRIPTION", fileExt = "") cat(paste("Package:", d$Package), file = dFile, sep = "\n") @@ -295,50 +416,6 @@ makeActiveBinding('Par', SpaDES.core:::activeParBindingFunction, ", cat("VignetteBuilder: knitr, rmarkdown", sep = "\n", file = dFile, append = TRUE) cat("ByteCompile: yes", sep = "\n", file = dFile, append = TRUE) cat("Roxygen: list(markdown = TRUE)", sep = "\n", file = dFile, append = TRUE) - - message("New/updated DESCRIPTION file is: ", dFile) - - if (isTRUE(buildDocuments)) { - message("Building documentation") - m <- packageFolderName - roxygen2::roxygenise(m, roclets = NULL) # This builds documentation, but also exports all functions ... - pkgload::dev_topic_index_reset(m) - pkgload::unload(.moduleNameNoUnderscore(basename2(m))) # so, unload here before reloading without exporting - } - - RBuildIgnoreFile <- filenameFromFunction(packageFolderName, "", fileExt = ".Rbuildignore") - cat("^.*\\.Rproj$ -^\\.Rproj\\.user$ -^_pkgdown\\.yml$ -.*\\.tar\\.gz$ -.*\\.toc$ -.*\\.zip$ -^\\.lintr$ -CONTRIBUTING\\.md -cran-comments\\.md -^docs$ -^LICENSE$ -vignettes/.*_cache$ -vignettes/.*\\.log$ -^\\.httr-oauth$ -^revdep$ -^\\.github$ -^codecov\\.yml$ -^CRAN-RELEASE$ -^data/* -^.git -^.gitignore -^.gitmodules - ", sep = "\n", - file = RBuildIgnoreFile, fill = TRUE) - - return(invisible()) -} - -filenameFromFunction <- function(packageFolderName, fn = "", subFolder = "", fileExt = ".R") { - normPath(file.path(packageFolderName, subFolder, paste0(gsub("\\.", "", fn), fileExt))) + return(dFile) } - -filenameForMainFunctions <- function(module, modulePath = ".") - normPath(file.path(modulePath, unlist(module), "R", paste0(unlist(basename(module)), "Fns.R")))