Skip to content
Permalink
Browse files

`defineModule` better handles `NA` values (closes #138)

* also checks/enforces types
* added corresponding unit tests (#139)
  • Loading branch information...
achubaty committed Jun 11, 2015
1 parent 64a24fc commit 17b41a14f58715cdd0d0d5e944906d2fa5679354
Showing with 142 additions and 2 deletions.
  1. +1 −0 NEWS
  2. +1 −1 R/module-dependencies-methods.R
  3. +40 −0 R/simList.R
  4. +1 −1 man/spadesEnv.Rd
  5. +99 −0 tests/testthat/test-module-deps-methods.R
1 NEWS
@@ -25,6 +25,7 @@ version 1.0.0
* improved `loadPackages`
* improved `.objectNames`
* `defineParameter` now accepts `min` and `max` values (#172)
* `defineModule` better handles `NA` values (#138)
* `Plot` improvements
* improvements to `loadFiles`:

@@ -1,5 +1,5 @@
### deal with spurious data.table warnings
if(getRversion() >= "3.1.0") {
if (getRversion() >= "3.1.0") {
utils::globalVariables(c(".", "module.x", "module.y", "from", "to", "name",
"objectName", "objectClass", "other", "module",
"i.objectClass", "i.module"))
@@ -1348,6 +1348,7 @@ setMethod(".simReqdPkgs",
#'
#' @return Updated \code{simList} object.
#'
#' @importFrom raster extent
#' @export
#' @docType methods
#' @rdname defineModule
@@ -1369,6 +1370,45 @@ setMethod("defineModule",
signature(sim="simList", x="list"),
definition=function(sim, x) {
loadPackages(x$reqdPkgs)

## enforce/coerce types for the user-supplied param list
x$name <- as.character(x$name)
x$description <- as.character(x$description)
x$keywords <- as.character(x$keywords)
if (!is(x$authors, "person")) {
stop("invalid module definition: ", x$name,
": authors must be a `person` class.")
}
if (is.character(x$version) || is.numeric(x$version)) {
x$version <- as.numeric_version(x$version)
}
if (!is(x$spatialExtent, "Extent")) {
if (is.na(x$spatialExtent)) {
x$spatialExtent <- raster::extent(rep(NA_real_, 4))
}
}
if (any(is.na(x$timeframe))) {
x$timeframe <- as.POSIXlt(c(NA, NA))
}
if (is.na(x$timestep)) {
x$timestep <- NA_real_
}
x$reqdPkgs <- as.list(x$reqdPkgs)
x$citation <- as.list(x$citation)
if (!is(x$parameters, "data.frame")) {
stop("invalid module definition: ", x$name,
": parameters must be a `data.frame`.")
}
if (!is(x$inputObjects, "data.frame")) {
stop("invalid module definition: ", x$name,
": inputObjects must be a `data.frame`.")
}
if (!is(x$outputObjects, "data.frame")) {
stop("invalid module definition: ", x$name,
": outputObjects must be a `data.frame`.")
}

## create module deps object and add to sim deps
m <- do.call(new, c(".moduleDeps", x))
return(.addSimDepends(sim, m))
})
@@ -4,7 +4,7 @@
\name{.spadesEnv}
\alias{.spadesEnv}
\title{The SpaDES environment}
\format{\preformatted{<environment: 0x7f84fcc714d0>
\format{\preformatted{<environment: 0x7fb5d3f36320>
}}
\usage{
.spadesEnv
@@ -1,3 +1,102 @@
test_that("defineModule correctly handles different inputs", {
tmp <- simInit()

x1 <- list(
name="testModule",
description="this is a test.",
keywords=c("test"),
authors=c(person(c("Alex", "M"), "Chubaty", email="achubaty@nrcan.gc.ca", role=c("aut", "cre"))),
version=numeric_version("0.0.1"),
spatialExtent=raster::extent(rep(NA_real_, 4)),
timeframe=as.POSIXlt(c(NA, NA)),
timestep=NA_real_,
citation=list(),
reqdPkgs=list("grid", "raster", "sp"),
parameters=rbind(defineParameter("dummyVal", "numeric", 1.0, NA, NA)),
inputObjects=data.frame(objectName="testInput",
objectClass="list",
other=NA_character_,
stringsAsFactors=FALSE),
outputObjects=data.frame(objectName="testOutput",
objectClass="list",
other=NA_character_,
stringsAsFactors=FALSE)
)

## check name
x2 <- x1
x2$name <- list("testModule") # not a character
expect_identical(defineModule(tmp, x1), defineModule(tmp, x2))

## check description
x2 <- x1
x2$description <- list("this is a test.") # not a character vector
expect_identical(defineModule(tmp, x1), defineModule(tmp, x2))

## check keywords
x2 <- x1
x2$keywords <- list("test") # not a character vector
expect_identical(defineModule(tmp, x1), defineModule(tmp, x2))

## check authors
x2 <- x1
x2$authors <- "not a person class"
expect_error(defineModule(tmp, x2), paste0("invalid module definition: ",
x2$name,
": authors must be a `person` class."))

## check version
x2 <- x1
x2$version <- "0.0.1"
expect_identical(defineModule(tmp, x1), defineModule(tmp, x2))

## check spatialExtent
x2 <- x1
x2$spatialExtent <- NA
expect_identical(defineModule(tmp, x1), defineModule(tmp, x2))

## check timeframe
x2 <- x1
x2$timeframe <- NA
expect_identical(defineModule(tmp, x1), defineModule(tmp, x2))

## check timestep
x2 <- x1
x2$timestep <- NA
expect_identical(defineModule(tmp, x1), defineModule(tmp, x2))

## check citation
x2 <- x1
x2$citation <- character() # not a list
expect_identical(defineModule(tmp, x1), defineModule(tmp, x2))

## check reqdPkgs
x2 <- x1
x2$reqdPkgs <- c("grid", "raster", "sp") # not a list
expect_identical(defineModule(tmp, x1), defineModule(tmp, x2))

## check parameters
x2 <- x1
x2$parameters <- "not a data.frame"
expect_error(defineModule(tmp, x2), paste0("invalid module definition: ",
x2$name,
": parameters must be a `data.frame`."))

## check inputObjects
x2 <- x1
x2$inputObjects <- "not a data.frame"
expect_error(defineModule(tmp, x2), paste0("invalid module definition: ",
x2$name,
": inputObjects must be a `data.frame`."))
## check authors
x2 <- x1
x2$outputObjects <- "not a person class"
expect_error(defineModule(tmp, x2), paste0("invalid module definition: ",
x2$name,
": outputObjects must be a `data.frame`."))
})


test_that("depsEdgeList and depsGraph work", {
times <- list(start=0.0, stop=10)
params <- list(.globals=list(burnStats="npixelsburned", stackName="landscape"),

0 comments on commit 17b41a1

Please sign in to comment.
You can’t perform that action at this time.