diff --git a/NAMESPACE b/NAMESPACE index 89820ae13..121809359 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -125,7 +125,9 @@ export(modulePath) export(modules) export(move) export(newModule) +export(newModuleCode) export(newModuleDocumentation) +export(newModuleTests) export(newPlot) export(newProgressBar) export(normPath) @@ -241,7 +243,9 @@ exportMethods(moduleDiagram) exportMethods(moduleMetadata) exportMethods(modulePath) exportMethods(newModule) +exportMethods(newModuleCode) exportMethods(newModuleDocumentation) +exportMethods(newModuleTests) exportMethods(nlayers) exportMethods(normPath) exportMethods(objectDiagram) diff --git a/R/module-template.R b/R/module-template.R index d291647cd..29d6d6e32 100644 --- a/R/module-template.R +++ b/R/module-template.R @@ -56,261 +56,20 @@ setMethod( unitTests = "logical"), definition = function(name, path, open, unitTests) { path <- checkPath(path, create = TRUE) - nestedPath <- file.path(path, name) - dataPath <- file.path(nestedPath, "data") - checkPath(nestedPath, create = TRUE) - checkPath(dataPath, create = TRUE) + nestedPath <- file.path(path, name) %>% checkPath(create = TRUE) + dataPath <- file.path(nestedPath, "data") %>% checkPath(create = TRUE) # empty data checksum file cat("", file = file.path(dataPath, "CHECKSUMS.txt")) - # module code - filenameR <- file.path(nestedPath, paste0(name, ".R")) - - cat(" - # Everything in this file gets sourced during simInit, and all functions and objects - # are put into the simList. To use objects and functions, use sim$xxx. - defineModule(sim, list( - name = \"", name, "\", - description = \"insert module description here\", - keywords = c(\"insert key words here\"), - authors = c(person(c(\"First\", \"Middle\"), \"Last\", email=\"email@example.com\", role=c(\"aut\", \"cre\"))), - childModules = character(), - version = numeric_version(\"0.0.0\"), - spatialExtent = raster::extent(rep(NA_real_, 4)), - timeframe = as.POSIXlt(c(NA, NA)), - timeunit = NA_character_, # e.g., \"year,\", - citation = list(\"citation.bib\"), - documentation = list(\"README.txt\", \"", name, ".Rmd\"), - reqdPkgs = list(), - parameters = rbind( - #defineParameter(\"paramName\", \"paramClass\", value, min, max, \"parameter description\")), - defineParameter(\".plotInitialTime\", \"numeric\", NA, NA, NA, \"This describes the simulation time at which the first plot event should occur\"), - defineParameter(\".plotInterval\", \"numeric\", NA, NA, NA, \"This describes the simulation time at which the first plot event should occur\"), - defineParameter(\".saveInitialTime\", \"numeric\", NA, NA, NA, \"This describes the simulation time at which the first save event should occur\"), - defineParameter(\".saveInterval\", \"numeric\", NA, NA, NA, \"This describes the simulation time at which the first save event should occur\") - ), - inputObjects = data.frame( - objectName = NA_character_, - objectClass = NA_character_, - sourceURL = \"\", - other = NA_character_, - stringsAsFactors = FALSE - ), - outputObjects = data.frame( - objectName = NA_character_, - objectClass = NA_character_, - other = NA_character_, - stringsAsFactors = FALSE - ) - )) - - ## event types - # - type `init` is required for initiliazation - - doEvent.", name, " = function(sim, eventTime, eventType, debug = FALSE) { - if (eventType == \"init\") { - ### check for more detailed object dependencies: - ### (use `checkObject` or similar) - - # do stuff for this event - sim <- sim$", name, "Init(sim) - - # schedule future event(s) - sim <- scheduleEvent(sim, params(sim)$", name, "$.plotInitialTime, \"", name, "\", \"plot\") - sim <- scheduleEvent(sim, params(sim)$", name, "$.saveInitialTime, \"", name, "\", \"save\") - } else if (eventType == \"plot\") { - # ! ----- EDIT BELOW ----- ! # - # do stuff for this event - - #Plot(objectFromModule) # uncomment this, replace with object to plot - # schedule future event(s) - - # e.g., - #sim <- scheduleEvent(sim, params(sim)$", name, "$.plotInitialTime, \"", name, "\", \"plot\") - - # ! ----- STOP EDITING ----- ! # - } else if (eventType == \"save\") { - # ! ----- EDIT BELOW ----- ! # - # do stuff for this event - - # e.g., call your custom functions/methods here - # you can define your own methods below this `doEvent` function - - # schedule future event(s) - - # e.g., - # sim <- scheduleEvent(sim, time(sim) + increment, \"", name, "\", \"save\") - - # ! ----- STOP EDITING ----- ! # - } else if (eventType == \"event1\") { - # ! ----- EDIT BELOW ----- ! # - # do stuff for this event - - # e.g., call your custom functions/methods here - # you can define your own methods below this `doEvent` function - - # schedule future event(s) - - # e.g., - # sim <- scheduleEvent(sim, time(sim) + increment, \"", name, "\", \"templateEvent\") - - # ! ----- STOP EDITING ----- ! # - } else if (eventType == \"event2\") { - # ! ----- EDIT BELOW ----- ! # - # do stuff for this event - - # e.g., call your custom functions/methods here - # you can define your own methods below this `doEvent` function - - # schedule future event(s) - - # e.g., - # sim <- scheduleEvent(sim, time(sim) + increment, \"", name, "\", \"templateEvent\") - - # ! ----- STOP EDITING ----- ! # - } else { - warning(paste(\"Undefined event type: \'\", events(sim)[1, \"eventType\", with = FALSE], - \"\' in module \'\", events(sim)[1, \"moduleName\", with = FALSE], \"\'\", sep = \"\")) - } - return(invisible(sim)) - } - - ## event functions - # - follow the naming convention `modulenameEventtype()`; - # - `modulenameInit()` function is required for initiliazation; - # - keep event functions short and clean, modularize by calling subroutines from section below. - - ### template initilization - ", name, "Init <- function(sim) { - - # # ! ----- EDIT BELOW ----- ! # - - - - # ! ----- STOP EDITING ----- ! # - - return(invisible(sim)) - } - - ### template for save events - ", name, "Save <- function(sim) { - # ! ----- EDIT BELOW ----- ! # - # do stuff for this event - sim <- saveFiles(sim) - - # ! ----- STOP EDITING ----- ! # - return(invisible(sim)) - } - - ### template for plot events - ", name, "Plot <- function(sim) { - # ! ----- EDIT BELOW ----- ! # - # do stuff for this event - #Plot(\"object\") - - # ! ----- STOP EDITING ----- ! # - return(invisible(sim)) - } - - ### template for your event1 - ", name, "Event1 <- function(sim) { - # ! ----- EDIT BELOW ----- ! # - - - - # ! ----- STOP EDITING ----- ! # - return(invisible(sim)) - } - - ### template for your event2 - ", name, "Event2 = function(sim) { - # ! ----- EDIT BELOW ----- ! # - + # module code file + newModuleCode(name = name, path = path, open = open) - - # ! ----- STOP EDITING ----- ! # - return(invisible(sim)) - } - - ### add additional events as needed by copy/pasting from above\n", - file = filenameR, fill = FALSE, sep = "") - if (open) { - # use tryCatch: Rstudio bug causes file open to fail on Windows (#209) - tryCatch(file.edit(filenameR), error = function(e) { - warning("A bug in RStudio for Windows prevented the opening of the file:\n", - filenameR, "\nPlease open it manually.") - }) - } - if (unitTests){ - # create another folder which will store the specific tests - checkPath(file.path(nestedPath, "tests"), create = TRUE) - checkPath(file.path(nestedPath, "tests", "testthat"), create = TRUE) - # create two R files in unit tests folder - # the first one is named as unitTests.R, source this file will triger - # all unit tests that are contained in tests folder - unitTestsR <- file.path(nestedPath, "tests/unitTests.R") - cat("# Please build your own test file from test-Template.R, and place it in tests folder \n\n", - "# please specify the package you need to run the sim function in the test files. \n", - "test_dir(\"", - file.path(nestedPath, "tests\")", sep=""), "\n", - "# the above line is used to test all the test files in the tests folder. \n\n", - "# Alternative, you can use test_file to test individual test file, e.g., \n", - "test_file(\"", - file.path(nestedPath, "tests", "testthat", "test-DryRun.R\")", sep=""), "\n", - file = unitTestsR, fill = FALSE, sep = "") - testTemplate <- file.path(nestedPath, "tests", "testthat", "test-DryRun.R") - - cat("# please do three things when this template is corrected modified. - # 1. rename this file based on the content you are testing, e.g., test-treeGrowthFunction.R - # 2. copy this file to tests folder, i.e.,", file.path(nestedPath, "tests", sep = ""),"\n", - " # 3. modify the test description, i.e., test tree growth function, based on the content you are testing \n", - "test_that(\"test tree growth function\", { \n", - " module <- list(\"", name, "\") \n", - " path <- list(modulePath = \"", path, "\", outputPath = \"~/output\") \n", - " parameters <- list( # .progress = list(type = \"graphical\", interval = 1), - .globals = list(verbose = FALSE), - ", name ," = list(.saveInitialTime = NA)) \n", - " times = list(start = 0, end = 1) \n", - " # If your test function contains time(sim), you can test the function at a particular simulation time by define start time above. \n\n", - " object1 <- \"object1\" # please specify \n", - " object2 <- \"object2\" # please specify \n", - " objects <- list(\"object1\" = object1, \"object2\" = object2) \n\n", - " mySim <- simInit(times = times, - params = parameters, - modules = module, - objects = objects, - paths = path) \n\n", - " # You may need to set seed if your module or the function has the random number generator. \n", - " set.seed(1234) \n\n", - " # You have two strategies to test your module: \n", - " # 1. test the overall simulation results for the given objects, then, use the code below: \n", - " output <- spades(mySim, debug = FALSE) \n\n", - " # is output a simList \n", - " expect_is(output, \"simList\") \n", - " # does output have your module in it \n", - " expect_true(any(unlist(modules(output)) %in% \n", - " c(unlist(module)))) \n", - " # did it simulate to the end \n", - " expect_true(time(output) == 1) \n", - " # 2. test the function inside of the module, then, use the line below: \n", - " # To allow the moduleCoverage function to calculate unit test coverage \n", - " # level, it needs access to all functions directly. Use this approach \n", - " # to when using any function within the simList object, i.e., one \n", - " # version as a direct call, and one with simList prepended \n", - " output <- try(treeGrowthFunction(mySim, otherArguments)) \n", - " if(is(output,\"try-error\")){ \n", - " output <- mySim$treeGrowthFunction(mySim, otherArguments)} \n", - " # treeGrowthFunction is the function you would like to test, please specify your function name \n", - " # otherArguments is the arguments needed for running the function. \n\n", - " # output_expected <- # please define your expection of your output. \n", - " # expect_equal(output,output_expected) # or other expect function in testthat package. \n", - "})", file = testTemplate, fill = FALSE, sep = "") - } + if (unitTests) { newModuleTests(name = name, path = path, open = open) } ### Make Rmarkdown file for module documentation newModuleDocumentation(name = name, path = path, open = open) - }) +}) #' @export #' @rdname newModule @@ -320,7 +79,7 @@ setMethod( unitTests = "logical"), definition = function(name, open, unitTests) { newModule(name = name, path = ".", open = open, unitTests = unitTests) - }) +}) #' @export #' @rdname newModule @@ -330,7 +89,7 @@ setMethod( unitTests = "logical"), definition = function(name, path, unitTests) { newModule(name = name, path = path, open = TRUE, unitTests = unitTests) - }) +}) #' @export #' @rdname newModule @@ -340,7 +99,7 @@ setMethod( unitTests = "logical"), definition = function(name, unitTests) { newModule(name = name, path = ".", open = TRUE, unitTests = unitTests) - }) +}) #' @export #' @rdname newModule @@ -350,7 +109,7 @@ setMethod( unitTests = "missing"), definition = function(name, path, open) { newModule(name = name, path = path, open = open, unitTests = TRUE) - }) +}) #' @export #' @rdname newModule @@ -360,7 +119,7 @@ setMethod( unitTests = "missing"), definition = function(name, open) { newModule(name = name, path = ".", open = open, unitTests = TRUE) - }) +}) #' @export #' @rdname newModule @@ -370,7 +129,7 @@ setMethod( unitTests = "missing"), definition = function(name, path) { newModule(name = name, path = path, open = TRUE, unitTests = TRUE) - }) +}) #' @export #' @rdname newModule @@ -380,9 +139,204 @@ setMethod( unitTests = "missing"), definition = function(name) { newModule(name = name, path = ".", open = TRUE, unitTests = TRUE) - }) +}) + +################################################################################ +#' @export +#' @docType methods +#' @rdname newModule +# @importFrom utils file.edit +#' @author Eliot McIntire and Alex Chubaty +#' +setGeneric("newModuleCode", function(name, path, open) { + standardGeneric("newModuleCode") +}) + +#' @export +#' @rdname newModule +setMethod( + "newModuleCode", + signature = c(name = "character", path = "character", open = "logical"), + definition = function(name, path, open) { + path <- checkPath(path, create = TRUE) + nestedPath <- file.path(path, name) %>% checkPath(create = TRUE) + filenameR <- file.path(nestedPath, paste0(name, ".R")) + cat(" +# Everything in this file gets sourced during simInit, and all functions and objects +# are put into the simList. To use objects and functions, use sim$xxx. +defineModule(sim, list( + name = \"", name, "\", + description = \"insert module description here\", + keywords = c(\"insert key words here\"), + authors = c(person(c(\"First\", \"Middle\"), \"Last\", email=\"email@example.com\", role=c(\"aut\", \"cre\"))), + childModules = character(), + version = numeric_version(\"0.0.0\"), + spatialExtent = raster::extent(rep(NA_real_, 4)), + timeframe = as.POSIXlt(c(NA, NA)), + timeunit = NA_character_, # e.g., \"year,\", + citation = list(\"citation.bib\"), + documentation = list(\"README.txt\", \"", name, ".Rmd\"), + reqdPkgs = list(), + parameters = rbind( + #defineParameter(\"paramName\", \"paramClass\", value, min, max, \"parameter description\")), + defineParameter(\".plotInitialTime\", \"numeric\", NA, NA, NA, \"This describes the simulation time at which the first plot event should occur\"), + defineParameter(\".plotInterval\", \"numeric\", NA, NA, NA, \"This describes the simulation time at which the first plot event should occur\"), + defineParameter(\".saveInitialTime\", \"numeric\", NA, NA, NA, \"This describes the simulation time at which the first save event should occur\"), + defineParameter(\".saveInterval\", \"numeric\", NA, NA, NA, \"This describes the simulation time at which the first save event should occur\") + ), + inputObjects = data.frame( + objectName = NA_character_, + objectClass = NA_character_, + sourceURL = \"\", + other = NA_character_, + stringsAsFactors = FALSE + ), + outputObjects = data.frame( + objectName = NA_character_, + objectClass = NA_character_, + other = NA_character_, + stringsAsFactors = FALSE + ) +)) + +## event types +# - type `init` is required for initialiazation + +doEvent.", name, " = function(sim, eventTime, eventType, debug = FALSE) { + if (eventType == \"init\") { + ### check for more detailed object dependencies: + ### (use `checkObject` or similar) + + # do stuff for this event + sim <- sim$", name, "Init(sim) + + # schedule future event(s) + sim <- scheduleEvent(sim, params(sim)$", name, "$.plotInitialTime, \"", name, "\", \"plot\") + sim <- scheduleEvent(sim, params(sim)$", name, "$.saveInitialTime, \"", name, "\", \"save\") + } else if (eventType == \"plot\") { + # ! ----- EDIT BELOW ----- ! # + # do stuff for this event + + #Plot(objectFromModule) # uncomment this, replace with object to plot + # schedule future event(s) + + # e.g., + #sim <- scheduleEvent(sim, params(sim)$", name, "$.plotInitialTime, \"", name, "\", \"plot\") + + # ! ----- STOP EDITING ----- ! # + } else if (eventType == \"save\") { + # ! ----- EDIT BELOW ----- ! # + # do stuff for this event + + # e.g., call your custom functions/methods here + # you can define your own methods below this `doEvent` function + + # schedule future event(s) + + # e.g., + # sim <- scheduleEvent(sim, time(sim) + increment, \"", name, "\", \"save\") + + # ! ----- STOP EDITING ----- ! # + } else if (eventType == \"event1\") { + # ! ----- EDIT BELOW ----- ! # + # do stuff for this event + + # e.g., call your custom functions/methods here + # you can define your own methods below this `doEvent` function + + # schedule future event(s) + + # e.g., + # sim <- scheduleEvent(sim, time(sim) + increment, \"", name, "\", \"templateEvent\") + + # ! ----- STOP EDITING ----- ! # + } else if (eventType == \"event2\") { + # ! ----- EDIT BELOW ----- ! # + # do stuff for this event + + # e.g., call your custom functions/methods here + # you can define your own methods below this `doEvent` function + + # schedule future event(s) + + # e.g., + # sim <- scheduleEvent(sim, time(sim) + increment, \"", name, "\", \"templateEvent\") + + # ! ----- STOP EDITING ----- ! # + } else { + warning(paste(\"Undefined event type: \'\", events(sim)[1, \"eventType\", with = FALSE], + \"\' in module \'\", events(sim)[1, \"moduleName\", with = FALSE], \"\'\", sep = \"\")) + } + return(invisible(sim)) +} + +## event functions +# - follow the naming convention `modulenameEventtype()`; +# - `modulenameInit()` function is required for initiliazation; +# - keep event functions short and clean, modularize by calling subroutines from section below. + +### template initialization +", name, "Init <- function(sim) { + # # ! ----- EDIT BELOW ----- ! # + + # ! ----- STOP EDITING ----- ! # + + return(invisible(sim)) +} + +### template for save events +", name, "Save <- function(sim) { + # ! ----- EDIT BELOW ----- ! # + # do stuff for this event + sim <- saveFiles(sim) + + # ! ----- STOP EDITING ----- ! # + return(invisible(sim)) +} + +### template for plot events +", name, "Plot <- function(sim) { + # ! ----- EDIT BELOW ----- ! # + # do stuff for this event + #Plot(\"object\") + + # ! ----- STOP EDITING ----- ! # + return(invisible(sim)) +} + +### template for your event1 +", name, "Event1 <- function(sim) { + # ! ----- EDIT BELOW ----- ! # + + + + # ! ----- STOP EDITING ----- ! # + return(invisible(sim)) +} + +### template for your event2 +", name, "Event2 = function(sim) { + # ! ----- EDIT BELOW ----- ! # + + + + # ! ----- STOP EDITING ----- ! # + return(invisible(sim)) +} + +### add additional events as needed by copy/pasting from above\n", + file = filenameR, fill = FALSE, sep = "") + + if (open) { + # use tryCatch: Rstudio bug causes file open to fail on Windows (#209) + tryCatch(file.edit(filenameR), error = function(e) { + warning("A bug in RStudio for Windows prevented the opening of the file:\n", + filenameR, "\nPlease open it manually.") + }) + } +}) -########################################################################### +################################################################################ #' @export #' @docType methods #' @rdname newModule @@ -400,8 +354,7 @@ setMethod( signature = c(name = "character", path = "character", open = "logical"), definition = function(name, path, open) { path <- checkPath(path, create = TRUE) - nestedPath <- file.path(path, name) - checkPath(nestedPath, create = TRUE) + nestedPath <- file.path(path, name) %>% checkPath(create = TRUE) filenameRmd <- file.path(nestedPath, paste0(name, ".Rmd")) filenameCitation <- file.path(nestedPath, "citation.bib") filenameLICENSE <- file.path(nestedPath, "LICENSE") @@ -409,121 +362,110 @@ setMethod( ### Make Rmarkdown file for module documentation cat( - "--- - title: \"", name, "\" - author: \"Module Author\" - date: \"", format(Sys.Date(), "%d %B %Y"), "\" - output: pdf_document - --- +"--- +title: \"", name, "\" +author: \"Module Author\" +date: \"", format(Sys.Date(), "%d %B %Y"), "\" +output: pdf_document +--- - # Overview +# Overview - Provide an overview of what the module does / how to use the module. +Provide an overview of what the module does / how to use the module. - Module documentation should be written so that others can use your module. - This is a template for module documentation, and should be changed to reflect your module. +Module documentation should be written so that others can use your module. +This is a template for module documentation, and should be changed to reflect your module. - ## RMarkdown +## RMarkdown - RMarkdown syntax allows R code, outputs, and figures to be rendered in the documentation. +RMarkdown syntax allows R code, outputs, and figures to be rendered in the documentation. - For help writing in RMarkdown, see http://rmarkdown.rstudio.com/. +For help writing in RMarkdown, see http://rmarkdown.rstudio.com/. - # Usage +# Usage - ```{r module_usage} - library(SpaDES) - library(magrittr) +```{r module_usage} +library(SpaDES) +library(magrittr) - inputDir <- file.path(tempdir(), \"inputs\") %>% checkPath(create = TRUE) - outputDir <- file.path(tempdir(), \"outputs\") - times <- list(start = 0, end = 10) - parameters <- list( - .globals = list(burnStats = \"nPixelsBurned\"), - #.progress = list(type = \"text\", interval = 1), # for a progress bar - # If there are further modules, each can have its own set of parameters, assigned - # as examples below - #cropReprojectLccAge = list(useCache = TRUE), - #forestSuccessionBeacons = list( - # returnInterval = 1, startTime = times$start, - # .plotInitialTime = times$start, .plotInterval = 1), - #forestAge = list( - # returnInterval = 1, startTime = times$start+0.5, - # .plotInitialTime = times$start, .plotInterval = 1), - #fireSpreadLcc = list( - # nFires = 3, its = 1e6, drought = 1.2, persistprob = 0, returnInterval = 1, - # startTime = times$start+1, .plotInitialTime = times$start, .plotInterval = 1), - #caribouMovementLcc = list( - # N = 1e3, moveInterval = 1, startTime = times$start+1, torus = TRUE, - # glmInitialTime = NA_real_, .plotInitialTime = times$start, .plotInterval = 1) - ) - modules <- list(\"", name, "\") - objects <- list() - paths <- list( - cachePath = file.path(outputDir, \"cache\"), - modulePath = file.path(\"..\"), - inputPath = inputDir, - outputPath = outputDir - ) +inputDir <- file.path(tempdir(), \"inputs\") %>% checkPath(create = TRUE) +outputDir <- file.path(tempdir(), \"outputs\") +times <- list(start = 0, end = 10) +parameters <- list( + .globals = list(burnStats = \"nPixelsBurned\"), + #.progress = list(type = \"text\", interval = 1), # for a progress bar + ## If there are further modules, each can have its own set of parameters: + #module1 = list(param1 = value1, param2 = value2), + #module2 = list(param1 = value1, param2 = value2) +) +modules <- list(\"", name, "\") +objects <- list() +paths <- list( + cachePath = file.path(outputDir, \"cache\"), + modulePath = file.path(\"..\"), + inputPath = inputDir, + outputPath = outputDir +) - mySim <- simInit(times = times, params = parameters, modules = modules, - objects = objects, paths = paths) +mySim <- simInit(times = times, params = parameters, modules = modules, + objects = objects, paths = paths) - spades(mySim) - ``` +spades(mySim) +``` - # Events +# Events - Describe what happens for each event type. +Describe what happens for each event type. - ## Plotting +## Plotting - Write what is plotted. +Write what is plotted. - ## Saving +## Saving - Write what is saved. +Write what is saved. - # Data dependencies +# Data dependencies - ## Input data +## Input data - How to obtain input data, and a description of the data required by the module. +How to obtain input data, and a description of the data required by the module. +If `sourceURL` is specified, `downloadData(\"", name, "\", \"path/to/modules/dir\")` may be sufficient. - ## Output data +## Output data - Description of the module outputs. +Description of the module outputs. - # Links to other modules +# Links to other modules - Describe any anticipated linkages to other modules. +Describe any anticipated linkages to other modules. - ", - file = filenameRmd, fill = FALSE, sep = "") +", + file = filenameRmd, fill = FALSE, sep = "") ### Make citation.bib file cat(" - @Manual{, - title = {", name ,"}, - author = {{Authors}}, - organization = {Organization}, - address = {Somewhere, Someplace}, - year = {", format(Sys.Date(), "%Y"), "}, - url = {}, - } - ", +@Manual{, + title = {", name ,"}, + author = {{Authors}}, + organization = {Organization}, + address = {Somewhere, Someplace}, + year = {", format(Sys.Date(), "%Y"), "}, + url = {}, +} +", file = filenameCitation, fill = FALSE, sep = "") ### Make LICENSE file cat(" - # Provide explicit details of the license for this module. - # See http://choosealicense.com for help selecting one.", +# Provide explicit details of the license for this module. +# See http://choosealicense.com for help selecting one.", file = filenameLICENSE, fill = FALSE, sep = "") ### Make README file cat(" - Any other details that a user may need to know, like where to get more information, - where to download data etc.", +Any other details that a user may need to know, like where to get more information, +where to download data, etc.", file = filenameREADME, fill = FALSE, sep = "") if (open) { @@ -535,7 +477,7 @@ setMethod( } return(invisible(NULL)) - }) +}) #' @export #' @rdname newModule @@ -543,7 +485,7 @@ setMethod("newModuleDocumentation", signature = c(name = "character", path = "missing", open = "logical"), definition = function(name, open) { newModuleDocumentation(name = name, path = ".", open = open) - }) +}) #' @export #' @rdname newModule @@ -551,7 +493,7 @@ setMethod("newModuleDocumentation", signature = c(name = "character", path = "character", open = "missing"), definition = function(name, path) { newModuleDocumentation(name = name, path = path, open = TRUE) - }) +}) #' @export #' @rdname newModule @@ -559,7 +501,111 @@ setMethod("newModuleDocumentation", signature = c(name = "character", path = "missing", open = "missing"), definition = function(name) { newModuleDocumentation(name = name, path = ".", open = TRUE) - }) +}) + +################################################################################ +#' @export +#' @docType methods +#' @rdname newModule +# @importFrom utils file.edit +#' @author Eliot McIntire and Alex Chubaty +#' +setGeneric("newModuleTests", function(name, path, open) { + standardGeneric("newModuleTests") +}) + +#' @export +#' @rdname newModule +setMethod( + "newModuleTests", + signature = c(name = "character", path = "character", open = "logical"), + definition = function(name, path, open) { + if (!requireNamespace("testthat", quietly = TRUE)) { + warning('The `testthat` package is required to run unit tests on modules.') + } + path <- checkPath(path, create = TRUE) + nestedPath <- file.path(path, name) %>% checkPath(create = TRUE) + testDir <- file.path(nestedPath, "tests") %>% checkPath(create = TRUE) + testthatDir <- file.path(testDir, "testthat") %>% checkPath(create = TRUE) + + # create two R files in unit tests folder: + unitTestsR <- file.path(testDir, "unitTests.R") # source this to run all tests + testTemplate <- file.path(testthatDir, "test-DryRun.R") + + cat(" +# Please build your own test file from test-Template.R, and place it in tests folder +# please specify the package you need to run the sim function in the test files. + +# to test all the test files in the tests folder: +test_dir(\"", testDir, "\") + +# Alternative, you can use test_file to test individual test file, e.g.: +test_file(\"", file.path(testthatDir, "test-DryRun.R"), "\")\n", + file = unitTestsR, fill = FALSE, sep = "") + + ## test template file + cat(" +# please do three things when this template is corrected modified. +# 1. rename this file based on the content you are testing, e.g., test-treeGrowthFunction.R +# 2. copy this file to tests folder, i.e., `", testDir, "`.\n +# 3. modify the test description, i.e., test tree growth function, based on the content you are testing:, +test_that(\"test tree growth function\", { +module <- list(\"", name, "\") +path <- list(modulePath = \"", path, "\", outputPath = \"~/output\") +parameters <- list( + #.progress = list(type = \"graphical\", interval = 1), + .globals = list(verbose = FALSE), + ", name ," = list(.saveInitialTime = NA) +) +times <- list(start = 0, end = 1) + +# If your test function contains `time(sim)`, you can test the function at a particular simulation time by define start time above. +object1 <- \"object1\" # please specify +object2 <- \"object2\" # please specify +objects <- list(\"object1\" = object1, \"object2\" = object2) + +mySim <- simInit(times = times, + params = parameters, + modules = module, + objects = objects, + paths = path) + +# You may need to set seed if your module or the function has the random number generator. +set.seed(1234) + +# You have two strategies to test your module: +# 1. test the overall simulation results for the given objects, then, use the code below: + +output <- spades(mySim, debug = FALSE) + +# is output a simList? +expect_is(output, \"simList\") + +# does output have your module in it +expect_true(any(unlist(modules(output)) %in% c(unlist(module)))) + +# did it simulate to the end? +expect_true(time(output) == 1) + +# 2. test the function inside of the module, then, use the line below: +# To allow the moduleCoverage function to calculate unit test coverage +# level, it needs access to all functions directly. Use this approach +# to when using any function within the simList object, +# i.e., one version as a direct call, and one with simList prepended. + +output <- try(treeGrowthFunction(mySim, otherArguments)) +if (is(output,\"try-error\")) { + output <- mySim$treeGrowthFunction(mySim, otherArguments) +} + +# treeGrowthFunction is the function you would like to test, please specify your function name +# otherArguments is the arguments needed for running the function. + +# output_expected <- # please define your expection of your output +# expect_equal(output,output_expected) # or other expect function in testthat package. +})", + file = testTemplate, fill = FALSE, sep = "") +}) ################################################################################ #' Open all modules nested within a base directory @@ -606,7 +652,7 @@ setMethod("openModules", basedir <- checkPath(path, create = FALSE) origDir <- getwd() setwd(basedir) - if(any(names == "all")) { + if (any(names == "all")) { Rfiles <- dir(pattern = "[\\.][rR]$", recursive = TRUE) } else { Rfiles <- dir(pattern = "[\\.][rR]$", recursive = TRUE) @@ -617,7 +663,7 @@ setMethod("openModules", function(x) any(duplicated(x)))] lapply(Rfiles, file.edit) setwd(origDir) - }) +}) #' @export #' @rdname openModules @@ -625,7 +671,7 @@ setMethod("openModules", signature = c(name = "missing", path = "missing"), definition = function() { openModules(name = "all", path = ".") - }) +}) #' @export #' @rdname openModules @@ -633,7 +679,7 @@ setMethod("openModules", signature = c(name = "missing", path = "character"), definition = function(path) { openModules(name = "all", path = path) - }) +}) #' @export #' @rdname openModules @@ -641,7 +687,7 @@ setMethod("openModules", signature = c(name = "character", path = "missing"), definition = function(name) { openModules(name = name, path = ".") - }) +}) ################################################################################ #' Create a zip archive of a module subdirectory @@ -683,7 +729,7 @@ setMethod( zip(zipFileName, files = file.path(name), extras = c("-x","*.zip"), ...) file.copy(zipFileName, to = paste0(name, "/", zipFileName), overwrite = TRUE) file.remove(zipFileName) - }) +}) #' @rdname zipModule #' @export @@ -691,7 +737,7 @@ setMethod("zipModule", signature = c(name = "character", path = "missing", version = "character"), definition = function(name, version, ...) { zipModule(name = name, path = ".", version = version, ...) - }) +}) #' @export #' @rdname zipModule @@ -700,7 +746,7 @@ setMethod("zipModule", definition = function(name, ...) { vers <- moduleMetadata(name, ".")$version %>% as.character zipModule(name = name, path = ".", version = vers, ...) - }) +}) #' @export #' @rdname zipModule @@ -709,4 +755,4 @@ setMethod("zipModule", definition = function(name, path, ...) { vers <- moduleMetadata(name, path)$version %>% as.character zipModule(name = name, path = path, version = vers, ...) - }) +}) diff --git a/R/moduleCoverage.R b/R/moduleCoverage.R index 6b8951f24..07ff07e6e 100644 --- a/R/moduleCoverage.R +++ b/R/moduleCoverage.R @@ -1,20 +1,18 @@ -############################################################################### +################################################################################ #' Calculate module coverage of unit tests #' -#' -#' Calculate the test coverage by unit tests for the module and functions in module -#' +#' Calculate the test coverage by unit tests for the module and its functions. #' #' @param name Character string. The module's name. #' -#' @param path Character string. Subdirectory in which to place the new module code file. -#' The default is the current working directory. +#' @param path Character string. The path to the module directory +#' (default is the current working directory). #' #' @return Return two coverage objects: moduleCoverage and functionCoverage. -#' The moduleCoverage contains percentage of coverage by unit tests for the module. -#' The functioinCoverage contains percentages of coverage by unit tests for functions in the module. -#' The returned two objects are compatible to \code{shine} function in \code{covr} package. -#' Please use \code{shine} to view the information of coverage. +#' The moduleCoverage contains percentage of coverage by unit tests for the module. +#' The functioinCoverage contains percentages of coverage by unit tests for functions in the module. +#' The returned two objects are compatible to \code{shine} function in \code{covr} package. +#' Please use \code{shine} to view the information of coverage. #' #' @note For running this function, the tests file must be restrictly placed in tests/testthat folder under module path. #' To automatically generate this folder, please set unitTests = TRUE when develop a new module using \code{\link{newModule}}. @@ -30,12 +28,12 @@ #' #' @examples #' \dontrun{ -#' # test module and function coverage for forestAge module +#' library(magrittr) #' library(SpaDES) -#' tmpdir <- tempdir(); on.exit(unlink(tmpdir, recursive = TRUE)) -#' modulePath <- file.path(tmpdir, "Modules") -#' moduleName <- "forestAge" -#' downloadModule(name = moduleName, path = modulePath) +#' tmpdir <- tempdir() +#' modulePath <- file.path(tmpdir, "Modules") %>% checkPath(create = TRUE) +#' moduleName <- "forestAge" # sample module to test +#' downloadModule(name = moduleName, path = modulePath) # download sample module #' testResults <- moduleCoverage(name = moduleName, path = modulePath) #' shine(testResults$moduleCoverage) #' shine(testResults$functionCoverage) @@ -51,64 +49,69 @@ setMethod( "moduleCoverage", signature(name = "character", path = "character"), definition = function(name, path) { + tmpdir <- tempdir(); on.exit(unlink(tmpdir, recursive = TRUE)) + fnDir <- file.path(path, name, "moduleFunctions") %>% + checkPath(create = TRUE) + testDir <- file.path(path, name, "tests", "testthat") + + if (!requireNamespace("covr", quietly = TRUE) || + !requireNamespace("testthat", quietly = TRUE)) { + stop("Suggested packages `covr` and `testthat` not found. ", + "Both must be installed to test module coverage.") + } + stopifnot(dir.exists(testDir)) + + fCoverage <- list() + mCoverage <- list() + # read the module mySim <- simInit(times = list(start = 0, end = 1), params = list(), modules = list(paste0(name)), objects = list(), - paths = list(modulePath = path, - outputPath = "~/output")) + paths = list(modulePath = path, outputPath = tmpdir)) objects <- mget(objects(mySim), envir(mySim)) - functionIndex <- which(lapply(objects, is.function) == TRUE) + fnIndex <- which(lapply(objects, is.function) == TRUE) - if(dir.exists(file.path(path, name, "tests", "testthat"))){ - testFileFolder <- file.path(path, name, "tests", "testthat") - functionFolder <- checkPath(file.path(path, name, "moduleFunctions"), create=TRUE) - moduleCoverage <- list() - functionCoverage <- list() - for (i in functionIndex){ - functionName <- file.path(functionFolder, paste0(names(objects[i]), ".R", sep="")) - functionLines <- deparse(objects[i][[1]]) - cat(names(objects[i]), " <- ", functionLines[1:2], "\n",sep="", file=functionName) - cat(functionLines[3:length(functionLines)], sep="\n", file=functionName, append = TRUE) - source(functionName) - } - rm(i) - - for(i in functionIndex){ - testfiles <- file.path(testFileFolder, paste("test-", objects(mySim)[i], ".R", sep="")) - if(file.exists(testfiles)){ - moduleTest <- covr::function_coverage(objects(mySim)[i], env=envir(mySim), - testthat::test_file(testfiles, env = envir(mySim))) - functionTest <- covr::function_coverage(objects(mySim)[i], - testthat::test_file(testfiles)) - moduleCoverage <- append(moduleCoverage, moduleTest) - functionCoverage <- append(functionCoverage, functionTest) + for (i in fnIndex) { + fnName <- file.path(fnDir, paste0(names(objects[i]), ".R", sep = "")) + fnLines <- deparse(objects[i][[1]]) + cat(names(objects[i]), " <- ", fnLines[1:2], "\n", sep = "", file = fnName) + cat(fnLines[3:length(fnLines)], sep = "\n", file = fnName, append = TRUE) + source(fnName) + } + rm(i) - } else { - moduleTest <- covr::function_coverage(objects(mySim)[i], env=envir(mySim), - testthat::test_dir(testFileFolder, env = envir(mySim))) - functionTest <- covr::function_coverage(objects(mySim)[i], - testthat::test_dir(testFileFolder)) - moduleCoverage <- append(moduleCoverage, moduleTest) - functionCoverage <- append(functionCoverage, functionTest) - } + for (i in fnIndex) { + testfiles <- file.path(testDir, paste0("test-", objects(mySim)[i], ".R")) + if (file.exists(testfiles)) { + mTest <- covr::function_coverage(objects(mySim)[i], env = envir(mySim), + testthat::test_file(testfiles, env = envir(mySim))) + fnTest <- covr::function_coverage(objects(mySim)[i], + testthat::test_file(testfiles)) + mCoverage <- append(mCoverage, mTest) + fnCoverage <- append(fnCoverage, fnTest) + } else { + mTest <- covr::function_coverage(objects(mySim)[i], env = envir(mySim), + testthat::test_dir(testDir, env = envir(mySim))) + fnTest <- covr::function_coverage(objects(mySim)[i], + testthat::test_dir(testDir)) + mCoverage <- append(mCoverage, mTest) + fnCoverage <- append(fnCoverage, fnTest) } - class(moduleCoverage) <- "coverage" - class(functionCoverage) <- "coverage" - unlink(functionFolder, recursive=TRUE) - return(list(moduleCoverage = moduleCoverage, functionCoverage = functionCoverage)) - } else { - stop("Your test files must be placed in ", file.path(path, name, "tests", "testthat")) } - }) + class(mCoverage) <- "coverage" + class(fnCoverage) <- "coverage" + unlink(fnDir, recursive = TRUE) + return(list(moduleCoverage = mCoverage, functionCoverage = fnCoverage)) +}) #' @export #' @rdname moduleCoverage setMethod( "moduleCoverage", signature(name = "character", path = "missing"), - definition = function(name){ + definition = function(name) { moduleCoverage(name = name, path = ".") - }) +}) diff --git a/man/moduleCoverage.Rd b/man/moduleCoverage.Rd index c341ad3b2..8724f3b4f 100644 --- a/man/moduleCoverage.Rd +++ b/man/moduleCoverage.Rd @@ -16,18 +16,18 @@ moduleCoverage(name, path) \arguments{ \item{name}{Character string. The module's name.} -\item{path}{Character string. Subdirectory in which to place the new module code file. -The default is the current working directory.} +\item{path}{Character string. The path to the module directory +(default is the current working directory).} } \value{ Return two coverage objects: moduleCoverage and functionCoverage. - The moduleCoverage contains percentage of coverage by unit tests for the module. - The functioinCoverage contains percentages of coverage by unit tests for functions in the module. - The returned two objects are compatible to \code{shine} function in \code{covr} package. - Please use \code{shine} to view the information of coverage. +The moduleCoverage contains percentage of coverage by unit tests for the module. +The functioinCoverage contains percentages of coverage by unit tests for functions in the module. +The returned two objects are compatible to \code{shine} function in \code{covr} package. +Please use \code{shine} to view the information of coverage. } \description{ -Calculate the test coverage by unit tests for the module and functions in module +Calculate the test coverage by unit tests for the module and its functions. } \note{ For running this function, the tests file must be restrictly placed in tests/testthat folder under module path. @@ -35,12 +35,12 @@ For running this function, the tests file must be restrictly placed in tests/tes } \examples{ \dontrun{ - # test module and function coverage for forestAge module + library(magrittr) library(SpaDES) - tmpdir <- tempdir(); on.exit(unlink(tmpdir, recursive = TRUE)) - modulePath <- file.path(tmpdir, "Modules") - moduleName <- "forestAge" - downloadModule(name = moduleName, path = modulePath) + tmpdir <- tempdir() + modulePath <- file.path(tmpdir, "Modules") \%>\% checkPath(create = TRUE) + moduleName <- "forestAge" # sample module to test + downloadModule(name = moduleName, path = modulePath) # download sample module testResults <- moduleCoverage(name = moduleName, path = modulePath) shine(testResults$moduleCoverage) shine(testResults$functionCoverage) diff --git a/man/newModule.Rd b/man/newModule.Rd index 69da0c5c3..edd4927bc 100644 --- a/man/newModule.Rd +++ b/man/newModule.Rd @@ -11,11 +11,15 @@ \alias{newModule,character,missing,logical,missing-method} \alias{newModule,character,missing,missing,logical-method} \alias{newModule,character,missing,missing,missing-method} +\alias{newModuleCode} +\alias{newModuleCode,character,character,logical-method} \alias{newModuleDocumentation} \alias{newModuleDocumentation,character,character,logical-method} \alias{newModuleDocumentation,character,character,missing-method} \alias{newModuleDocumentation,character,missing,logical-method} \alias{newModuleDocumentation,character,missing,missing-method} +\alias{newModuleTests} +\alias{newModuleTests,character,character,logical-method} \title{Create new module from template.} \usage{ newModule(name, path, open, unitTests) @@ -37,6 +41,10 @@ newModule(name, path, open, unitTests) \S4method{newModule}{character,missing,missing,missing}(name) +newModuleCode(name, path, open) + +\S4method{newModuleCode}{character,character,logical}(name, path, open) + newModuleDocumentation(name, path, open) \S4method{newModuleDocumentation}{character,character,logical}(name, path, open) @@ -46,6 +54,10 @@ newModuleDocumentation(name, path, open) \S4method{newModuleDocumentation}{character,character,missing}(name, path) \S4method{newModuleDocumentation}{character,missing,missing}(name) + +newModuleTests(name, path, open) + +\S4method{newModuleTests}{character,character,logical}(name, path, open) } \arguments{ \item{name}{Character string. Your module's name.} @@ -93,6 +105,10 @@ You can just browse to the file and open it manually. \author{ Alex Chubaty and Eliot McIntire +Eliot McIntire and Alex Chubaty + Eliot McIntire + +Eliot McIntire and Alex Chubaty } diff --git a/tests/testthat/test-downloadModule.R b/tests/testthat/test-downloadModule.R index 595c5a944..feb513ee5 100644 --- a/tests/testthat/test-downloadModule.R +++ b/tests/testthat/test-downloadModule.R @@ -43,9 +43,9 @@ test_that("downloadModule downloads and unzips a parent module", { d <- f %>% dirname() %>% basename() %>% unique() %>% sort() d_expected <- moduleMetadata("LCC2005", tmpdir)$childModules %>% - c(m, "data") %>% sort() + c(m, "data", "testthat") %>% sort() - expect_equal(length(f), 40) + expect_equal(length(f), 42) expect_equal(d, d_expected) })