Skip to content

Commit

Permalink
Merge pull request #287 from PredictiveEcology/noGlobalsSimSampleMods
Browse files Browse the repository at this point in the history 
rm `globals(sim)` from sampleModules
  • Loading branch information
@eliotmcintire
eliotmcintire committed Jun 8, 2024
2 parents 58a3d19 + 54785c0 commit 362b749
Show file tree
Hide file tree
Showing 8 changed files with 146 additions and 64 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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")),
Expand Down
3 changes: 2 additions & 1 deletion NEWS.md
View file
Original file line number Diff line number Diff line change
@@ -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

Expand Down
3 changes: 2 additions & 1 deletion R/Plots.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
}
}
}
Expand Down
176 changes: 127 additions & 49 deletions R/convertToPackage.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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"
Expand All @@ -244,17 +364,19 @@ 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)
inequality <- paste0("(", gsub("(.+)\\((.+)\\)", "\\2", deps[hasVersionNumb]), ")")
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
Expand Down Expand Up @@ -294,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")))
17 changes: 9 additions & 8 deletions inst/sampleModules/fireSpread/fireSpread.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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"),
Expand All @@ -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_)
)
))
Expand All @@ -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))
}

Expand Down Expand Up @@ -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))
}
5 changes: 3 additions & 2 deletions tests/testthat/test-module-deps-methods.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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",
Expand Down
2 changes: 1 addition & 1 deletion tests/testthat/test-simList.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand Down
2 changes: 1 addition & 1 deletion tests/testthat/test-simulation.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down

0 comments on commit 362b749

Please sign in to comment.