From 74c574d67419ac19f51dd2f9b670487dc77e0702 Mon Sep 17 00:00:00 2001 From: jasenfinch Date: Mon, 22 May 2023 15:32:04 +0100 Subject: [PATCH] Added the argument parallel_plan to the Project class and defineProject() --- DESCRIPTION | 3 +++ NAMESPACE | 3 +++ R/project.R | 44 +++++++++++++++++++++++++++++++++++ man/Project-accessors.Rd | 18 ++++++++++++++ man/Project-class.Rd | 2 ++ man/defineProject.Rd | 3 +++ tests/testthat/test-project.R | 5 ++++ 7 files changed, 78 insertions(+) diff --git a/DESCRIPTION b/DESCRIPTION index e55f6e5..4667b27 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -14,6 +14,7 @@ Imports: projecttemplates, crayon, gh, glue, + jfmisc, magrittr, methods, purrr, @@ -25,6 +26,7 @@ Imports: projecttemplates, yaml Suggests: covr, + future, hrmtargets, knitr, metaboData, @@ -45,6 +47,7 @@ RoxygenNote: 7.2.3 VignetteBuilder: knitr Remotes: jasenfinch/chunky, + jasenfinch/jfmisc, jasenfinch/hrmtargets, jasenfinch/projecttemplates diff --git a/NAMESPACE b/NAMESPACE index 162d0c7..f44cab7 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -15,6 +15,7 @@ export("host<-") export("input<-") export("instrument<-") export("name<-") +export("parallelPlan<-") export("path<-") export("port<-") export("private<-") @@ -51,6 +52,7 @@ export(modules) export(modulesKeep) export(modulesRemove) export(name) +export(parallelPlan) export(path) export(port) export(private) @@ -104,6 +106,7 @@ importFrom(purrr,flatten_chr) importFrom(purrr,map) importFrom(purrr,map_chr) importFrom(purrr,walk) +importFrom(rlang,enexpr) importFrom(rlang,enexprs) importFrom(rlang,eval_tidy) importFrom(rlang,expr) diff --git a/R/project.R b/R/project.R index a535aca..92c2aba 100644 --- a/R/project.R +++ b/R/project.R @@ -7,6 +7,7 @@ #' @slot github creation of a GitHub repository #' @slot private private GitHub repository #' @slot github_actions creation of GitHub actions infrastructure +#' @slot parallel_plan an expression to define the parallel future plan to use #' @slot force force project creation if the project directory already exists setClass('Project', @@ -18,6 +19,7 @@ setClass('Project', github = 'logical', private = 'logical', github_actions = 'logical', + parallel_plan = 'call', force = 'logical' ), prototype = list( @@ -28,6 +30,7 @@ setClass('Project', github = FALSE, private = FALSE, github_actions = FALSE, + parallel_plan = rlang::expr(jfmisc::suitableParallelPlan()), force = FALSE )) @@ -40,6 +43,7 @@ setMethod('show',signature = 'Project', cat('GitHub repository:',github(object),'\n') cat('Private repository:',private(object),'\n') cat('GitHub Actions:',githubActions(object),'\n') + cat('Parallel plan:',expr_text(parallelPlan(object)),'\n') cat('Force creation:',force(object),'\n') }) @@ -92,6 +96,12 @@ setMethod('show',signature = 'Project', #' #' ## Set the project github actions option #' githubActions(workflow_project) <- TRUE +#' +#' ## Return the expression project parallel plan +#' parallelPlan(workflow_project) +#' +#' ## Set the expression for the project parallel plan +#' parallelPlan(workflow_project) <- rlang::expr(future::plan(strategy = 'multisession',workers = 2)) #' #' ## Return the project force option #' force(workflow_project) @@ -289,6 +299,33 @@ setMethod('githubActions<-',signature = 'Project', #' @rdname Project-accessors #' @export +setGeneric('parallelPlan',function(x) + standardGeneric('parallelPlan')) + +#' @rdname Project-accessors + +setMethod('parallelPlan',signature = 'Project', + function(x){ + x@parallel_plan + }) + +#' @rdname Project-accessors +#' @export + +setGeneric('parallelPlan<-',function(x,value) + standardGeneric('parallelPlan<-')) + +#' @rdname Project-accessors + +setMethod('parallelPlan<-',signature = 'Project', + function(x,value){ + x@parallel_plan <- value + return(x) + }) + +#' @rdname Project-accessors +#' @export + setGeneric('force',function(x) standardGeneric('force')) @@ -322,12 +359,14 @@ setMethod('force<-',signature = 'Project', #' @param github TRUE/FALSE. Create a GitHub repository? #' @param private TRUE/FALSE. Should the GitHub repository be private? Evaluated only if argument `github` is TRUE. #' @param github_actions TRUE/FALSE. Add Github actions infrastructure? Evaluated only if argument `github` is TRUE. +#' @param parallel_plan An expression denoting the `future` parallel plan to use in the project template. See `future::plan()` for more information on `future` parallel plans. #' @param force force project creation if project directory already exists #' @return An S4 object of class `Project`. #' @examples #' workflow_project <- defineProject('A metabolomics project') #' #' workflow_project +#' @importFrom rlang enexpr #' @export defineProject <- function(project_name, @@ -337,7 +376,11 @@ defineProject <- function(project_name, github = FALSE, private = FALSE, github_actions = FALSE, + parallel_plan = jfmisc::suitableParallelPlan(), force = FALSE){ + + parallel_plan <- enexpr(parallel_plan) + new('Project', project_name = project_name, path = path, @@ -346,6 +389,7 @@ defineProject <- function(project_name, github = github, private = private, github_actions = github_actions, + parallel_plan = parallel_plan, force = force) } diff --git a/man/Project-accessors.Rd b/man/Project-accessors.Rd index a10ba5f..e39c7e8 100644 --- a/man/Project-accessors.Rd +++ b/man/Project-accessors.Rd @@ -29,6 +29,10 @@ \alias{githubActions,Project-method} \alias{githubActions<-} \alias{githubActions<-,Project-method} +\alias{parallelPlan} +\alias{parallelPlan,Project-method} +\alias{parallelPlan<-} +\alias{parallelPlan<-,Project-method} \alias{force} \alias{force,Project-method} \alias{force<-} @@ -91,6 +95,14 @@ githubActions(x) <- value \S4method{githubActions}{Project}(x) <- value +parallelPlan(x) + +\S4method{parallelPlan}{Project}(x) + +parallelPlan(x) <- value + +\S4method{parallelPlan}{Project}(x) <- value + force(x) \S4method{force}{Project}(x) @@ -152,6 +164,12 @@ githubActions(workflow_project) ## Set the project github actions option githubActions(workflow_project) <- TRUE +## Return the expression project parallel plan +parallelPlan(workflow_project) + +## Set the expression for the project parallel plan +parallelPlan(workflow_project) <- rlang::expr(future::plan(strategy = 'multisession',workers = 2)) + ## Return the project force option force(workflow_project) diff --git a/man/Project-class.Rd b/man/Project-class.Rd index 4900f74..bf53f5b 100644 --- a/man/Project-class.Rd +++ b/man/Project-class.Rd @@ -24,6 +24,8 @@ An S4 class to store the workflow project directory definitions. \item{\code{github_actions}}{creation of GitHub actions infrastructure} +\item{\code{parallel_plan}}{an expression to define the parallel future plan to use} + \item{\code{force}}{force project creation if the project directory already exists} }} diff --git a/man/defineProject.Rd b/man/defineProject.Rd index 8606dc3..fe4e7e0 100644 --- a/man/defineProject.Rd +++ b/man/defineProject.Rd @@ -12,6 +12,7 @@ defineProject( github = FALSE, private = FALSE, github_actions = FALSE, + parallel_plan = jfmisc::suitableParallelPlan(), force = FALSE ) } @@ -30,6 +31,8 @@ defineProject( \item{github_actions}{TRUE/FALSE. Add Github actions infrastructure? Evaluated only if argument \code{github} is TRUE.} +\item{parallel_plan}{An expression denoting the \code{future} parallel plan to use in the project template. See \code{future::plan()} for more information on \code{future} parallel plans.} + \item{force}{force project creation if project directory already exists} } \value{ diff --git a/tests/testthat/test-project.R b/tests/testthat/test-project.R index 2b66e2e..11cf265 100644 --- a/tests/testthat/test-project.R +++ b/tests/testthat/test-project.R @@ -20,6 +20,8 @@ test_that('Project elements can be returned',{ FALSE) expect_identical(githubActions(workflow_project), FALSE) + expect_identical(parallelPlan(workflow_project), + rlang::expr(jfmisc::suitableParallelPlan())) expect_identical(force(workflow_project), FALSE) }) @@ -34,6 +36,7 @@ test_that('Project elements can be set',{ github(workflow_project) <- TRUE private(workflow_project) <- TRUE githubActions(workflow_project) <- TRUE + parallelPlan(workflow_project) <- rlang::expr(future::plan()) force(workflow_project) <- TRUE expect_identical(projectName(workflow_project), @@ -49,6 +52,8 @@ test_that('Project elements can be set',{ TRUE) expect_identical(githubActions(workflow_project), TRUE) + expect_identical(parallelPlan(workflow_project), + rlang::expr(future::plan())) expect_identical(force(workflow_project), TRUE) })