From 58a71108e4221045f1f01b79341890f922f9b9cb Mon Sep 17 00:00:00 2001 From: mihaiconstantin Date: Sun, 30 Apr 2023 20:24:46 +0200 Subject: [PATCH 01/34] Docs: update parameter docs for `sapply` operation --- R/AsyncBackend.R | 3 +-- R/Context.R | 3 +-- R/ProgressTrackingContext.R | 3 +-- R/Service.R | 3 +-- R/SyncBackend.R | 3 +-- 5 files changed, 5 insertions(+), 10 deletions(-) diff --git a/R/AsyncBackend.R b/R/AsyncBackend.R index ee70b59..f8687a0 100644 --- a/R/AsyncBackend.R +++ b/R/AsyncBackend.R @@ -426,8 +426,7 @@ AsyncBackend <- R6::R6Class("AsyncBackend", #' @description #' Run a task on the backend akin to [parallel::parSapply()]. #' - #' @param x A vector (i.e., usually of integers) to pass to the `fun` - #' function. + #' @param x An atomic vector or list to pass to the `fun` function. #' #' @param fun A function to apply to each element of `x`. #' diff --git a/R/Context.R b/R/Context.R index e22f5a3..2546932 100644 --- a/R/Context.R +++ b/R/Context.R @@ -185,8 +185,7 @@ Context <- R6::R6Class("Context", #' @description #' Run a task on the backend akin to [parallel::parSapply()]. #' - #' @param x A vector (i.e., usually of integers) to pass to the `fun` - #' function. + #' @param x An atomic vector or list to pass to the `fun` function. #' #' @param fun A function to apply to each element of `x`. #' diff --git a/R/ProgressTrackingContext.R b/R/ProgressTrackingContext.R index a409d9f..f425da4 100644 --- a/R/ProgressTrackingContext.R +++ b/R/ProgressTrackingContext.R @@ -265,8 +265,7 @@ ProgressTrackingContext <- R6::R6Class("ProgressTrackingContext", #' Run a task on the backend akin to [parallel::parSapply()], but with a #' progress bar. #' - #' @param x A vector (i.e., usually of integers) to pass to the `fun` - #' function. + #' @param x An atomic vector or list to pass to the `fun` function. #' #' @param fun A function to apply to each element of `x`. #' diff --git a/R/Service.R b/R/Service.R index 4a55c99..b346059 100644 --- a/R/Service.R +++ b/R/Service.R @@ -101,8 +101,7 @@ Service <- R6::R6Class("Service", #' @description #' Run a task on the backend akin to [parallel::parSapply()]. #' - #' @param x A vector (i.e., usually of integers) to pass to the `fun` - #' function. + #' @param x An atomic vector or list to pass to the `fun` function. #' #' @param fun A function to apply to each element of `x`. #' diff --git a/R/SyncBackend.R b/R/SyncBackend.R index e16415d..d6dffd4 100644 --- a/R/SyncBackend.R +++ b/R/SyncBackend.R @@ -273,8 +273,7 @@ SyncBackend <- R6::R6Class("SyncBackend", #' @description #' Run a task on the backend akin to [parallel::parSapply()]. #' - #' @param x A vector (i.e., usually of integers) to pass to the `fun` - #' function. + #' @param x An atomic vector or list to pass to the `fun` function. #' #' @param fun A function to apply to each element of `x`. #' From 74664d79110c7556e18d4ca259f424ba05ec6c1e Mon Sep 17 00:00:00 2001 From: mihaiconstantin Date: Sun, 30 Apr 2023 20:29:02 +0200 Subject: [PATCH 02/34] Docs: update docs for `get_output` method --- R/AsyncBackend.R | 6 ++++-- R/Context.R | 6 ++++-- R/Service.R | 12 +++++++----- R/SyncBackend.R | 6 ++++-- 4 files changed, 19 insertions(+), 11 deletions(-) diff --git a/R/AsyncBackend.R b/R/AsyncBackend.R index f8687a0..f6cc8d0 100644 --- a/R/AsyncBackend.R +++ b/R/AsyncBackend.R @@ -465,8 +465,10 @@ AsyncBackend <- R6::R6Class("AsyncBackend", #' task is still running. #' #' @return - #' A vector or list of the same length as `x` containing the results of - #' the `fun`. It resembles the format of [base::sapply()]. + #' A vector, matrix, or list of the same length as `x`, containing the + #' results of the `fun`. The output format differs based on the specific + #' operation employed. Check out the documentation for the `apply` + #' operations of [`parallel::parallel`] for more information. get_output = function(wait = FALSE) { # Reset the output on exit. on.exit({ diff --git a/R/Context.R b/R/Context.R index 2546932..e1a89db 100644 --- a/R/Context.R +++ b/R/Context.R @@ -216,8 +216,10 @@ Context <- R6::R6Class("Context", #' task. #' #' @return - #' A vector or list of the same length as `x` containing the results of - #' the `fun`. It resembles the format of [base::sapply()]. + #' A vector, matrix, or list of the same length as `x`, containing the + #' results of the `fun`. The output format differs based on the specific + #' operation employed. Check out the documentation for the `apply` + #' operations of [`parallel::parallel`] for more information. get_output = function(...) { # Consume the backend API. private$.backend$get_output(...) diff --git a/R/Service.R b/R/Service.R index b346059..a2cfe8a 100644 --- a/R/Service.R +++ b/R/Service.R @@ -118,6 +118,9 @@ Service <- R6::R6Class("Service", #' @description #' Get the output of the task execution. #' + #' @param ... Additional optional arguments that may be used by concrete + #' implementations. + #' #' @details #' This method fetches the output of the task execution after calling #' the `sapply()` method. It returns the output and immediately removes @@ -125,12 +128,11 @@ Service <- R6::R6Class("Service", #' not advised. This method should be called after the execution of a #' task. #' - #' @param ... Additional optional arguments that may be used by concrete - #' implementations. - #' #' @return - #' A vector or list of the same length as `x` containing the results of - #' the `fun`. It resembles the format of [base::sapply()]. + #' A vector, matrix, or list of the same length as `x`, containing the + #' results of the `fun`. The output format differs based on the specific + #' operation employed. Check out the documentation for the `apply` + #' operations of [`parallel::parallel`] for more information. get_output = function(...) { Exception$method_not_implemented() } diff --git a/R/SyncBackend.R b/R/SyncBackend.R index d6dffd4..3ce2e31 100644 --- a/R/SyncBackend.R +++ b/R/SyncBackend.R @@ -298,8 +298,10 @@ SyncBackend <- R6::R6Class("SyncBackend", #' task. #' #' @return - #' A vector or list of the same length as `x` containing the results of - #' the `fun`. It resembles the format of [base::sapply()]. + #' A vector, matrix, or list of the same length as `x`, containing the + #' results of the `fun`. The output format differs based on the specific + #' operation employed. Check out the documentation for the `apply` + #' operations of [`parallel::parallel`] for more information. get_output = function() { # Reset the output on exit. on.exit({ From c32e3c7c40d2a8c90e50aefe94ed029794964f45 Mon Sep 17 00:00:00 2001 From: mihaiconstantin Date: Sun, 30 Apr 2023 20:43:48 +0200 Subject: [PATCH 03/34] Feat: add `lapply` method to `Service` interface --- R/Service.R | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/R/Service.R b/R/Service.R index a2cfe8a..1e180da 100644 --- a/R/Service.R +++ b/R/Service.R @@ -115,6 +115,23 @@ Service <- R6::R6Class("Service", Exception$method_not_implemented() }, + #' @description + #' Run a task on the backend akin to [parallel::parLapply()]. + #' + #' @param x An atomic vector or list to pass to the `fun` function. + #' + #' @param fun A function to apply to each element of `x`. + #' + #' @param ... Additional arguments to pass to the `fun` function. + #' + #' @return + #' This method returns void. The output of the task execution must be + #' stored in the private field `.output` on the [`parabar::Backend`] + #' abstract class, and is accessible via the `get_output()` method. + lapply = function(x, fun, ...) { + Exception$method_not_implemented() + }, + #' @description #' Get the output of the task execution. #' From 6bcba63b9ab9a4ef21459e2e6935ae7ac1c22ff0 Mon Sep 17 00:00:00 2001 From: mihaiconstantin Date: Sun, 30 Apr 2023 20:45:13 +0200 Subject: [PATCH 04/34] Feat: add `lapply` implementation for `SyncBackend` --- R/SyncBackend.R | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/R/SyncBackend.R b/R/SyncBackend.R index 3ce2e31..6b67518 100644 --- a/R/SyncBackend.R +++ b/R/SyncBackend.R @@ -157,6 +157,12 @@ SyncBackend <- R6::R6Class("SyncBackend", parallel::parSapply(private$.cluster, X = x, FUN = fun, ...) }, + # A wrapper around `parallel:parLapply` to run tasks on the cluster. + .lapply = function(x, fun, ...) { + # Run the task and return the results. + parallel::parLapply(private$.cluster, X = x, fun = fun, ...) + }, + # Clear the current output on the backend. .clear_output = function() { # Clear output. @@ -287,6 +293,23 @@ SyncBackend <- R6::R6Class("SyncBackend", private$.output = private$.sapply(x, fun, ...) }, + #' @description + #' Run a task on the backend akin to [parallel::parLapply()]. + #' + #' @param x An atomic vector or list to pass to the `fun` function. + #' + #' @param fun A function to apply to each element of `x`. + #' + #' @param ... Additional arguments to pass to the `fun` function. + #' + #' @return + #' This method returns void. The output of the task execution must be + #' stored in the private field `.output` on the [`parabar::Backend`] + #' abstract class, and is accessible via the `get_output()` method. + lapply = function(x, fun, ...) { + private$.output = private$.lapply(x, fun, ...) + }, + #' @description #' Get the output of the task execution. #' From fd8874140e5547e0ee23d70b53c494ddce449af2 Mon Sep 17 00:00:00 2001 From: mihaiconstantin Date: Sun, 30 Apr 2023 20:45:43 +0200 Subject: [PATCH 05/34] Feat: add `lapply` implementation for `AsyncBackend` --- R/AsyncBackend.R | 36 ++++++++++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) diff --git a/R/AsyncBackend.R b/R/AsyncBackend.R index f6cc8d0..0a534f1 100644 --- a/R/AsyncBackend.R +++ b/R/AsyncBackend.R @@ -225,6 +225,21 @@ AsyncBackend <- R6::R6Class("AsyncBackend", }, args = list(x, fun, dots)) }, + # Run tasks on the cluster in the session via `parallel:parLapply` asynchronously. + .lapply = function(x, fun, ...) { + # Capture the `...`. + dots <- list(...) + + # Perform the evaluation from the `R` session. + private$.cluster$call(function(x, fun, dots) { + # Run the task. + output <- do.call(parallel::parLapply, c(list(cluster, x, fun), dots)) + + # Return to the session. + return(output) + }, args = list(x, fun, dots)) + }, + # Clear the current output on the backend. .clear_output = function() { # Clear output. @@ -444,6 +459,27 @@ AsyncBackend <- R6::R6Class("AsyncBackend", private$.sapply(x, fun, ...) }, + #' @description + #' Run a task on the backend akin to [parallel::parLapply()]. + #' + #' @param x An atomic vector or list to pass to the `fun` function. + #' + #' @param fun A function to apply to each element of `x`. + #' + #' @param ... Additional arguments to pass to the `fun` function. + #' + #' @return + #' This method returns void. The output of the task execution must be + #' stored in the private field `.output` on the [`parabar::Backend`] + #' abstract class, and is accessible via the `get_output()` method. + lapply = function(x, fun, ...) { + # Throw if backend is busy. + private$.throw_if_backend_is_busy() + + # Deploy the task asynchronously. + private$.lapply(x, fun, ...) + }, + #' @description #' Get the output of the task execution. #' From 8822d8153eea7cf0c85d631739c3df97798a44f4 Mon Sep 17 00:00:00 2001 From: mihaiconstantin Date: Sun, 30 Apr 2023 20:45:56 +0200 Subject: [PATCH 06/34] Feat: add `lapply` implementation for `Context` --- R/Context.R | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/R/Context.R b/R/Context.R index e1a89db..82e31c2 100644 --- a/R/Context.R +++ b/R/Context.R @@ -200,6 +200,24 @@ Context <- R6::R6Class("Context", private$.backend$sapply(x = x, fun = fun, ...) }, + #' @description + #' Run a task on the backend akin to [parallel::parLapply()]. + #' + #' @param x An atomic vector or list to pass to the `fun` function. + #' + #' @param fun A function to apply to each element of `x`. + #' + #' @param ... Additional arguments to pass to the `fun` function. + #' + #' @return + #' This method returns void. The output of the task execution must be + #' stored in the private field `.output` on the [`parabar::Backend`] + #' abstract class, and is accessible via the `get_output()` method. + lapply = function(x, fun, ...) { + # Consume the backend API. + private$.backend$lapply(x = x, fun = fun, ...) + }, + #' @description #' Get the output of the task execution. #' From 89f5a4d32f4ffb814b64df800f1d0546bf8ebfe6 Mon Sep 17 00:00:00 2001 From: mihaiconstantin Date: Sun, 30 Apr 2023 20:50:57 +0200 Subject: [PATCH 07/34] Feat: add `.execute` method for progress tracking steps --- R/ProgressTrackingContext.R | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/R/ProgressTrackingContext.R b/R/ProgressTrackingContext.R index f425da4..3bba92b 100644 --- a/R/ProgressTrackingContext.R +++ b/R/ProgressTrackingContext.R @@ -212,6 +212,27 @@ ProgressTrackingContext <- R6::R6Class("ProgressTrackingContext", # Close and remove the progress bar. private$.bar$terminate() + }, + + # Template function for tracking progress of backend operations. + .execute = function(operation, x, fun) { + # Create file for logging progress. + log <- private$.make_log() + + # Clear the temporary file on function exit. + on.exit({ + # Remove. + unlink(log) + }) + + # Decorate task function and save it as `task` (i.e., for readability). + task <- private$.decorate(task = fun, log = log) + + # Substitute `fun` with `task` (i.e., for readability) and evaluate. + eval(substituteDirect(operation, list(fun = task))) + + # Show the progress bar and block the main process. + private$.show_progress(total = length(x), log = log) } ), From 68277ea7cb9f97baf759333cba359f02eab58995 Mon Sep 17 00:00:00 2001 From: mihaiconstantin Date: Sun, 30 Apr 2023 20:56:17 +0200 Subject: [PATCH 08/34] Refactor: update `sapply` to use `.execute` private method This is in the context of `ProgressTrackingContext` to generalize the progress tracking to other backend operations (e.g., `lapply` and `apply`) --- R/ProgressTrackingContext.R | 24 ++++++++---------------- 1 file changed, 8 insertions(+), 16 deletions(-) diff --git a/R/ProgressTrackingContext.R b/R/ProgressTrackingContext.R index 3bba92b..4271cc9 100644 --- a/R/ProgressTrackingContext.R +++ b/R/ProgressTrackingContext.R @@ -297,23 +297,15 @@ ProgressTrackingContext <- R6::R6Class("ProgressTrackingContext", #' stored in the private field `.output` on the [`parabar::Backend`] #' abstract class, and is accessible via the `get_output()` method. sapply = function(x, fun, ...) { - # Create file for logging progress. - log <- private$.make_log() - - # Clear the temporary file on function exit. - on.exit({ - # Remove. - unlink(log) - }) - - # Decorate task function. - task <- private$.decorate(task = fun, log = log) - - # Execute the decorated task. - super$sapply(x = x, fun = task, ...) + # Prepare the backend operation with early evaluated `...`. + operation <- bquote( + do.call( + super$sapply, c(list(x = x, fun = fun), .(list(...))) + ) + ) - # Show the progress bar and block the main process. - private$.show_progress(total = length(x), log = log) + # Execute the task using the desired backend operation. + private$.execute(operation = operation, x = x, fun = fun) } ), From 50e7dbc2e1bc20d2066bcd8ee690fef6ed7eceb8 Mon Sep 17 00:00:00 2001 From: mihaiconstantin Date: Sun, 30 Apr 2023 20:57:11 +0200 Subject: [PATCH 09/34] Feat: add `lapply` implementation for `ProgressTrackingContext` --- R/ProgressTrackingContext.R | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) diff --git a/R/ProgressTrackingContext.R b/R/ProgressTrackingContext.R index 4271cc9..6ba5450 100644 --- a/R/ProgressTrackingContext.R +++ b/R/ProgressTrackingContext.R @@ -306,6 +306,32 @@ ProgressTrackingContext <- R6::R6Class("ProgressTrackingContext", # Execute the task using the desired backend operation. private$.execute(operation = operation, x = x, fun = fun) + }, + + #' @description + #' Run a task on the backend akin to [parallel::parLapply()], but with a + #' progress bar. + #' + #' @param x An atomic vector or list to pass to the `fun` function. + #' + #' @param fun A function to apply to each element of `x`. + #' + #' @param ... Additional arguments to pass to the `fun` function. + #' + #' @return + #' This method returns void. The output of the task execution must be + #' stored in the private field `.output` on the [`parabar::Backend`] + #' abstract class, and is accessible via the `get_output()` method. + lapply = function(x, fun, ...) { + # Prepare the backend operation with early evaluated `...`. + operation <- bquote( + do.call( + super$lapply, c(list(x = x, fun = fun), .(list(...))) + ) + ) + + # Execute the task via the `lapply` backend operation. + private$.execute(operation = operation, x = x, fun = fun) } ), From ce9b15af0a7b59697e30b58e67382f82d6df1414 Mon Sep 17 00:00:00 2001 From: mihaiconstantin Date: Sun, 30 Apr 2023 20:59:48 +0200 Subject: [PATCH 10/34] Docs: update comments in `AsyncBackend` --- R/AsyncBackend.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/AsyncBackend.R b/R/AsyncBackend.R index 0a534f1..71933a5 100644 --- a/R/AsyncBackend.R +++ b/R/AsyncBackend.R @@ -210,7 +210,7 @@ AsyncBackend <- R6::R6Class("AsyncBackend", }, args = list(capture)) }, - # Run tasks on the cluster in the session asynchronously. + # Run tasks asynchronously via the cluster in the session. .sapply = function(x, fun, ...) { # Capture the `...`. dots <- list(...) @@ -225,7 +225,7 @@ AsyncBackend <- R6::R6Class("AsyncBackend", }, args = list(x, fun, dots)) }, - # Run tasks on the cluster in the session via `parallel:parLapply` asynchronously. + # Run tasks asynchronously via the cluster in the session. .lapply = function(x, fun, ...) { # Capture the `...`. dots <- list(...) From 3183e83cc52afdcf8e84bb490397be0246e81db7 Mon Sep 17 00:00:00 2001 From: mihaiconstantin Date: Sun, 30 Apr 2023 21:12:54 +0200 Subject: [PATCH 11/34] Refactor: simplify `.execute` in `ProgressTrackingContext` --- R/ProgressTrackingContext.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/R/ProgressTrackingContext.R b/R/ProgressTrackingContext.R index 6ba5450..9096759 100644 --- a/R/ProgressTrackingContext.R +++ b/R/ProgressTrackingContext.R @@ -225,11 +225,11 @@ ProgressTrackingContext <- R6::R6Class("ProgressTrackingContext", unlink(log) }) - # Decorate task function and save it as `task` (i.e., for readability). - task <- private$.decorate(task = fun, log = log) + # Decorate the task function. + fun <- private$.decorate(task = fun, log = log) - # Substitute `fun` with `task` (i.e., for readability) and evaluate. - eval(substituteDirect(operation, list(fun = task))) + # Evaluate the operation now referencing the decorated task. + eval(operation) # Show the progress bar and block the main process. private$.show_progress(total = length(x), log = log) From c2b5184187adbc30dade065f138f65a5145cba65 Mon Sep 17 00:00:00 2001 From: mihaiconstantin Date: Wed, 3 May 2023 15:44:14 +0200 Subject: [PATCH 12/34] Feat: add `UserApiConsumer` class for the user `API` --- R/UserApiConsumer.R | 233 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 233 insertions(+) create mode 100644 R/UserApiConsumer.R diff --git a/R/UserApiConsumer.R b/R/UserApiConsumer.R new file mode 100644 index 0000000..39b86c5 --- /dev/null +++ b/R/UserApiConsumer.R @@ -0,0 +1,233 @@ +#' @include Helper.R Warning.R ContextFactory.R BarFactory.R + +#' @title +#' UserApiConsumer +#' +#' @description +#' This class is an opinionated interface around the developer API of the +#' [`parabar::parabar`] package. See the **Details** section for more +#' information on how this class works. +#' +#' @param ... Additional arguments to pass to the `fun` function. +#' +#' @details +#' This class acts as a wrapper around the [`R6::R6`] developer API of the +#' [`parabar::parabar`] package. In a nutshell, it provides an opinionated +#' interface by wrapping the developer API in simple functional calls. More +#' specifically, for executing a task in parallel, this class performs the +#' following steps: +#' - Validates the backend provided. +#' - Instantiates an appropriate [`parabar::parabar`] context based on the +#' backend. If the backend supports progress tracking (i.e., the backend is an +#' instance of [`parabar::AsyncBackend`]), a progress tracking context (i.e., +#' [`parabar::ProgressTrackingContext`]) is instantiated and used. Otherwise, +#' a regular context (i.e., [`parabar::Context`]) is instantiated. A regular +#' context is also used if the progress tracking is disabled via the +#' [`parabar::Options`] instance. +#' - Registers the [`backend`][`parabar::Backend`] with the context. +#' - Instantiates and configures the progress bar based on the +#' [`parabar::Options`] instance in the session [`base::.Options`] list. +#' - Executes the task in parallel, and displays a progress bar if appropriate. +#' - Fetches the results from the backend and returns them. +#' +#' @examples +#' # Define a simple task. +#' task <- function(x) { +#' # Perform computations. +#' Sys.sleep(0.01) +#' +#' # Return the result. +#' return(x + 1) +#' } +#' +#' # Start an asynchronous backend. +#' backend <- start_backend(cores = 2, cluster_type = "psock", backend_type = "async") +#' +#' # Change the progress bar options. +#' configure_bar(type = "modern", format = "[:bar] :percent") +#' +#' # Create an user API consumer. +#' consumer <- UserApiConsumer$new() +#' +#' # Execute the task using the `sapply` parallel operation. +#' output_sapply <- consumer$sapply(backend = backend, x = 1:200, fun = task) +#' +#' # Print the head of the `sapply` operation output. +#' head(output_sapply) +#' +#' # Execute the task using the `sapply` parallel operation. +#' output_lapply <- consumer$lapply(backend = backend, x = 1:200, fun = task) +#' +#' # Print the head of the `lapply` operation output. +#' head(output_lapply) +#' +#' # Stop the backend. +#' stop_backend(backend) +#' +#' @seealso +#' [parabar::start_backend()], [parabar::stop_backend()], +#' [parabar::configure_bar()], [parabar::par_sapply()], and +#' [parabar::par_lapply()]. +#' +#' @export +UserApiConsumer <- R6::R6Class("UserApiConsumer", + private = list( + # Execute a task via the user API with the corresponding operation. + .execute = function(backend, parallel_operation, sequential_operation) { + # If no backend is provided. + if (is.null(backend)) { + # Then use the non-parallel (i.e., sequential) operation. + output <- eval(sequential_operation) + + # Return results. + return(output) + + # Otherwise, if a backend is provided. + } else { + # Check the type. + Helper$check_object_type(backend, "Backend") + } + + # Get user warning settings. + user_options <- options() + + # Enable printing warnings as soon as they occur. + options(warn = 1) + + # Restore user's original settings. + on.exit({ + # Reset user's options. + options(user_options) + }) + + # Whether to track progress or not. + progress <- get_option("progress_track") + + # If the user requested progress tracking and the backend does not support it. + if (progress && !backend$supports_progress) { + # Warn the users. + Warning$progress_not_supported_for_backend(backend) + } + + # Create a context manager factory. + context_factory <- ContextFactory$new() + + # If progress is requested and the conditions are right. + if (progress && backend$supports_progress && interactive()) { + # Then use a progress-decorated context. + context <- context_factory$get("progress") + + # Progress bar type. + bar_type <- get_option("progress_bar_type") + + # Progress bar default configuration. + bar_config <- get_option("progress_bar_config")[[bar_type]] + + # Create a bar factory. + bar_factory <- BarFactory$new() + + # Get a bar of desired type. + bar <- bar_factory$get(bar_type) + + # Set the bar. + context$set_bar(bar) + + # Configure the bar. + do.call(context$configure_bar, bar_config) + + # Otherwise, if progress tracking is not requested, nor possible. + } else { + # Use a regular context. + context <- context_factory$get("regular") + } + + # Register the backend with the context. + context$set_backend(backend) + + # Register the backend with the context. + context$set_backend(backend) + + # Execute the task via the requested parallel operation. + eval(parallel_operation) + + # If the current context wraps a backend that supports progress tracking. + if (context$backend$supports_progress) { + # Then wait for the results. + output <- context$get_output(wait = TRUE) + } else { + # Otherwise, return the output whenever the task is finished. + output <- context$get_output() + } + + return(output) + } + ), + + public = list( + #' @description + #' Execute a task in parallel akin to [parallel::parSapply()]. + #' + #' @param backend An object of class [`parabar::Backend`] as returned by + #' the [parabar::start_backend()] function. It can also be `NULL` to run + #' the task sequentially via [base::sapply()]. + #' + #' @param x An atomic vector or list to pass to the `fun` function. + #' + #' @param fun A function to apply to each element of `x`. + #' + #' @return + #' A vector of the same length as `x` containing the results of the + #' `fun`. The output format resembles that of [base::sapply()]. + sapply = function(backend, x, fun, ...) { + # Prepare the sequential operation. + sequential <- bquote( + do.call( + base::sapply, c(list(X = .(x), FUN = .(fun)), .(list(...))) + ) + ) + + # Prepare the parallel operation. + parallel <- bquote( + do.call( + context$sapply, c(list(x = .(x), fun = .(fun)), .(list(...))) + ) + ) + + # Execute the `sapply` operation accordingly and return the results. + private$.execute(backend, parallel, sequential) + }, + + #' @description + #' Execute a task in parallel akin to [parallel::parLapply()]. + #' + #' @param backend An object of class [`parabar::Backend`] as returned by + #' the [parabar::start_backend()] function. It can also be `NULL` to run + #' the task sequentially via [base::lapply()]. + #' + #' @param x An atomic vector or list to pass to the `fun` function. + #' + #' @param fun A function to apply to each element of `x`. + #' + #' @return + #' A list of the same length as `x` containing the results of the `fun`. + #' The output format resembles that of [base::lapply()]. + lapply = function(backend, x, fun, ...) { + # Prepare the sequential operation. + sequential <- bquote( + do.call( + base::lapply, c(list(X = .(x), FUN = .(fun)), .(list(...))) + ) + ) + + # Prepare the parallel operation. + parallel <- bquote( + do.call( + context$lapply, c(list(x = .(x), fun = .(fun)), .(list(...))) + ) + ) + + # Execute the `lapply` operation accordingly and return the results. + private$.execute(backend, parallel, sequential) + } + ) +) From ad21b1b48dcd2377cb2214dfa9301d22fb34c88c Mon Sep 17 00:00:00 2001 From: mihaiconstantin Date: Wed, 3 May 2023 15:46:23 +0200 Subject: [PATCH 13/34] Refactor: update `par_sapply` to use the consumer `API` --- R/exports.r | 86 +++-------------------------------------------------- 1 file changed, 4 insertions(+), 82 deletions(-) diff --git a/R/exports.r b/R/exports.r index b136d78..cbe75c2 100644 --- a/R/exports.r +++ b/R/exports.r @@ -158,87 +158,9 @@ evaluate <- function(backend, expression) { #' @template par-sapply #' @export par_sapply <- function(backend = NULL, x, fun, ...) { - # If no backend is provided. - if (is.null(backend)) { - # Then use the built in, non-parallel `base::sapply`. - output <- base::sapply(X = x, FUN = fun, ...) - - # Return results. - return(output) - - # Otherwise, if a backend is provided. - } else { - # Check the type. - Helper$check_object_type(backend, "Backend") - } - - # Get user warning settings. - user_options <- options() - - # Enable printing warnings as soon as they occur. - options(warn = 1) - - # Restore user's original settings. - on.exit({ - # Reset user's options. - options(user_options) - }) - - # Whether to track progress or not. - progress <- get_option("progress_track") - - # If the user requested progress tracking and the backend does not support it. - if (progress && !backend$supports_progress) { - # Warn the users. - Warning$progress_not_supported_for_backend(backend) - } - - # Create a context manager factory. - context_factory <- ContextFactory$new() - - # If progress is requested and the conditions are right. - if (progress && backend$supports_progress && interactive()) { - # Then use a progress-decorated context. - context <- context_factory$get("progress") - - # Progress bar type. - bar_type <- get_option("progress_bar_type") - - # Progress bar default configuration. - bar_config <- get_option("progress_bar_config")[[bar_type]] - - # Create a bar factory. - bar_factory <- BarFactory$new() - - # Get a bar of desired type. - bar <- bar_factory$get(bar_type) - - # Set the bar. - context$set_bar(bar) - - # Configure the bar. - do.call(context$configure_bar, bar_config) - - # Otherwise, if progress tracking is not requested, nor possible. - } else { - # Use a regular context. - context <- context_factory$get("regular") - } - - # Register the backend with the context. - context$set_backend(backend) - - # Execute the task using the backend provided (i.e., aka context). - context$sapply(x = x, fun = fun, ...) - - # If the current context wraps a backend that supports progress tracking. - if (context$backend$supports_progress) { - # Then wait for the results. - output <- context$get_output(wait = TRUE) - } else { - # Otherwise, return the output whenever the task is finished. - output <- context$get_output() - } + # Create an user API consumer. + consumer <- UserApiConsumer$new() - return(output) + # Execute the task using the `sapply` parallel operation. + consumer$sapply(backend = backend, x = x, fun = fun, ...) } From cb37ada2f5c2900987c8d132be662a5c18e964b5 Mon Sep 17 00:00:00 2001 From: mihaiconstantin Date: Wed, 3 May 2023 15:47:04 +0200 Subject: [PATCH 14/34] Feat: add `par_lapply` exported function --- R/exports.r | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/R/exports.r b/R/exports.r index cbe75c2..e8338d7 100644 --- a/R/exports.r +++ b/R/exports.r @@ -164,3 +164,13 @@ par_sapply <- function(backend = NULL, x, fun, ...) { # Execute the task using the `sapply` parallel operation. consumer$sapply(backend = backend, x = x, fun = fun, ...) } + +#' @template par-lapply +#' @export +par_lapply <- function(backend = NULL, x, fun, ...) { + # Create an user API consumer. + consumer <- UserApiConsumer$new() + + # Execute the task using the `sapply` parallel operation. + consumer$lapply(backend = backend, x = x, fun = fun, ...) +} From 305f386441cac150a4db2fb1b87ce07ced8c656b Mon Sep 17 00:00:00 2001 From: mihaiconstantin Date: Wed, 3 May 2023 15:47:59 +0200 Subject: [PATCH 15/34] Docs: add documentation for `par_lapply` function --- man-roxygen/par-lapply.R | 89 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 89 insertions(+) create mode 100644 man-roxygen/par-lapply.R diff --git a/man-roxygen/par-lapply.R b/man-roxygen/par-lapply.R new file mode 100644 index 0000000..b103d14 --- /dev/null +++ b/man-roxygen/par-lapply.R @@ -0,0 +1,89 @@ +#' @title +#' Run a Task in Parallel +#' +#' @description +#' This function can be used to run a task in parallel. The task is executed in +#' parallel on the specified backend, similar to [parallel::parLapply()]. If +#' `backend = NULL`, the task is executed sequentially using [base::lapply()]. +#' See the **Details** section for more information on how this function works. +#' +#' @param backend An object of class [`parabar::Backend`] as returned by the +#' [parabar::start_backend()] function. It can also be `NULL` to run the task +#' sequentially via [base::lapply()]. The default value is `NULL`. +#' +#' @param x An atomic vector or list to pass to the `fun` function. +#' +#' @param fun A function to apply to each element of `x`. +#' +#' @param ... Additional arguments to pass to the `fun` function. +#' +#' @details +#' This function uses the [`parabar::UserApiConsumer`] class that acts like an +#' interface for the developer API of the [`parabar::parabar`] package. +#' +#' @return +#' A list of the same length as `x` containing the results of the `fun`. The +#' output format resembles that of [base::lapply()]. +#' +#' @examples +#' \donttest{ +#' +#' # Define a simple task. +#' task <- function(x) { +#' # Perform computations. +#' Sys.sleep(0.01) +#' +#' # Return the result. +#' return(x + 1) +#' } +#' +#' # Start an asynchronous backend. +#' backend <- start_backend(cores = 2, cluster_type = "psock", backend_type = "async") +#' +#' # Run a task in parallel. +#' results <- par_lapply(backend, x = 1:300, fun = task) +#' +#' # Disable progress tracking. +#' set_option("progress_track", FALSE) +#' +#' # Run a task in parallel. +#' results <- par_lapply(backend, x = 1:300, fun = task) +#' +#' # Enable progress tracking. +#' set_option("progress_track", TRUE) +#' +#' # Change the progress bar options. +#' configure_bar(type = "modern", format = "[:bar] :percent") +#' +#' # Run a task in parallel. +#' results <- par_lapply(backend, x = 1:300, fun = task) +#' +#' # Stop the backend. +#' stop_backend(backend) +#' +#' # Start a synchronous backend. +#' backend <- start_backend(cores = 2, cluster_type = "psock", backend_type = "sync") +#' +#' # Run a task in parallel. +#' results <- par_lapply(backend, x = 1:300, fun = task) +#' +#' # Disable progress tracking to remove the warning that progress is not supported. +#' set_option("progress_track", FALSE) +#' +#' # Run a task in parallel. +#' results <- par_lapply(backend, x = 1:300, fun = task) +#' +#' # Stop the backend. +#' stop_backend(backend) +#' +#' # Run the task using the `base::lapply` (i.e., non-parallel). +#' results <- par_lapply(NULL, x = 1:300, fun = task) +#' +#' } +#' +#' @seealso +#' [parabar::start_backend()], [parabar::peek()], [parabar::export()], +#' [parabar::evaluate()], [parabar::clear()], [parabar::configure_bar()], +#' [parabar::par_sapply()], [parabar::stop_backend()], [parabar::set_option()], +#' [parabar::get_option()], [`parabar::Options`], [`parabar::UserApiConsumer`], +#' and [`parabar::Service`]. From 85ae54a139c79dd0d215b60a9d5e61201bef8696 Mon Sep 17 00:00:00 2001 From: mihaiconstantin Date: Wed, 3 May 2023 15:48:33 +0200 Subject: [PATCH 16/34] Docs: update documentation for `par_sapply` function --- man-roxygen/par-sapply.R | 26 ++++++++------------------ 1 file changed, 8 insertions(+), 18 deletions(-) diff --git a/man-roxygen/par-sapply.R b/man-roxygen/par-sapply.R index fa3d23c..9361a55 100644 --- a/man-roxygen/par-sapply.R +++ b/man-roxygen/par-sapply.R @@ -11,30 +11,19 @@ #' [parabar::start_backend()] function. It can also be `NULL` to run the task #' sequentially via [base::sapply()]. The default value is `NULL`. #' -#' @param x A vector (i.e., usually of integers) to pass to the `fun` function. +#' @param x An atomic vector or list to pass to the `fun` function. #' #' @param fun A function to apply to each element of `x`. #' #' @param ... Additional arguments to pass to the `fun` function. #' #' @details -#' This function is a wrapper around the developer API of the -#' [`parabar::parabar`] package. More specifically, this function: -#' - Instantiates an appropriate [`parabar::parabar`] context. If the backend -#' supports progress tracking (i.e., the backend is an instance of -#' [`parabar::AsyncBackend`]), a progress tracking context (i.e., -#' [`parabar::ProgressTrackingContext`]) is instantiated and used. Otherwise, a -#' regular context (i.e., [`parabar::Context`]) is instantiated. A regular -#' context is also used if the progress tracking is disabled via the -#' [`parabar::Options`] instance. -#' - Registers the [`backend`][`parabar::Backend`] with the context. -#' - Instantiates and configures the progress bar based on the -#' [`parabar::Options`] instance in the session [`base::.Options`] list. -#' - Executes the task in parallel, and displays a progress bar if appropriate. +#' This function uses the [`parabar::UserApiConsumer`] class that acts like an +#' interface for the developer API of the [`parabar::parabar`] package. #' #' @return -#' A vector or list of the same length as `x` containing the results of the -#' `fun`. The output format resembles that of [base::sapply()]. +#' A vector of the same length as `x` containing the results of the `fun`. The +#' output format resembles that of [base::sapply()]. #' #' @examples #' \donttest{ @@ -95,5 +84,6 @@ #' @seealso #' [parabar::start_backend()], [parabar::peek()], [parabar::export()], #' [parabar::evaluate()], [parabar::clear()], [parabar::configure_bar()], -#' [parabar::stop_backend()], [parabar::set_option()], [parabar::get_option()], -#' [`parabar::Options`], and [`parabar::Service`]. +#' [parabar::par_lapply()], [parabar::stop_backend()], [parabar::set_option()], +#' [parabar::get_option()], [`parabar::Options`], [`parabar::UserApiConsumer`], +#' and [`parabar::Service`]. From 1a2709cec72936e4e81fe71c227d97305aa412c7 Mon Sep 17 00:00:00 2001 From: mihaiconstantin Date: Wed, 3 May 2023 15:49:22 +0200 Subject: [PATCH 17/34] Docs: update package docs to mention `par_lapply` --- man-roxygen/parabar.R | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) diff --git a/man-roxygen/parabar.R b/man-roxygen/parabar.R index 37e0957..faef123 100644 --- a/man-roxygen/parabar.R +++ b/man-roxygen/parabar.R @@ -9,7 +9,7 @@ #' solution for parallel processing in their packages. #' #' @section Users: -#' For the first category of users, [`parabar::parabar`] provides seven main +#' For the first category of users, [`parabar::parabar`] provides several main #' functions of interest: #' - [parabar::start_backend()]: creates a parallel backend for executing tasks #' according to the specifications provided. @@ -19,6 +19,10 @@ #' [base::sapply()] function when no backend is provided. However, when a #' backend is provided, the function will execute a task in parallel on the #' backend, similar to the built-in function [parallel::parSapply()]. +#' - [parabar::par_lapply()]: is a drop-in replacement for the built-in +#' [base::lapply()] function when no backend is provided. However, when a +#' backend is provided, the function will execute a task in parallel on the +#' backend, similar to the built-in function [parallel::parLapply()]. #' - [parabar::clear()]: removes all variables available on a backend. #' - [parabar::peek()]: returns the names of all variables available on a #' backend. @@ -56,7 +60,8 @@ #' [`start()`][parabar::Service], [`stop()`][parabar::Service], #' [`clear()`][parabar::Service], [`peek()`][parabar::Service], #' [`export()`][parabar::Service], [`evaluate()`][parabar::Service], -#' [`sapply()`][parabar::Service], and [`get_output()`][parabar::Service]. +#' [`sapply()`][parabar::Service], [`lapply()`][parabar::Service], and +#' [`get_output()`][parabar::Service]. #' #' Check out the documentation for [`parabar::Service`] for more information on #' each method. @@ -67,9 +72,9 @@ #' call to the corresponding backend method. However, a more complex context can #' augment the operation before forwarding the call to the backend. One example #' of a complex context is the [`parabar::ProgressTrackingContext`] class. This -#' class extends the regular [`parabar::Context`] class and decorates the -#' backend [`sapply()`][parabar::Service] operation to log the progress after -#' each task execution and display a progress bar. +#' class extends the regular [`parabar::Context`] class and decorates, for +#' example, the backend [`sapply()`][parabar::Service] operation to log the +#' progress after each task execution and display a progress bar. #' #' The following are the main classes provided by `parabar`: #' - [`parabar::Service`]: interface for backend operations. @@ -86,7 +91,8 @@ #' - [`parabar::BackendFactory`]: factory for creating backend objects. #' - [`parabar::Context`]: default context for executing backend operations. #' - [`parabar::ProgressTrackingContext`]: context for decorating the -#' [`sapply()`][parabar::Service] operation to track and display progress. +#' [`sapply()`][parabar::Service] and [`lapply()`][parabar::Service] +#' operations to track and display the execution progress. #' - [`parabar::ContextFactory`]: factory for creating context objects. #' #' @section Progress Bars: @@ -97,7 +103,7 @@ #' - [`parabar::BasicBar`]: a simple, but robust, bar created via #' [utils::txtProgressBar()] extending the [`parabar::Bar`] abstract class. #' - [`parabar::ModernBar`]: a modern bar created via [`progress::progress_bar`] -#' extending the [parabar::Bar] abstract class. +#' extending the [`parabar::Bar`] abstract class. #' - [`parabar::BarFactory`]: factory for creating bar objects. #' #' Finally, [`parabar::parabar`] uses several [base::options()] to configure the From 5f26f1a262a3a72119a8a4433736ce4f813ff58e Mon Sep 17 00:00:00 2001 From: mihaiconstantin Date: Wed, 3 May 2023 15:50:23 +0200 Subject: [PATCH 18/34] Docs: mention `par_lapply` in other `API` functions --- man-roxygen/clear.R | 2 +- man-roxygen/evaluate.R | 2 +- man-roxygen/export.R | 2 +- man-roxygen/peek.R | 2 +- man-roxygen/start-backend.R | 2 +- man-roxygen/stop-backend.R | 2 +- 6 files changed, 6 insertions(+), 6 deletions(-) diff --git a/man-roxygen/clear.R b/man-roxygen/clear.R index 6d9b2b0..61d6fa3 100644 --- a/man-roxygen/clear.R +++ b/man-roxygen/clear.R @@ -23,4 +23,4 @@ #' @seealso #' [parabar::start_backend()], [parabar::peek()], [parabar::export()], #' [parabar::evaluate()], [parabar::configure_bar()], [parabar::par_sapply()], -#' [parabar::stop_backend()], and [`parabar::Service`]. +#' [parabar::par_lapply()], [parabar::stop_backend()], and [`parabar::Service`]. diff --git a/man-roxygen/evaluate.R b/man-roxygen/evaluate.R index 277f4ee..88c6e0d 100644 --- a/man-roxygen/evaluate.R +++ b/man-roxygen/evaluate.R @@ -26,4 +26,4 @@ #' @seealso #' [parabar::start_backend()], [parabar::peek()], [parabar::export()], #' [parabar::clear()], [parabar::configure_bar()], [parabar::par_sapply()], -#' [parabar::stop_backend()], and [`parabar::Service`]. +#' [parabar::par_lapply()], [parabar::stop_backend()], and [`parabar::Service`]. diff --git a/man-roxygen/export.R b/man-roxygen/export.R index ee3770b..e751c45 100644 --- a/man-roxygen/export.R +++ b/man-roxygen/export.R @@ -29,4 +29,4 @@ #' @seealso #' [parabar::start_backend()], [parabar::peek()], [parabar::evaluate()], #' [parabar::clear()], [parabar::configure_bar()], [parabar::par_sapply()], -#' [parabar::stop_backend()], and [`parabar::Service`]. +#' [parabar::par_lapply()], [parabar::stop_backend()], and [`parabar::Service`]. diff --git a/man-roxygen/peek.R b/man-roxygen/peek.R index 6094290..88331f9 100644 --- a/man-roxygen/peek.R +++ b/man-roxygen/peek.R @@ -25,4 +25,4 @@ #' @seealso #' [parabar::start_backend()], [parabar::export()], [parabar::evaluate()], #' [parabar::clear()], [parabar::configure_bar()], [parabar::par_sapply()], -#' [parabar::stop_backend()], and [`parabar::Service`]. +#' [parabar::par_lapply()], [parabar::stop_backend()], and [`parabar::Service`]. diff --git a/man-roxygen/start-backend.R b/man-roxygen/start-backend.R index 4cbdc40..abcbbc8 100644 --- a/man-roxygen/start-backend.R +++ b/man-roxygen/start-backend.R @@ -120,4 +120,4 @@ #' @seealso #' [parabar::peek()], [parabar::export()], [parabar::evaluate()], #' [parabar::clear()], [parabar::configure_bar()], [parabar::par_sapply()], -#' [parabar::stop_backend()], and [`parabar::Service`]. +#' [parabar::par_lapply()], [parabar::stop_backend()], and [`parabar::Service`]. diff --git a/man-roxygen/stop-backend.R b/man-roxygen/stop-backend.R index 5b418f2..20563ee 100644 --- a/man-roxygen/stop-backend.R +++ b/man-roxygen/stop-backend.R @@ -26,4 +26,4 @@ #' @seealso #' [parabar::start_backend()], [parabar::peek()], [parabar::export()], #' [parabar::evaluate()], [parabar::clear()], [parabar::configure_bar()], -#' [parabar::par_sapply()], and [`parabar::Service`]. +#' [parabar::par_sapply()], [parabar::par_lapply()], and [`parabar::Service`]. From f4a587bb2a2c7feeaa3718d7f1ff1ff07eab9958 Mon Sep 17 00:00:00 2001 From: mihaiconstantin Date: Wed, 3 May 2023 15:51:25 +0200 Subject: [PATCH 19/34] Docs: update `README` to include `par_lapply` --- README.md | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index c6fc378..c9f3f46 100644 --- a/README.md +++ b/README.md @@ -270,6 +270,7 @@ can be performed on a backend. | export(backend, variables, environment) | Export objects to a backend. | | evaluate(backend, expression) | Evaluate expressions on a backend. | | par_sapply(backend, x, fun) | Run tasks in parallel on a backend. | +| par_lapply(backend, x, fun) | Run tasks in parallel on a backend. | Check the documentation corresponding to each operation for more information and examples. @@ -298,6 +299,7 @@ The `?Service` interface defines the following operations: - `export`: Export variables from a given environment to the backend. - `evaluate`: Evaluate an arbitrary expression on the backend. - `sapply`: Run a task on the backend. +- `lapply`: Run a task on the backend. - `get_output`: Get the output of the task execution. Check out the documentation for `Service` for more information on each method. @@ -369,8 +371,8 @@ backend <- backend_factory$get("async") backend$start(specification) ``` -Finally, we can run a task in parallel by calling the `sapply` method on the -`backend` instance. +Finally, we can run a task in parallel by calling, e.g., the `sapply` method on +the `backend` instance. ```r # Run a task in parallel. @@ -484,6 +486,10 @@ Check out the UML diagram below for a quick overview of the package design.

+**_Note._** For the sake of clarity, the diagram only displays the `sapply` +operation for running tasks in parallel. However, other operations are supported +as well (i.e., see table in the section *Additional Operations*). + ## Contributing - Any contributions are welcome and greatly appreciated. Please open a [pull request](https://github.com/mihaiconstantin/parabar/pulls) on `GitHub`. From 8e7c3ad6539949ca9b5ede5dd92ff5d00dd089e1 Mon Sep 17 00:00:00 2001 From: mihaiconstantin Date: Wed, 3 May 2023 15:52:21 +0200 Subject: [PATCH 20/34] Build: add `UserApiConsumer` to `Collate` in `DESCRIPTION` --- DESCRIPTION | 1 + 1 file changed, 1 insertion(+) diff --git a/DESCRIPTION b/DESCRIPTION index 3017287..362982e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -41,6 +41,7 @@ Collate: 'ProgressTrackingContext.R' 'ContextFactory.R' 'Warning.R' + 'UserApiConsumer.R' 'exports.r' 'logo.R' 'parabar-package.R' From 6c21fa70ed48e2485acafda356c8cee755daba70 Mon Sep 17 00:00:00 2001 From: mihaiconstantin Date: Wed, 3 May 2023 15:53:18 +0200 Subject: [PATCH 21/34] Build: update package imports and `NAMESPACE` --- NAMESPACE | 2 +- R/parabar-package.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 7edd5ec..4ef7702 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -41,7 +41,7 @@ importFrom(parallel,clusterEvalQ) importFrom(parallel,clusterExport) importFrom(parallel,detectCores) importFrom(parallel,makeCluster) -importFrom(parallel,parApply) +importFrom(parallel,parLapply) importFrom(parallel,parSapply) importFrom(parallel,stopCluster) importFrom(progress,progress_bar) diff --git a/R/parabar-package.R b/R/parabar-package.R index 7f57481..21a4fb5 100644 --- a/R/parabar-package.R +++ b/R/parabar-package.R @@ -17,7 +17,7 @@ # Imports. #' @importFrom parallel detectCores makeCluster stopCluster clusterExport -#' @importFrom parallel clusterEvalQ parSapply parApply clusterCall +#' @importFrom parallel clusterEvalQ parSapply parLapply clusterCall #' @importFrom R6 R6Class #' @importFrom progress progress_bar #' @importFrom callr r_session From 261706e68dda505dfcef606a9d1453d722564954 Mon Sep 17 00:00:00 2001 From: mihaiconstantin Date: Wed, 3 May 2023 15:54:24 +0200 Subject: [PATCH 22/34] Build: update `NAMESPACE` with new exports --- NAMESPACE | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 4ef7702..669ec08 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -19,6 +19,7 @@ export(Service) export(Specification) export(SyncBackend) export(TaskState) +export(UserApiConsumer) export(Warning) export(clear) export(configure_bar) @@ -26,6 +27,7 @@ export(evaluate) export(export) export(get_option) export(make_logo) +export(par_lapply) export(par_sapply) export(peek) export(set_default_options) From d1a781316c3bac78686cd67424d85351cada826a Mon Sep 17 00:00:00 2001 From: mihaiconstantin Date: Wed, 3 May 2023 15:55:58 +0200 Subject: [PATCH 23/34] Test: add and refactor test helpers --- tests/testthat/helpers.R | 517 ++++++++++++++++++++++++++++++++------- 1 file changed, 424 insertions(+), 93 deletions(-) diff --git a/tests/testthat/helpers.R b/tests/testthat/helpers.R index 2e63e60..99ad801 100644 --- a/tests/testthat/helpers.R +++ b/tests/testthat/helpers.R @@ -1,5 +1,7 @@ # Helpers for testing. +#region General test helpers. + # Helper for extracting the message associated with errors and warnings. as_text <- function(expression) { # Capture message. @@ -66,26 +68,49 @@ task_is_running <- function(backend) { return(status) } +#endregion -# Set of tests for synchronous backend operations. -tests_set_for_synchronous_backend_operations <- function(service, specification, task) { - # Start the cluster on the backend. - service$start(specification) - # Always stop on exit. - on.exit({ - # Stop the backend. - service$stop() - }) +#region Tests sets applicable to all backends types. - # Expect that the cluster is empty upon creation. - expect_true(all(sapply(service$peek(), length) == 0)) +# Set of tests for unimplemented service methods. +tests_set_for_unimplemented_service_methods <- function(service) { + # Expect an error when calling the `start` method. + expect_error(service$start(), as_text(Exception$method_not_implemented())) + + # Expect an error when calling the `stop` method. + expect_error(service$stop(), as_text(Exception$method_not_implemented())) + + # Expect an error when calling the `clear` method. + expect_error(service$clear(), as_text(Exception$method_not_implemented())) + + # Expect an error when calling the `peek` method. + expect_error(service$peek(), as_text(Exception$method_not_implemented())) + + # Expect an error when calling the `export` method. + expect_error(service$export(), as_text(Exception$method_not_implemented())) + + # Expect an error when calling the `evaluate` method. + expect_error(service$evaluate(), as_text(Exception$method_not_implemented())) + + # Expect an error when calling the `sapply` method. + expect_error(service$sapply(), as_text(Exception$method_not_implemented())) + + # Expect an error when calling the `lapply` method. + expect_error(service$lapply(), as_text(Exception$method_not_implemented())) + + # Expect an error when calling the `get_output` method. + expect_error(service$get_output(), as_text(Exception$method_not_implemented())) +} - # Create a variable in a new environment. + +# Set of tests for exporting to the backend (i.e,. regardless of type). +tests_set_for_backend_exporting <- function(service) { + # Create a variable in a different environment. env <- new.env() env$test_variable <- rnorm(1) - # Export the variable from the environment to the backend. + # Export the variable from the specific environment to the backend. service$export("test_variable", env) # Expect that the variable is on the backend. @@ -94,37 +119,70 @@ tests_set_for_synchronous_backend_operations <- function(service, specification, # Expect the cluster to hold the correct value for the exported variable. expect_true(all(service$evaluate(test_variable) == env$test_variable)) - # Clear the backend. - service$clear() + # Assign a variable to the current environment. + assign("test_variable", rnorm(1), envir = environment()) - # Expect that clearing the cluster leaves it empty. - expect_true(all(sapply(service$peek(), length) == 0)) + # Export the variable using the current environment (i.e., parent of `export`). + service$export("test_variable") - # Select task arguments for the `sapply` operation. - x <- sample(1:100, 100) - y <- sample(1:100, 1) - z <- sample(1:100, 1) - sleep = sample(c(0, 0.001, 0.002), 1) + # Expect that the variable is on the backend. + expect_true(all(service$peek() == "test_variable")) + + # Expect the cluster to hold the correct value for the exported variable. + expect_true(all(service$evaluate(test_variable) == get("test_variable", envir = environment()))) +} - # Run the task in parallel. - service$sapply(x, task, y = y, z = z, sleep = sleep) + +# Set of tests for starting and stopping backends. +tests_set_for_backend_states <- function(backend, specification) { + # Expect an error if an attempt is made to start a cluster while one is already active. + expect_error(backend$start(specification), as_text(Exception$cluster_active())) + + # Stop the backend. + backend$stop() + + # Expect that stopping the cluster marks it as inactive. + expect_false(backend$active) + + # Expect the cluster field has been cleared. + expect_null(backend$cluster) + + # Start a new cluster on the same backend instance. + backend$start(specification) + + # Expect the cluster is active. + expect_true(backend$active) + + # Stop the cluster. + backend$stop() + + # Expect that trying to stop a cluster that is not active throws an error. + expect_error(backend$stop(), as_text(Exception$cluster_not_active())) +} + +#endregion + + +#region Tests sets for synchronous backends. + +# Set of tests for the synchronous backend task execution via a specified operation. +tests_set_for_synchronous_backend_task_execution <- function(operation, service, expected_output) { + # Run the task in parallel via the requested operation (e.g., `sapply`). + eval(operation) # Expect the that output is correct. - expect_equal(service$get_output(), task(x, y, z)) + expect_equal(service$get_output(), expected_output) # Expect that subsequent calls to `get_output` return `NULL`. expect_null(service$get_output()) - # Expect that the cluster is empty after performing operations on it. - expect_true(all(sapply(service$peek(), length) == 0)) - # Remain silent. invisible(NULL) } # Set of tests for synchronous backend operations. -tests_set_for_asynchronous_backend_operations <- function(service, specification, task) { +tests_set_for_synchronous_backend_operations <- function(service, specification, task) { # Start the cluster on the backend. service$start(specification) @@ -137,34 +195,55 @@ tests_set_for_asynchronous_backend_operations <- function(service, specification # Expect that the cluster is empty upon creation. expect_true(all(sapply(service$peek(), length) == 0)) - # Create a variable in a new environment. - env <- new.env() - env$test_variable <- rnorm(1) - - # Export the variable from the environment to the backend. - service$export("test_variable", env) + # Tests for exporting to the backend. + tests_set_for_backend_exporting(service) - # Expect that the variable is on the backend. - expect_true(all(service$peek() == "test_variable")) - - # Expect the cluster to hold the correct value for the exported variable. - expect_true(all(service$evaluate(test_variable) == env$test_variable)) + # Clear the backend. + service$clear() # Expect that clearing the cluster leaves it empty. - service$clear() expect_true(all(sapply(service$peek(), length) == 0)) - # Select task arguments for the `sapply` operation. + # Select task arguments. x <- sample(1:100, 100) y <- sample(1:100, 1) z <- sample(1:100, 1) sleep = sample(c(0, 0.001, 0.002), 1) - # Compute the correct output. + # Created the expect output. expected_output <- task(x, y, z) + # Define the `sapply` operation. + operation <- bquote(service$sapply(.(x), .(task), y = .(y), z = .(z), sleep = .(sleep))) + + # Tests for the `sapply` operation. + tests_set_for_synchronous_backend_task_execution(operation, service, expected_output) + + # Created the expect output. + expected_output <- as.list(expected_output) + + # Define the `lapply` operation. + operation <- bquote(service$lapply(.(x), .(task), y = .(y), z = .(z), sleep = .(sleep))) + + # Tests for the `lapply` operation. + tests_set_for_synchronous_backend_task_execution(operation, service, expected_output) + + # Expect that the cluster is empty after performing operations on it. + expect_true(all(sapply(service$peek(), length) == 0)) + + # Remain silent. + invisible(NULL) +} + +#endregion + + +#region Tests sets for asynchronous backends. + +# Set of tests for the asynchronous backend task execution via a specified operation. +tests_set_for_asynchronous_backend_task_execution <- function(operation, service, expected_output) { # Run the task in parallel. - service$sapply(x, task, y = y, z = z) + eval(operation) # Expect the that output is correct. expect_equal(service$get_output(wait = TRUE), expected_output) @@ -173,16 +252,16 @@ tests_set_for_asynchronous_backend_operations <- function(service, specification expect_error(service$get_output(), as_text(Exception$async_task_not_started())) # Run the task in parallel, with a bit of overhead. - service$sapply(x, task, y = y, z = z, sleep = sleep) + eval(operation) # Expect that trying to run a task while another is running fails. - expect_error(service$sapply(x, task, y = y, z = z), as_text(Exception$async_task_running())) + expect_error(eval(operation), as_text(Exception$async_task_running())) # Expect the that output is correct. expect_equal(service$get_output(wait = TRUE), expected_output) - # Run the task in parallel. - service$sapply(x, task, y = y, z = z, sleep = sleep) + # Run the task in parallel, with a bit of overhead. + eval(operation) # Expect that trying to get the output of a task that is still running fails. expect_error(service$get_output(), as_text(Exception$async_task_running())) @@ -194,10 +273,62 @@ tests_set_for_asynchronous_backend_operations <- function(service, specification } # Expect that trying to run a task without reading the previous output fails. - expect_error(service$sapply(data, task, add = add), as_text(Exception$async_task_completed())) + expect_error(eval(operation), as_text(Exception$async_task_completed())) # Expect the that output is correct. expect_equal(service$get_output(), expected_output) +} + + +# Set of tests for synchronous backend operations. +tests_set_for_asynchronous_backend_operations <- function(service, specification, task) { + # Start the cluster on the backend. + service$start(specification) + + # Always stop on exit. + on.exit({ + # Stop the backend. + service$stop() + }) + + # Expect that the cluster is empty upon creation. + expect_true(all(sapply(service$peek(), length) == 0)) + + # Tests for the `export` operation. + tests_set_for_backend_exporting(service) + + # Clear the backend. + service$clear() + + # Expect that clearing the cluster leaves it empty. + expect_true(all(sapply(service$peek(), length) == 0)) + + # Expect error waiting to fetch the output when no task is running. + expect_error(service$get_output(wait = TRUE), as_text(Exception$async_task_not_started())) + + # Select task arguments. + x <- sample(1:100, 100) + y <- sample(1:100, 1) + z <- sample(1:100, 1) + sleep = sample(c(0, 0.001, 0.002), 1) + + # Compute the expected output for the `sapply` operation. + expected_output <- task(x, y, z) + + # Define the `sapply` operation. + operation <- bquote(service$sapply(.(x), .(task), y = .(y), z = .(z), sleep = .(sleep))) + + # Tests for the `sapply` operation. + tests_set_for_asynchronous_backend_task_execution(operation, service, expected_output) + + # Compute the expected output for the `lapply` operation. + expected_output <- as.list(expected_output) + + # Define the `lapply` operation. + operation <- bquote(service$lapply(.(x), .(task), y = .(y), z = .(z), sleep = .(sleep))) + + # Tests for the `lapply` operation. + tests_set_for_asynchronous_backend_task_execution(operation, service, expected_output) # Expect that the cluster is empty after performing operations on it. expect_true(all(sapply(service$peek(), length) == 0)) @@ -206,62 +337,100 @@ tests_set_for_asynchronous_backend_operations <- function(service, specification invisible(NULL) } +#endregion -# Set of tests for starting and stopping backends. -tests_set_for_backend_states <- function(backend, specification) { - # Expect an error if an attempt is made to start a cluster while one is already active. - expect_error(backend$start(specification), as_text(Exception$cluster_active())) - # Stop the backend. - backend$stop() +#region Tests sets for progress tracking. - # Expect that stopping the cluster marks it as inactive. - expect_false(backend$active) +# Set of tests for executing tasks in a progress tracking context with output. +tests_set_for_task_execution_with_progress_tracking <- function(operation, context, expected_output) { + # Clear the progress output on exit. + on.exit({ + # Clear the output. + context$progress_bar_output <- NULL + }) - # Expect the cluster field has been cleared. - expect_null(backend$cluster) + # Create a bar factory. + bar_factory <- BarFactory$new() - # Start a new cluster on the same backend instance. - backend$start(specification) + # Get a basic bar instance. + bar <- bar_factory$get("basic") - # Expect the cluster is active. - expect_true(backend$active) + # Register the bar with the context object. + context$set_bar(bar) - # Stop the cluster. - backend$stop() + # Configure the bar. + context$configure_bar( + style = 3 + ) - # Expect that trying to stop a cluster that is not active throws an error. - expect_error(backend$stop(), as_text(Exception$cluster_not_active())) -} + # Run the task in parallel. + eval(operation) + # Expect that the task output is correct. + expect_equal(context$get_output(wait = TRUE), expected_output) -# Set of tests for unimplemented service methods. -tests_set_for_unimplemented_service_methods <- function(service) { - # Expect an error when calling the `start` method. - expect_error(service$start(), as_text(Exception$method_not_implemented())) + # Expect the progress bar was shown correctly. + expect_true(any(grepl("=\\| 100%", context$progress_bar_output))) - # Expect an error when calling the `stop` method. - expect_error(service$stop(), as_text(Exception$method_not_implemented())) + # Get a modern bar instance. + bar <- bar_factory$get("modern") - # Expect an error when calling the `clear` method. - expect_error(service$clear(), as_text(Exception$method_not_implemented())) + # Register the bar with the same context object. + context$set_bar(bar) - # Expect an error when calling the `peek` method. - expect_error(service$peek(), as_text(Exception$method_not_implemented())) + # Configure the bar. + context$configure_bar( + show_after = 0, + format = ":bar| :percent", + clear = FALSE, + force = TRUE + ) - # Expect an error when calling the `export` method. - expect_error(service$export(), as_text(Exception$method_not_implemented())) + # Run the task in parallel. + eval(operation) - # Expect an error when calling the `evaluate` method. - expect_error(service$evaluate(), as_text(Exception$method_not_implemented())) + # Expect that the task output is correct. + expect_equal(context$get_output(wait = TRUE), expected_output) - # Expect an error when calling the `sapply` method. - expect_error(service$sapply(), as_text(Exception$method_not_implemented())) + # Expect the progress bar was shown correctly. + expect_true(any(grepl("=\\| 100%", context$progress_bar_output))) +} - # Expect an error when calling the `get_output` method. - expect_error(service$get_output(), as_text(Exception$method_not_implemented())) +# Set of tests for progress tracking context. +tests_set_for_progress_tracking_context <- function(context, task) { + # Check the type. + Helper$check_object_type(context, "ProgressTrackingContextTester") + + # Select task arguments. + x <- sample(1:100, 100) + y <- sample(1:100, 1) + z <- sample(1:100, 1) + sleep = sample(c(0, 0.001, 0.002), 1) + + # Create the expected output for the `sapply` operation. + expected_output <- task(x, y, z) + + # Create the `sapply` operation. + operation <- bquote(context$sapply(.(x), .(task), y = .(y), z = .(z), sleep = .(sleep))) + + # Tests for the `sapply` operation in a progress tracking context. + tests_set_for_task_execution_with_progress_tracking(operation, context, expected_output) + + # Create the expected output for the `lapply` operation. + expected_output <- as.list(expected_output) + + # Create the `lapply` operation. + operation <- bquote(context$lapply(.(x), .(task), y = .(y), z = .(z), sleep = .(sleep))) + + # Tests for the `lapply` operation in a progress tracking context. + tests_set_for_task_execution_with_progress_tracking(operation, context, expected_output) } +#endregion + + +#region Tests sets for the user API. # Set of tests for creating backends via the user API. tests_set_for_backend_creation_via_user_api <- function(cluster_type, backend_type) { @@ -289,6 +458,133 @@ tests_set_for_backend_creation_via_user_api <- function(cluster_type, backend_ty } +# Set of tests for task execution via the user API. +tests_set_for_user_api_task_execution <- function(parallel, sequential, expected_output) { + # Clean-up. + on.exit({ + # Set default values for package options. + set_default_options() + }) + + # Select a cluster type. + cluster_type <- pick_cluster_type(Specification$new()$types) + + # Disable progress tracking. + set_option("progress_track", FALSE) + + # Create a synchronous backend. + backend <- start_backend( + cores = 2, + cluster_type = cluster_type, + backend_type = "sync" + ) + + # Expect the output of the task ran in parallel to be correct. + expect_equal(eval(parallel), expected_output) + + # Enable progress tracking. + set_option("progress_track", TRUE) + + # Expect warning for requesting progress tracking with incompatible backend. + expect_warning( + eval(parallel), + as_text(Warning$progress_not_supported_for_backend(backend)) + ) + + # Stop the synchronous backend. + stop_backend(backend) + + # Create an asynchronous backend. + backend <- start_backend( + cores = 2, + cluster_type = cluster_type, + backend_type = "async" + ) + + # Expect the output to be correct. + expect_equal(eval(parallel), expected_output) + + # Disable progress tracking. + set_option("progress_track", FALSE) + + # Expect the output to be correct. + expect_equal(eval(parallel), expected_output) + + # Stop the asynchronous backend. + stop_backend(backend) + + # Expect the task to produce correct output when ran sequentially. + expect_equal(eval(sequential), expected_output) +} + + +# Set of tests for progress tracking via the user API. +tests_set_for_user_api_progress_tracking <- function(operation) { + # Pick a cluster type. + cluster_type <- pick_cluster_type(Specification$new()$types) + + # Create an asynchronous backend. + backend <- start_backend( + cores = 2, + cluster_type = cluster_type, + backend_type = "async" + ) + + # Clean-up on exit. + on.exit({ + # Stop the backend. + stop_backend(backend) + + # Restore the default options. + set_default_options() + }) + + # Configure modern bar. + configure_bar( + type = "modern", + force = TRUE, + clear = FALSE + ) + + # Redirect output. + sink("/dev/null", type = "output") + + # Run the task and capture the progress bar output. + output <- capture.output({ eval(operation) }, type = "message") + + # Remove output redirection. + sink(NULL) + + # Expect the progress bar to be shown correctly. + expect_true(grepl("tasks \\[100%\\]", paste0(output, collapse = ""), perl = TRUE)) + + # Configure the basic bar. + configure_bar( + type = "basic", + style = 3 + ) + + # Run the task and capture the progress bar output. + output <- capture.output({ eval(operation) }, type = "output") + + # Expect the progress bar to be shown correctly. + expect_true(grepl("=\\| 100%", paste0(output, collapse = ""), perl = TRUE)) + + # Disable progress tracking. + set_option("progress_track", FALSE) + + # Run the task and capture the output without the progress bar. + output <- capture.output({ eval(operation) }, type = "output") + + # Expect the progress bar to be missing from the output. + expect_false(grepl("=\\| 100%", paste0(output, collapse = ""), perl = TRUE)) +} + +#endregion + + +#region Helper `R6` classes for testing. + # Helper for testing private methods of `Specification` class. SpecificationTester <- R6::R6Class("SpecificationTester", inherit = Specification, @@ -340,12 +636,9 @@ BackendImplementation <- R6::R6Class("BackendImplementation", ProgressTrackingContextTester <- R6::R6Class("ProgressTrackingContextTester", inherit = ProgressTrackingContext, - public = list( - # The progress bar output used for testing. - progress_bar_output = NULL, - - # Implementation for the `sapply` method preserving the log file. - sapply = function(x, fun, ...) { + private = list( + # Wrapper for executing task operations with progress output capturing. + .execute_and_capture_progress = function(operation) { # Create a text connection. connection <- textConnection("output", open = "w", local = TRUE) @@ -364,13 +657,49 @@ ProgressTrackingContextTester <- R6::R6Class("ProgressTrackingContextTester", }) # Execute the task. - super$sapply(x, fun, ...) + eval(operation) # Store the progress bar output on the instance. self$progress_bar_output <- output } ), + public = list( + # The progress bar output used for testing. + progress_bar_output = NULL, + + # Implementation for the `sapply` method capturing the progress output. + sapply = function(x, fun, ...) { + # Define the operation. + operation <- bquote( + do.call( + super$sapply, c(list(.(x), .(fun)), .(list(...))) + ) + ) + + # Execute the task via the operation and capture the progress output. + private$.execute_and_capture_progress(operation) + }, + + # Implementation for the `lapply` method capturing the progress output. + lapply = function(x, fun, ...) { + # Define the operation. + operation <- bquote( + do.call( + super$lapply, c(list(.(x), .(fun)), .(list(...))) + ) + ) + + # Execute the task via the operation and capture the progress output. + private$.execute_and_capture_progress(operation) + }, + + # Wrapper to expose `.make_log` for testing. + make_log = function() { + private$.make_log() + } + ), + active = list( # Expose the bar configuration. bar_config = function() { return(private$.bar_config) } @@ -387,3 +716,5 @@ BarImplementation <- R6::R6Class("BarImplementation", initialize = function() {} ) ) + +#endregion From d0c2828949e3dfd34007d72ec9ef325e4114c2e9 Mon Sep 17 00:00:00 2001 From: mihaiconstantin Date: Wed, 3 May 2023 15:56:20 +0200 Subject: [PATCH 24/34] Test: update test for `AsyncBackend` class --- tests/testthat/test-async-backend.R | 3 +++ 1 file changed, 3 insertions(+) diff --git a/tests/testthat/test-async-backend.R b/tests/testthat/test-async-backend.R index 67f38e0..bb3ec3a 100644 --- a/tests/testthat/test-async-backend.R +++ b/tests/testthat/test-async-backend.R @@ -36,6 +36,9 @@ test_that("'AsyncBackend' creates and manages clusters correctly", { # Test backend states. tests_set_for_backend_states(backend, specification) + + # Expect error attempting to get the cluster state for an inactive backend. + expect_error(backend$task_state, as_text(Exception$cluster_not_active())) }) From 1a1e7601992b3f42de5354f912f9e8a4046513c4 Mon Sep 17 00:00:00 2001 From: mihaiconstantin Date: Wed, 3 May 2023 15:57:18 +0200 Subject: [PATCH 25/34] Test: update tests for `ProgressTrackingContext` class --- .../testthat/test-progress-tracking-context.R | 110 +++++++++--------- 1 file changed, 56 insertions(+), 54 deletions(-) diff --git a/tests/testthat/test-progress-tracking-context.R b/tests/testthat/test-progress-tracking-context.R index 397d1bb..100bad8 100644 --- a/tests/testthat/test-progress-tracking-context.R +++ b/tests/testthat/test-progress-tracking-context.R @@ -33,7 +33,7 @@ test_that("'ProgressTrackingContext' sets the backend correctly", { }) -test_that("'ProgressTrackingContext' sets progress bars correctly", { +test_that("'ProgressTrackingContext' sets the progress bar correctly", { # Create a bar factory. bar_factory <- BarFactory$new() @@ -90,16 +90,61 @@ test_that("'ProgressTrackingContext' configures the progress bar correctly", { }) -test_that("'ProgressTrackingContext' executes the task in parallel correctly", { - # Select task arguments for the `sapply` operation. - x <- sample(1:100, 100) - y <- sample(1:100, 1) - z <- sample(1:100, 1) - sleep = sample(c(0, 0.001, 0.002), 1) +test_that("'ProgressTrackingContext' correctly creates log files.", { + # Reset default package options on exit. + on.exit({ + # Set defaults. + set_default_options() + }) + + # Create a progress tracking context object. + context <- ProgressTrackingContextTester$new() + + # Create a log file with a randomly generated path. + path <- context$make_log() + + # Expect that the file exist at the used path. + expect_true(file.exists(path)) + + # Remove the file. + file.remove(path) + + # Pick a specific log path. + log_path <- tempfile(pattern = "progress_log") + + # Fix the log path. + set_option("progress_log_path", log_path) + + # Create a log file with the fixed log path. + path <- context$make_log() + + # Expect that the correct log path was used. + expect_equal(log_path, path) + + # Expect that the log file was created at the fixed path. + expect_true(file.exists(path)) - # Compute the correct output. - expected_output <- test_task(x, y, z) + # Remove the file. + file.remove(path) + # Pick an absurd path for the log file. + log_path_absurd <- "/absurd/log/file/path" + + # Fix the log path to the absurd value. + set_option("progress_log_path", log_path_absurd) + + # Expect error when failing to create the log file. + expect_error( + context$make_log(), + as_text(Exception$temporary_file_creation_failed(log_path_absurd)) + ) + + # Expect that the log file was not created at the absurd path. + expect_false(file.exists(log_path_absurd)) +}) + + +test_that("'ProgressTrackingContext' executes the task in parallel correctly", { # Create a specification. specification <- Specification$new() @@ -124,51 +169,8 @@ test_that("'ProgressTrackingContext' executes the task in parallel correctly", { # Start the backend. context$start(specification) - # Create a bar factory. - bar_factory <- BarFactory$new() - - # Get a basic bar instance. - bar <- bar_factory$get("basic") - - # Register the bar with the context object. - context$set_bar(bar) - - # Configure the bar. - context$configure_bar( - style = 3 - ) - - # Run the task in parallel. - context$sapply(x, test_task, y = y, z = z, sleep = sleep) - - # Expect that the task output is correct. - expect_equal(context$get_output(wait = TRUE), expected_output) - - # Expect the progress bar was shown correctly. - expect_true(any(grepl("=\\| 100%", context$progress_bar_output))) - - # Get a modern bar instance. - bar <- bar_factory$get("modern") - - # Register the bar with the same context object. - context$set_bar(bar) - - # Configure the bar. - context$configure_bar( - show_after = 0, - format = ":bar| :percent", - clear = FALSE, - force = TRUE - ) - - # Run the task in parallel. - context$sapply(x, test_task, y = y, z = z, sleep = sleep) - - # Expect that the task output is correct. - expect_equal(context$get_output(wait = TRUE), expected_output) - - # Expect the progress bar was shown correctly. - expect_true(any(grepl("=\\| 100%", context$progress_bar_output))) + # Expect correctly executed tasks and logged progress. + tests_set_for_progress_tracking_context(context, test_task) # Stop the backend. context$stop() From 093aefe694074037d639ffef6998953ad0a905de Mon Sep 17 00:00:00 2001 From: mihaiconstantin Date: Wed, 3 May 2023 15:57:46 +0200 Subject: [PATCH 26/34] Test: update tests for the user `API` functions --- tests/testthat/test-user-api.R | 166 ++++++++------------------------- 1 file changed, 37 insertions(+), 129 deletions(-) diff --git a/tests/testthat/test-user-api.R b/tests/testthat/test-user-api.R index 129487c..e27fe9e 100644 --- a/tests/testthat/test-user-api.R +++ b/tests/testthat/test-user-api.R @@ -223,7 +223,12 @@ test_that("user API functions handle incompatible input correctly", { ) expect_error( - par_sapply(backend), + par_sapply(backend, NULL, NULL), + as_text(Exception$type_not_assignable(class(backend), "Backend")) + ) + + expect_error( + par_lapply(backend, NULL, NULL), as_text(Exception$type_not_assignable(class(backend), "Backend")) ) }) @@ -278,156 +283,59 @@ test_that("user API functions handle backend operations correctly", { }) -test_that("'par_sapply' correctly runs tasks in parallel", { - # Clean-up. - on.exit({ - # Set default values for package options. - set_default_options() - }) - - # Select task arguments for the `sapply` operation. +test_that("user API functions run tasks in parallel correctly", { + # Select task arguments. x <- sample(1:100, 100) y <- sample(1:100, 1) z <- sample(1:100, 1) sleep = sample(c(0, 0.001, 0.002), 1) - # Compute the correct output. + # Compute the expected output for the `par_sapply` user API function. expected_output <- test_task(x, y, z) - # Select a cluster type. - cluster_type <- pick_cluster_type(Specification$new()$types) - - # Disable progress tracking. - set_option("progress_track", FALSE) - - # Create a synchronous backend. - backend <- start_backend( - cores = 2, - cluster_type = cluster_type, - backend_type = "sync" + # Define the `par_sapply` parallel operation. + parallel_sapply <- bquote( + par_sapply(backend, x = .(x), fun = test_task, .(y), .(z), sleep = .(sleep)), ) - # Expect the output of the task ran in parallel to be correct. - expect_equal( - par_sapply(backend, x = x, fun = test_task, y, z, sleep = sleep), - expected_output + # Define the `par_sapply` sequential operation. + sequential_sapply <- bquote( + par_sapply(backend = NULL, x = .(x), fun = test_task, .(y), .(z)), ) - # Enable progress tracking. - set_option("progress_track", TRUE) + # Expect the `par_sapply` to run the task in parallel correctly. + tests_set_for_user_api_task_execution(parallel_sapply, sequential_sapply, expected_output) - # Expect warning for requesting progress tracking with incompatible backend. - expect_warning( - par_sapply(backend, x = x, fun = test_task, y, z, sleep = sleep), - as_text(Warning$progress_not_supported_for_backend(backend)) - ) - - # Stop the synchronous backend. - stop_backend(backend) + # Compute the expected output for the `par_lapply` user API function. + expected_output <- as.list(expected_output) - # Create an asynchronous backend. - backend <- start_backend( - cores = 2, - cluster_type = cluster_type, - backend_type = "async" + # Define the `par_lapply` parallel operation. + parallel_lapply <- bquote( + par_lapply(backend, x = .(x), fun = test_task, .(y), .(z), sleep = .(sleep)), ) - # Expect the output to be correct. - expect_equal( - par_sapply(backend, x = x, fun = test_task, y, z, sleep = sleep), - expected_output + # Define the `par_lapply` sequential operation. + sequential_lapply <- bquote( + par_lapply(backend = NULL, x = .(x), fun = test_task, .(y), .(z)), ) - # Disable progress tracking. - set_option("progress_track", FALSE) - - # Expect the output to be correct. - expect_equal( - par_sapply(backend, x = x, fun = test_task, y, z, sleep = sleep), - expected_output - ) - - # Stop the asynchronous backend. - stop_backend(backend) - - # Expect the task to produce correct output when ran sequentially. - expect_equal( - par_sapply(backend = NULL, x = x, fun = test_task, y, z), - expected_output - ) + # Expect the `par_lapply` to run the task in parallel correctly. + tests_set_for_user_api_task_execution(parallel_lapply, sequential_lapply, expected_output) }) -test_that("'par_sapply' tracks progress correctly", { +test_that("user API functions track progress correctly", { # Run the test only in interactive contexts. if (interactive()) { - # Pick a cluster type. - cluster_type <- pick_cluster_type(Specification$new()$types) - - # Create an asynchronous backend. - backend <- start_backend( - cores = 2, - cluster_type = cluster_type, - backend_type = "async" - ) - - # Clean-up on exit. - on.exit({ - # Stop the backend. - stop_backend(backend) - - # Restore the default options. - set_default_options() - }) - - # Configure modern bar. - configure_bar( - type = "modern", - force = TRUE, - clear = FALSE - ) - - # Redirect output. - sink("/dev/null", type = "output") - - # Run the task and capture the progress bar output. - output <- capture.output({ - par_sapply(backend, x = 1:100, fun = test_task, 1, 2) - }, type = "message" - ) - - # Remove output redirection. - sink(NULL) - - # Expect the progress bar to be shown correctly. - expect_true(grepl("tasks \\[100%\\]", paste0(output, collapse = ""), perl = TRUE)) - - # Configure the basic bar. - configure_bar( - type = "basic", - style = 3 - ) - - # Run the task and capture the progress bar output. - output <- capture.output({ - par_sapply(backend, x = 1:100, fun = test_task, 1, 2) - }, type = "output" - ) - - # Expect the progress bar to be shown correctly. - expect_true(grepl("=\\| 100%", paste0(output, collapse = ""), perl = TRUE)) - - # Disable progress tracking. - set_option("progress_track", FALSE) - - # Run the task and capture the output without the progress bar. - output <- capture.output({ - par_sapply(backend, x = 1:100, fun = test_task, 1, 2) - }, type = "output" - ) - - # Expect the progress bar to be missing from the output. - expect_false(grepl("=\\| 100%", paste0(output, collapse = ""), perl = TRUE)) + # Expect progress tracking is displayed correctly via `par_sapply`. + tests_set_for_user_api_progress_tracking(bquote( + par_sapply(backend, x = 1:100, fun = test_task, 1, 2) + )) + + # Expect progress tracking is displayed correctly via `par_lapply`. + tests_set_for_user_api_progress_tracking(bquote( + par_lapply(backend, x = 1:100, fun = test_task, 1, 2) + )) } else { skip("Test only runs in interactive contexts.") } From 75746e22731b76de0d2066745bcbbe3a52365a8e Mon Sep 17 00:00:00 2001 From: mihaiconstantin Date: Wed, 3 May 2023 16:02:22 +0200 Subject: [PATCH 27/34] Docs: regenerate `.Rd` man files --- man/AsyncBackend.Rd | 36 +++++++- man/Backend.Rd | 1 + man/Context.Rd | 36 +++++++- man/ProgressTrackingContext.Rd | 31 ++++++- man/Service.Rd | 36 +++++++- man/SyncBackend.Rd | 36 +++++++- man/UserApiConsumer.Rd | 156 +++++++++++++++++++++++++++++++++ man/clear.Rd | 2 +- man/evaluate.Rd | 2 +- man/export.Rd | 2 +- man/par_lapply.Rd | 97 ++++++++++++++++++++ man/par_sapply.Rd | 28 ++---- man/parabar-package.Rd | 20 +++-- man/peek.Rd | 2 +- man/start_backend.Rd | 2 +- man/stop_backend.Rd | 2 +- 16 files changed, 438 insertions(+), 51 deletions(-) create mode 100644 man/UserApiConsumer.Rd create mode 100644 man/par_lapply.Rd diff --git a/man/AsyncBackend.Rd b/man/AsyncBackend.Rd index e96cde8..1f0311a 100644 --- a/man/AsyncBackend.Rd +++ b/man/AsyncBackend.Rd @@ -124,6 +124,7 @@ has been fetched, the backend is free to deploy another task. \item \href{#method-AsyncBackend-export}{\code{AsyncBackend$export()}} \item \href{#method-AsyncBackend-evaluate}{\code{AsyncBackend$evaluate()}} \item \href{#method-AsyncBackend-sapply}{\code{AsyncBackend$sapply()}} +\item \href{#method-AsyncBackend-lapply}{\code{AsyncBackend$lapply()}} \item \href{#method-AsyncBackend-get_output}{\code{AsyncBackend$get_output()}} \item \href{#method-AsyncBackend-clone}{\code{AsyncBackend$clone()}} } @@ -277,8 +278,33 @@ Run a task on the backend akin to \code{\link[parallel:clusterApply]{parallel::p \subsection{Arguments}{ \if{html}{\out{
}} \describe{ -\item{\code{x}}{A vector (i.e., usually of integers) to pass to the \code{fun} -function.} +\item{\code{x}}{An atomic vector or list to pass to the \code{fun} function.} + +\item{\code{fun}}{A function to apply to each element of \code{x}.} + +\item{\code{...}}{Additional arguments to pass to the \code{fun} function.} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +This method returns void. The output of the task execution must be +stored in the private field \code{.output} on the \code{\link{Backend}} +abstract class, and is accessible via the \code{get_output()} method. +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-AsyncBackend-lapply}{}}} +\subsection{Method \code{lapply()}}{ +Run a task on the backend akin to \code{\link[parallel:clusterApply]{parallel::parLapply()}}. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{AsyncBackend$lapply(x, fun, ...)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{x}}{An atomic vector or list to pass to the \code{fun} function.} \item{\code{fun}}{A function to apply to each element of \code{x}.} @@ -325,8 +351,10 @@ task is still running. } \subsection{Returns}{ -A vector or list of the same length as \code{x} containing the results of -the \code{fun}. It resembles the format of \code{\link[base:lapply]{base::sapply()}}. +A vector, matrix, or list of the same length as \code{x}, containing the +results of the \code{fun}. The output format differs based on the specific +operation employed. Check out the documentation for the \code{apply} +operations of \code{\link[parallel:parallel-package]{parallel::parallel}} for more information. } } \if{html}{\out{
}} diff --git a/man/Backend.Rd b/man/Backend.Rd index a9e941e..22d4fe2 100644 --- a/man/Backend.Rd +++ b/man/Backend.Rd @@ -52,6 +52,7 @@ implementation has an active cluster.}
  • parabar::Service$evaluate()
  • parabar::Service$export()
  • parabar::Service$get_output()
    • +
  • parabar::Service$lapply()
  • parabar::Service$peek()
  • parabar::Service$sapply()
  • parabar::Service$start()
    • diff --git a/man/Context.Rd b/man/Context.Rd index aa3bf9f..03ff003 100644 --- a/man/Context.Rd +++ b/man/Context.Rd @@ -101,6 +101,7 @@ context.} \item \href{#method-Context-export}{\code{Context$export()}} \item \href{#method-Context-evaluate}{\code{Context$evaluate()}} \item \href{#method-Context-sapply}{\code{Context$sapply()}} +\item \href{#method-Context-lapply}{\code{Context$lapply()}} \item \href{#method-Context-get_output}{\code{Context$get_output()}} \item \href{#method-Context-clone}{\code{Context$clone()}} } @@ -246,8 +247,33 @@ Run a task on the backend akin to \code{\link[parallel:clusterApply]{parallel::p \subsection{Arguments}{ \if{html}{\out{
    }} \describe{ -\item{\code{x}}{A vector (i.e., usually of integers) to pass to the \code{fun} -function.} +\item{\code{x}}{An atomic vector or list to pass to the \code{fun} function.} + +\item{\code{fun}}{A function to apply to each element of \code{x}.} + +\item{\code{...}}{Additional arguments to pass to the \code{fun} function.} +} +\if{html}{\out{
    }} +} +\subsection{Returns}{ +This method returns void. The output of the task execution must be +stored in the private field \code{.output} on the \code{\link{Backend}} +abstract class, and is accessible via the \code{get_output()} method. +} +} +\if{html}{\out{
    }} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-Context-lapply}{}}} +\subsection{Method \code{lapply()}}{ +Run a task on the backend akin to \code{\link[parallel:clusterApply]{parallel::parLapply()}}. +\subsection{Usage}{ +\if{html}{\out{
    }}\preformatted{Context$lapply(x, fun, ...)}\if{html}{\out{
    }} +} + +\subsection{Arguments}{ +\if{html}{\out{
    }} +\describe{ +\item{\code{x}}{An atomic vector or list to pass to the \code{fun} function.} \item{\code{fun}}{A function to apply to each element of \code{x}.} @@ -288,8 +314,10 @@ task. } \subsection{Returns}{ -A vector or list of the same length as \code{x} containing the results of -the \code{fun}. It resembles the format of \code{\link[base:lapply]{base::sapply()}}. +A vector, matrix, or list of the same length as \code{x}, containing the +results of the \code{fun}. The output format differs based on the specific +operation employed. Check out the documentation for the \code{apply} +operations of \code{\link[parallel:parallel-package]{parallel::parallel}} for more information. } } \if{html}{\out{
    }} diff --git a/man/ProgressTrackingContext.Rd b/man/ProgressTrackingContext.Rd index 590c4b0..43710b5 100644 --- a/man/ProgressTrackingContext.Rd +++ b/man/ProgressTrackingContext.Rd @@ -127,6 +127,7 @@ context$stop() \item \href{#method-ProgressTrackingContext-set_bar}{\code{ProgressTrackingContext$set_bar()}} \item \href{#method-ProgressTrackingContext-configure_bar}{\code{ProgressTrackingContext$configure_bar()}} \item \href{#method-ProgressTrackingContext-sapply}{\code{ProgressTrackingContext$sapply()}} +\item \href{#method-ProgressTrackingContext-lapply}{\code{ProgressTrackingContext$lapply()}} \item \href{#method-ProgressTrackingContext-clone}{\code{ProgressTrackingContext$clone()}} } } @@ -216,8 +217,34 @@ progress bar. \subsection{Arguments}{ \if{html}{\out{
    }} \describe{ -\item{\code{x}}{A vector (i.e., usually of integers) to pass to the \code{fun} -function.} +\item{\code{x}}{An atomic vector or list to pass to the \code{fun} function.} + +\item{\code{fun}}{A function to apply to each element of \code{x}.} + +\item{\code{...}}{Additional arguments to pass to the \code{fun} function.} +} +\if{html}{\out{
    }} +} +\subsection{Returns}{ +This method returns void. The output of the task execution must be +stored in the private field \code{.output} on the \code{\link{Backend}} +abstract class, and is accessible via the \code{get_output()} method. +} +} +\if{html}{\out{
    }} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-ProgressTrackingContext-lapply}{}}} +\subsection{Method \code{lapply()}}{ +Run a task on the backend akin to \code{\link[parallel:clusterApply]{parallel::parLapply()}}, but with a +progress bar. +\subsection{Usage}{ +\if{html}{\out{
    }}\preformatted{ProgressTrackingContext$lapply(x, fun, ...)}\if{html}{\out{
    }} +} + +\subsection{Arguments}{ +\if{html}{\out{
    }} +\describe{ +\item{\code{x}}{An atomic vector or list to pass to the \code{fun} function.} \item{\code{fun}}{A function to apply to each element of \code{x}.} diff --git a/man/Service.Rd b/man/Service.Rd index 8b01041..2160b6b 100644 --- a/man/Service.Rd +++ b/man/Service.Rd @@ -23,6 +23,7 @@ and \code{\link{Context}}. \item \href{#method-Service-export}{\code{Service$export()}} \item \href{#method-Service-evaluate}{\code{Service$evaluate()}} \item \href{#method-Service-sapply}{\code{Service$sapply()}} +\item \href{#method-Service-lapply}{\code{Service$lapply()}} \item \href{#method-Service-get_output}{\code{Service$get_output()}} \item \href{#method-Service-clone}{\code{Service$clone()}} } @@ -167,8 +168,33 @@ Run a task on the backend akin to \code{\link[parallel:clusterApply]{parallel::p \subsection{Arguments}{ \if{html}{\out{
    }} \describe{ -\item{\code{x}}{A vector (i.e., usually of integers) to pass to the \code{fun} -function.} +\item{\code{x}}{An atomic vector or list to pass to the \code{fun} function.} + +\item{\code{fun}}{A function to apply to each element of \code{x}.} + +\item{\code{...}}{Additional arguments to pass to the \code{fun} function.} +} +\if{html}{\out{
    }} +} +\subsection{Returns}{ +This method returns void. The output of the task execution must be +stored in the private field \code{.output} on the \code{\link{Backend}} +abstract class, and is accessible via the \code{get_output()} method. +} +} +\if{html}{\out{
    }} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-Service-lapply}{}}} +\subsection{Method \code{lapply()}}{ +Run a task on the backend akin to \code{\link[parallel:clusterApply]{parallel::parLapply()}}. +\subsection{Usage}{ +\if{html}{\out{
    }}\preformatted{Service$lapply(x, fun, ...)}\if{html}{\out{
    }} +} + +\subsection{Arguments}{ +\if{html}{\out{
    }} +\describe{ +\item{\code{x}}{An atomic vector or list to pass to the \code{fun} function.} \item{\code{fun}}{A function to apply to each element of \code{x}.} @@ -208,8 +234,10 @@ task. } \subsection{Returns}{ -A vector or list of the same length as \code{x} containing the results of -the \code{fun}. It resembles the format of \code{\link[base:lapply]{base::sapply()}}. +A vector, matrix, or list of the same length as \code{x}, containing the +results of the \code{fun}. The output format differs based on the specific +operation employed. Check out the documentation for the \code{apply} +operations of \code{\link[parallel:parallel-package]{parallel::parallel}} for more information. } } \if{html}{\out{
    }} diff --git a/man/SyncBackend.Rd b/man/SyncBackend.Rd index 801def4..3de684a 100644 --- a/man/SyncBackend.Rd +++ b/man/SyncBackend.Rd @@ -93,6 +93,7 @@ backend$active \item \href{#method-SyncBackend-export}{\code{SyncBackend$export()}} \item \href{#method-SyncBackend-evaluate}{\code{SyncBackend$evaluate()}} \item \href{#method-SyncBackend-sapply}{\code{SyncBackend$sapply()}} +\item \href{#method-SyncBackend-lapply}{\code{SyncBackend$lapply()}} \item \href{#method-SyncBackend-get_output}{\code{SyncBackend$get_output()}} \item \href{#method-SyncBackend-clone}{\code{SyncBackend$clone()}} } @@ -246,8 +247,33 @@ Run a task on the backend akin to \code{\link[parallel:clusterApply]{parallel::p \subsection{Arguments}{ \if{html}{\out{
    }} \describe{ -\item{\code{x}}{A vector (i.e., usually of integers) to pass to the \code{fun} -function.} +\item{\code{x}}{An atomic vector or list to pass to the \code{fun} function.} + +\item{\code{fun}}{A function to apply to each element of \code{x}.} + +\item{\code{...}}{Additional arguments to pass to the \code{fun} function.} +} +\if{html}{\out{
    }} +} +\subsection{Returns}{ +This method returns void. The output of the task execution must be +stored in the private field \code{.output} on the \code{\link{Backend}} +abstract class, and is accessible via the \code{get_output()} method. +} +} +\if{html}{\out{
    }} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-SyncBackend-lapply}{}}} +\subsection{Method \code{lapply()}}{ +Run a task on the backend akin to \code{\link[parallel:clusterApply]{parallel::parLapply()}}. +\subsection{Usage}{ +\if{html}{\out{
    }}\preformatted{SyncBackend$lapply(x, fun, ...)}\if{html}{\out{
    }} +} + +\subsection{Arguments}{ +\if{html}{\out{
    }} +\describe{ +\item{\code{x}}{An atomic vector or list to pass to the \code{fun} function.} \item{\code{fun}}{A function to apply to each element of \code{x}.} @@ -279,8 +305,10 @@ task. } \subsection{Returns}{ -A vector or list of the same length as \code{x} containing the results of -the \code{fun}. It resembles the format of \code{\link[base:lapply]{base::sapply()}}. +A vector, matrix, or list of the same length as \code{x}, containing the +results of the \code{fun}. The output format differs based on the specific +operation employed. Check out the documentation for the \code{apply} +operations of \code{\link[parallel:parallel-package]{parallel::parallel}} for more information. } } \if{html}{\out{
    }} diff --git a/man/UserApiConsumer.Rd b/man/UserApiConsumer.Rd new file mode 100644 index 0000000..808780d --- /dev/null +++ b/man/UserApiConsumer.Rd @@ -0,0 +1,156 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/UserApiConsumer.R +\name{UserApiConsumer} +\alias{UserApiConsumer} +\title{UserApiConsumer} +\description{ +This class is an opinionated interface around the developer API of the +\code{\link{parabar}} package. See the \strong{Details} section for more +information on how this class works. +} +\details{ +This class acts as a wrapper around the \code{\link[R6:R6Class]{R6::R6}} developer API of the +\code{\link{parabar}} package. In a nutshell, it provides an opinionated +interface by wrapping the developer API in simple functional calls. More +specifically, for executing a task in parallel, this class performs the +following steps: +\itemize{ +\item Validates the backend provided. +\item Instantiates an appropriate \code{\link{parabar}} context based on the +backend. If the backend supports progress tracking (i.e., the backend is an +instance of \code{\link{AsyncBackend}}), a progress tracking context (i.e., +\code{\link{ProgressTrackingContext}}) is instantiated and used. Otherwise, +a regular context (i.e., \code{\link{Context}}) is instantiated. A regular +context is also used if the progress tracking is disabled via the +\code{\link{Options}} instance. +\item Registers the \code{\link[=Backend]{backend}} with the context. +\item Instantiates and configures the progress bar based on the +\code{\link{Options}} instance in the session \code{\link[base:options]{base::.Options}} list. +\item Executes the task in parallel, and displays a progress bar if appropriate. +\item Fetches the results from the backend and returns them. +} +} +\examples{ +# Define a simple task. +task <- function(x) { + # Perform computations. + Sys.sleep(0.01) + + # Return the result. + return(x + 1) +} + +# Start an asynchronous backend. +backend <- start_backend(cores = 2, cluster_type = "psock", backend_type = "async") + +# Change the progress bar options. +configure_bar(type = "modern", format = "[:bar] :percent") + +# Create an user API consumer. +consumer <- UserApiConsumer$new() + +# Execute the task using the `sapply` parallel operation. +output_sapply <- consumer$sapply(backend = backend, x = 1:200, fun = task) + +# Print the head of the `sapply` operation output. +head(output_sapply) + +# Execute the task using the `sapply` parallel operation. +output_lapply <- consumer$lapply(backend = backend, x = 1:200, fun = task) + +# Print the head of the `lapply` operation output. +head(output_lapply) + +# Stop the backend. +stop_backend(backend) + +} +\seealso{ +\code{\link[=start_backend]{start_backend()}}, \code{\link[=stop_backend]{stop_backend()}}, +\code{\link[=configure_bar]{configure_bar()}}, \code{\link[=par_sapply]{par_sapply()}}, and +\code{\link[=par_lapply]{par_lapply()}}. +} +\section{Methods}{ +\subsection{Public methods}{ +\itemize{ +\item \href{#method-UserApiConsumer-sapply}{\code{UserApiConsumer$sapply()}} +\item \href{#method-UserApiConsumer-lapply}{\code{UserApiConsumer$lapply()}} +\item \href{#method-UserApiConsumer-clone}{\code{UserApiConsumer$clone()}} +} +} +\if{html}{\out{
    }} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-UserApiConsumer-sapply}{}}} +\subsection{Method \code{sapply()}}{ +Execute a task in parallel akin to \code{\link[parallel:clusterApply]{parallel::parSapply()}}. +\subsection{Usage}{ +\if{html}{\out{
    }}\preformatted{UserApiConsumer$sapply(backend, x, fun, ...)}\if{html}{\out{
    }} +} + +\subsection{Arguments}{ +\if{html}{\out{
    }} +\describe{ +\item{\code{backend}}{An object of class \code{\link{Backend}} as returned by +the \code{\link[=start_backend]{start_backend()}} function. It can also be \code{NULL} to run +the task sequentially via \code{\link[base:lapply]{base::sapply()}}.} + +\item{\code{x}}{An atomic vector or list to pass to the \code{fun} function.} + +\item{\code{fun}}{A function to apply to each element of \code{x}.} + +\item{\code{...}}{Additional arguments to pass to the \code{fun} function.} +} +\if{html}{\out{
    }} +} +\subsection{Returns}{ +A vector of the same length as \code{x} containing the results of the +\code{fun}. The output format resembles that of \code{\link[base:lapply]{base::sapply()}}. +} +} +\if{html}{\out{
    }} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-UserApiConsumer-lapply}{}}} +\subsection{Method \code{lapply()}}{ +Execute a task in parallel akin to \code{\link[parallel:clusterApply]{parallel::parLapply()}}. +\subsection{Usage}{ +\if{html}{\out{
    }}\preformatted{UserApiConsumer$lapply(backend, x, fun, ...)}\if{html}{\out{
    }} +} + +\subsection{Arguments}{ +\if{html}{\out{
    }} +\describe{ +\item{\code{backend}}{An object of class \code{\link{Backend}} as returned by +the \code{\link[=start_backend]{start_backend()}} function. It can also be \code{NULL} to run +the task sequentially via \code{\link[base:lapply]{base::lapply()}}.} + +\item{\code{x}}{An atomic vector or list to pass to the \code{fun} function.} + +\item{\code{fun}}{A function to apply to each element of \code{x}.} + +\item{\code{...}}{Additional arguments to pass to the \code{fun} function.} +} +\if{html}{\out{
    }} +} +\subsection{Returns}{ +A list of the same length as \code{x} containing the results of the \code{fun}. +The output format resembles that of \code{\link[base:lapply]{base::lapply()}}. +} +} +\if{html}{\out{
    }} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-UserApiConsumer-clone}{}}} +\subsection{Method \code{clone()}}{ +The objects of this class are cloneable with this method. +\subsection{Usage}{ +\if{html}{\out{
    }}\preformatted{UserApiConsumer$clone(deep = FALSE)}\if{html}{\out{
    }} +} + +\subsection{Arguments}{ +\if{html}{\out{
    }} +\describe{ +\item{\code{deep}}{Whether to make a deep clone.} +} +\if{html}{\out{
    }} +} +} +} diff --git a/man/clear.Rd b/man/clear.Rd index e3cf463..115b4a2 100644 --- a/man/clear.Rd +++ b/man/clear.Rd @@ -84,5 +84,5 @@ backend$active \seealso{ \code{\link[=start_backend]{start_backend()}}, \code{\link[=peek]{peek()}}, \code{\link[=export]{export()}}, \code{\link[=evaluate]{evaluate()}}, \code{\link[=configure_bar]{configure_bar()}}, \code{\link[=par_sapply]{par_sapply()}}, -\code{\link[=stop_backend]{stop_backend()}}, and \code{\link{Service}}. +\code{\link[=par_lapply]{par_lapply()}}, \code{\link[=stop_backend]{stop_backend()}}, and \code{\link{Service}}. } diff --git a/man/evaluate.Rd b/man/evaluate.Rd index 2678c0c..14e643d 100644 --- a/man/evaluate.Rd +++ b/man/evaluate.Rd @@ -87,5 +87,5 @@ backend$active \seealso{ \code{\link[=start_backend]{start_backend()}}, \code{\link[=peek]{peek()}}, \code{\link[=export]{export()}}, \code{\link[=clear]{clear()}}, \code{\link[=configure_bar]{configure_bar()}}, \code{\link[=par_sapply]{par_sapply()}}, -\code{\link[=stop_backend]{stop_backend()}}, and \code{\link{Service}}. +\code{\link[=par_lapply]{par_lapply()}}, \code{\link[=stop_backend]{stop_backend()}}, and \code{\link{Service}}. } diff --git a/man/export.Rd b/man/export.Rd index 3ccf104..afda767 100644 --- a/man/export.Rd +++ b/man/export.Rd @@ -90,5 +90,5 @@ backend$active \seealso{ \code{\link[=start_backend]{start_backend()}}, \code{\link[=peek]{peek()}}, \code{\link[=evaluate]{evaluate()}}, \code{\link[=clear]{clear()}}, \code{\link[=configure_bar]{configure_bar()}}, \code{\link[=par_sapply]{par_sapply()}}, -\code{\link[=stop_backend]{stop_backend()}}, and \code{\link{Service}}. +\code{\link[=par_lapply]{par_lapply()}}, \code{\link[=stop_backend]{stop_backend()}}, and \code{\link{Service}}. } diff --git a/man/par_lapply.Rd b/man/par_lapply.Rd new file mode 100644 index 0000000..ec3d248 --- /dev/null +++ b/man/par_lapply.Rd @@ -0,0 +1,97 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/exports.r +\name{par_lapply} +\alias{par_lapply} +\title{Run a Task in Parallel} +\usage{ +par_lapply(backend = NULL, x, fun, ...) +} +\arguments{ +\item{backend}{An object of class \code{\link{Backend}} as returned by the +\code{\link[=start_backend]{start_backend()}} function. It can also be \code{NULL} to run the task +sequentially via \code{\link[base:lapply]{base::lapply()}}. The default value is \code{NULL}.} + +\item{x}{An atomic vector or list to pass to the \code{fun} function.} + +\item{fun}{A function to apply to each element of \code{x}.} + +\item{...}{Additional arguments to pass to the \code{fun} function.} +} +\value{ +A list of the same length as \code{x} containing the results of the \code{fun}. The +output format resembles that of \code{\link[base:lapply]{base::lapply()}}. +} +\description{ +This function can be used to run a task in parallel. The task is executed in +parallel on the specified backend, similar to \code{\link[parallel:clusterApply]{parallel::parLapply()}}. If +\code{backend = NULL}, the task is executed sequentially using \code{\link[base:lapply]{base::lapply()}}. +See the \strong{Details} section for more information on how this function works. +} +\details{ +This function uses the \code{\link{UserApiConsumer}} class that acts like an +interface for the developer API of the \code{\link{parabar}} package. +} +\examples{ +\donttest{ + +# Define a simple task. +task <- function(x) { + # Perform computations. + Sys.sleep(0.01) + + # Return the result. + return(x + 1) +} + +# Start an asynchronous backend. +backend <- start_backend(cores = 2, cluster_type = "psock", backend_type = "async") + +# Run a task in parallel. +results <- par_lapply(backend, x = 1:300, fun = task) + +# Disable progress tracking. +set_option("progress_track", FALSE) + +# Run a task in parallel. +results <- par_lapply(backend, x = 1:300, fun = task) + +# Enable progress tracking. +set_option("progress_track", TRUE) + +# Change the progress bar options. +configure_bar(type = "modern", format = "[:bar] :percent") + +# Run a task in parallel. +results <- par_lapply(backend, x = 1:300, fun = task) + +# Stop the backend. +stop_backend(backend) + +# Start a synchronous backend. +backend <- start_backend(cores = 2, cluster_type = "psock", backend_type = "sync") + +# Run a task in parallel. +results <- par_lapply(backend, x = 1:300, fun = task) + +# Disable progress tracking to remove the warning that progress is not supported. +set_option("progress_track", FALSE) + +# Run a task in parallel. +results <- par_lapply(backend, x = 1:300, fun = task) + +# Stop the backend. +stop_backend(backend) + +# Run the task using the `base::lapply` (i.e., non-parallel). +results <- par_lapply(NULL, x = 1:300, fun = task) + +} + +} +\seealso{ +\code{\link[=start_backend]{start_backend()}}, \code{\link[=peek]{peek()}}, \code{\link[=export]{export()}}, +\code{\link[=evaluate]{evaluate()}}, \code{\link[=clear]{clear()}}, \code{\link[=configure_bar]{configure_bar()}}, +\code{\link[=par_sapply]{par_sapply()}}, \code{\link[=stop_backend]{stop_backend()}}, \code{\link[=set_option]{set_option()}}, +\code{\link[=get_option]{get_option()}}, \code{\link{Options}}, \code{\link{UserApiConsumer}}, +and \code{\link{Service}}. +} diff --git a/man/par_sapply.Rd b/man/par_sapply.Rd index ea6bafb..3dc5cbd 100644 --- a/man/par_sapply.Rd +++ b/man/par_sapply.Rd @@ -11,15 +11,15 @@ par_sapply(backend = NULL, x, fun, ...) \code{\link[=start_backend]{start_backend()}} function. It can also be \code{NULL} to run the task sequentially via \code{\link[base:lapply]{base::sapply()}}. The default value is \code{NULL}.} -\item{x}{A vector (i.e., usually of integers) to pass to the \code{fun} function.} +\item{x}{An atomic vector or list to pass to the \code{fun} function.} \item{fun}{A function to apply to each element of \code{x}.} \item{...}{Additional arguments to pass to the \code{fun} function.} } \value{ -A vector or list of the same length as \code{x} containing the results of the -\code{fun}. The output format resembles that of \code{\link[base:lapply]{base::sapply()}}. +A vector of the same length as \code{x} containing the results of the \code{fun}. The +output format resembles that of \code{\link[base:lapply]{base::sapply()}}. } \description{ This function can be used to run a task in parallel. The task is executed in @@ -28,21 +28,8 @@ parallel on the specified backend, similar to \code{\link[parallel:clusterApply] See the \strong{Details} section for more information on how this function works. } \details{ -This function is a wrapper around the developer API of the -\code{\link{parabar}} package. More specifically, this function: -\itemize{ -\item Instantiates an appropriate \code{\link{parabar}} context. If the backend -supports progress tracking (i.e., the backend is an instance of -\code{\link{AsyncBackend}}), a progress tracking context (i.e., -\code{\link{ProgressTrackingContext}}) is instantiated and used. Otherwise, a -regular context (i.e., \code{\link{Context}}) is instantiated. A regular -context is also used if the progress tracking is disabled via the -\code{\link{Options}} instance. -\item Registers the \code{\link[=Backend]{backend}} with the context. -\item Instantiates and configures the progress bar based on the -\code{\link{Options}} instance in the session \code{\link[base:options]{base::.Options}} list. -\item Executes the task in parallel, and displays a progress bar if appropriate. -} +This function uses the \code{\link{UserApiConsumer}} class that acts like an +interface for the developer API of the \code{\link{parabar}} package. } \examples{ \donttest{ @@ -104,6 +91,7 @@ results <- par_sapply(NULL, x = 1:300, fun = task) \seealso{ \code{\link[=start_backend]{start_backend()}}, \code{\link[=peek]{peek()}}, \code{\link[=export]{export()}}, \code{\link[=evaluate]{evaluate()}}, \code{\link[=clear]{clear()}}, \code{\link[=configure_bar]{configure_bar()}}, -\code{\link[=stop_backend]{stop_backend()}}, \code{\link[=set_option]{set_option()}}, \code{\link[=get_option]{get_option()}}, -\code{\link{Options}}, and \code{\link{Service}}. +\code{\link[=par_lapply]{par_lapply()}}, \code{\link[=stop_backend]{stop_backend()}}, \code{\link[=set_option]{set_option()}}, +\code{\link[=get_option]{get_option()}}, \code{\link{Options}}, \code{\link{UserApiConsumer}}, +and \code{\link{Service}}. } diff --git a/man/parabar-package.Rd b/man/parabar-package.Rd index 945ee09..5447e12 100644 --- a/man/parabar-package.Rd +++ b/man/parabar-package.Rd @@ -19,7 +19,7 @@ solution for parallel processing in their packages. } \section{Users}{ -For the first category of users, \code{\link{parabar}} provides seven main +For the first category of users, \code{\link{parabar}} provides several main functions of interest: \itemize{ \item \code{\link[=start_backend]{start_backend()}}: creates a parallel backend for executing tasks @@ -30,6 +30,10 @@ eligible for garbage collection. \code{\link[base:lapply]{base::sapply()}} function when no backend is provided. However, when a backend is provided, the function will execute a task in parallel on the backend, similar to the built-in function \code{\link[parallel:clusterApply]{parallel::parSapply()}}. +\item \code{\link[=par_lapply]{par_lapply()}}: is a drop-in replacement for the built-in +\code{\link[base:lapply]{base::lapply()}} function when no backend is provided. However, when a +backend is provided, the function will execute a task in parallel on the +backend, similar to the built-in function \code{\link[parallel:clusterApply]{parallel::parLapply()}}. \item \code{\link[=clear]{clear()}}: removes all variables available on a backend. \item \code{\link[=peek]{peek()}}: returns the names of all variables available on a backend. @@ -72,7 +76,8 @@ The \code{\link{Service}} interface defines the following operations: \code{\link[=Service]{start()}}, \code{\link[=Service]{stop()}}, \code{\link[=Service]{clear()}}, \code{\link[=Service]{peek()}}, \code{\link[=Service]{export()}}, \code{\link[=Service]{evaluate()}}, -\code{\link[=Service]{sapply()}}, and \code{\link[=Service]{get_output()}}. +\code{\link[=Service]{sapply()}}, \code{\link[=Service]{lapply()}}, and +\code{\link[=Service]{get_output()}}. Check out the documentation for \code{\link{Service}} for more information on each method. @@ -85,9 +90,9 @@ operates. The default, regular \code{\link{Context}} class simply forwards the call to the corresponding backend method. However, a more complex context can augment the operation before forwarding the call to the backend. One example of a complex context is the \code{\link{ProgressTrackingContext}} class. This -class extends the regular \code{\link{Context}} class and decorates the -backend \code{\link[=Service]{sapply()}} operation to log the progress after -each task execution and display a progress bar. +class extends the regular \code{\link{Context}} class and decorates, for +example, the backend \code{\link[=Service]{sapply()}} operation to log the +progress after each task execution and display a progress bar. The following are the main classes provided by \code{parabar}: \itemize{ @@ -105,7 +110,8 @@ asynchronous backend. \item \code{\link{BackendFactory}}: factory for creating backend objects. \item \code{\link{Context}}: default context for executing backend operations. \item \code{\link{ProgressTrackingContext}}: context for decorating the -\code{\link[=Service]{sapply()}} operation to track and display progress. +\code{\link[=Service]{sapply()}} and \code{\link[=Service]{lapply()}} +operations to track and display the execution progress. \item \code{\link{ContextFactory}}: factory for creating context objects. } } @@ -121,7 +127,7 @@ implemented by concrete bar classes. \item \code{\link{BasicBar}}: a simple, but robust, bar created via \code{\link[utils:txtProgressBar]{utils::txtProgressBar()}} extending the \code{\link{Bar}} abstract class. \item \code{\link{ModernBar}}: a modern bar created via \code{\link[progress:progress_bar]{progress::progress_bar}} -extending the \link{Bar} abstract class. +extending the \code{\link{Bar}} abstract class. \item \code{\link{BarFactory}}: factory for creating bar objects. } diff --git a/man/peek.Rd b/man/peek.Rd index 2a07a22..36dad9f 100644 --- a/man/peek.Rd +++ b/man/peek.Rd @@ -86,5 +86,5 @@ backend$active \seealso{ \code{\link[=start_backend]{start_backend()}}, \code{\link[=export]{export()}}, \code{\link[=evaluate]{evaluate()}}, \code{\link[=clear]{clear()}}, \code{\link[=configure_bar]{configure_bar()}}, \code{\link[=par_sapply]{par_sapply()}}, -\code{\link[=stop_backend]{stop_backend()}}, and \code{\link{Service}}. +\code{\link[=par_lapply]{par_lapply()}}, \code{\link[=stop_backend]{stop_backend()}}, and \code{\link{Service}}. } diff --git a/man/start_backend.Rd b/man/start_backend.Rd index 16bd87c..cd7eb0f 100644 --- a/man/start_backend.Rd +++ b/man/start_backend.Rd @@ -130,5 +130,5 @@ backend$active \seealso{ \code{\link[=peek]{peek()}}, \code{\link[=export]{export()}}, \code{\link[=evaluate]{evaluate()}}, \code{\link[=clear]{clear()}}, \code{\link[=configure_bar]{configure_bar()}}, \code{\link[=par_sapply]{par_sapply()}}, -\code{\link[=stop_backend]{stop_backend()}}, and \code{\link{Service}}. +\code{\link[=par_lapply]{par_lapply()}}, \code{\link[=stop_backend]{stop_backend()}}, and \code{\link{Service}}. } diff --git a/man/stop_backend.Rd b/man/stop_backend.Rd index 574bcc2..e36356f 100644 --- a/man/stop_backend.Rd +++ b/man/stop_backend.Rd @@ -89,5 +89,5 @@ backend$active \seealso{ \code{\link[=start_backend]{start_backend()}}, \code{\link[=peek]{peek()}}, \code{\link[=export]{export()}}, \code{\link[=evaluate]{evaluate()}}, \code{\link[=clear]{clear()}}, \code{\link[=configure_bar]{configure_bar()}}, -\code{\link[=par_sapply]{par_sapply()}}, and \code{\link{Service}}. +\code{\link[=par_sapply]{par_sapply()}}, \code{\link[=par_lapply]{par_lapply()}}, and \code{\link{Service}}. } From 7dd66a846e5b9ed4dcd05cba5b45e25a40459e80 Mon Sep 17 00:00:00 2001 From: mihaiconstantin Date: Wed, 3 May 2023 16:07:59 +0200 Subject: [PATCH 28/34] Docs: add missing topics to `_pkgdown.yml` --- _pkgdown.yml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/_pkgdown.yml b/_pkgdown.yml index 85dd21d..1eddfcc 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -13,6 +13,7 @@ reference: - clear - evaluate - par_sapply + - par_lapply - configure_bar - matches("get_|set_") - subtitle: Developer Classes @@ -36,6 +37,7 @@ reference: - Helper - Warning - Exception + - UserApiConsumer - subtitle: Miscellaneous desc: Very specific functions that may safely be ignored. - contents: From 49ddf1ebe5536c5aed44beb8a423ba45c3bc5108 Mon Sep 17 00:00:00 2001 From: mihaiconstantin Date: Wed, 3 May 2023 16:24:40 +0200 Subject: [PATCH 29/34] Docs: add changes to `NEWS` --- NEWS.md | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/NEWS.md b/NEWS.md index fe0302b..1ab4fe4 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,24 @@ +# Development + +## Added +- Add more tests to improve coverage. +- Add `par_lapply` function to the user `API`. The `par_lapply` function can be + used to run tasks in parallel akin to `parallel::parLapply`. +- Add `UserApiConsumer` `R6` class that provides an opinionated wrapper around + the developer `API` of the `parabar` package. All parallel operations (e.g., + `par_sapply` and `par_lapply`) follow more or less the same pattern. The + `UserApiConsumer` encapsulates this pattern and makes it easier to extend + `parabar` with new parallel functions (e.g., `par_apply`) while avoiding code + duplication. The `UserApiConsumer` class can also be used as a standalone + class for parallel operations, however, its primary purpose is to be used by + the parallel task execution functions in the user `API`. + +## Changed +- Refactor test helpers to avoid code duplication. +- Update `par_sapply` to use the `UserApiConsumer` class. +- Update the developer `API` `R6` classes to implement the `lapply` parallel + operation. + # parabar 1.0.3 ## Fixed From 26f1f8a9197a9c64deb7c645fe4bc49edb5d0b12 Mon Sep 17 00:00:00 2001 From: mihaiconstantin Date: Wed, 3 May 2023 16:25:12 +0200 Subject: [PATCH 30/34] Ci: update line exclusions for coverage workflow --- .github/workflows/test-coverage.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index 1e7946d..223206c 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -43,5 +43,5 @@ jobs: - name: Test coverage env: PROCESSX_NOTIFY_OLD_SIGCHLD: true - run: covr::codecov(line_exclusions = list("R/parabar-package.R")) + run: covr::codecov(line_exclusions = list("R/parabar-package.R", "R/UserApiConsumer.R" = c(59:77))) shell: Rscript {0} From 34f184559aa498d51d4416887749cdb43778b386 Mon Sep 17 00:00:00 2001 From: mihaiconstantin Date: Wed, 3 May 2023 16:28:37 +0200 Subject: [PATCH 31/34] Fix: update `export` operation to default to parent frame --- R/Context.R | 9 +++++++-- R/SyncBackend.R | 6 +++--- man/Context.Rd | 2 +- man/SyncBackend.Rd | 2 +- 4 files changed, 12 insertions(+), 7 deletions(-) diff --git a/R/Context.R b/R/Context.R index 82e31c2..4b0687f 100644 --- a/R/Context.R +++ b/R/Context.R @@ -155,12 +155,17 @@ Context <- R6::R6Class("Context", #' @param variables A character vector of variable names to export. #' #' @param environment An environment object from which to export the - #' variables. + #' variables. Defaults to the parent frame. #' #' @return This method returns void. export = function(variables, environment) { + # If no environment is provided. + if (missing(environment)) { + # Use the caller's environment where the variables are defined. + environment <- parent.frame() + } + # Consume the backend API. - # TODO: Check that this works as expected (i.e., the environment). private$.backend$export(variables, environment) }, diff --git a/R/SyncBackend.R b/R/SyncBackend.R index 6b67518..c29227c 100644 --- a/R/SyncBackend.R +++ b/R/SyncBackend.R @@ -244,14 +244,14 @@ SyncBackend <- R6::R6Class("SyncBackend", #' @param variables A character vector of variable names to export. #' #' @param environment An environment object from which to export the - #' variables. + #' variables. Defaults to the parent frame. #' #' @return This method returns void. export = function(variables, environment) { # If no environment is provided. if (missing(environment)) { - # Use the global environment. - environment <- .GlobalEnv + # Use the caller's environment where the variables are defined. + environment <- parent.frame() } # Export and return the output. diff --git a/man/Context.Rd b/man/Context.Rd index 03ff003..9d5945b 100644 --- a/man/Context.Rd +++ b/man/Context.Rd @@ -207,7 +207,7 @@ Export variables from a given environment to the backend. \item{\code{variables}}{A character vector of variable names to export.} \item{\code{environment}}{An environment object from which to export the -variables.} +variables. Defaults to the parent frame.} } \if{html}{\out{
    }} } diff --git a/man/SyncBackend.Rd b/man/SyncBackend.Rd index 3de684a..2e55fef 100644 --- a/man/SyncBackend.Rd +++ b/man/SyncBackend.Rd @@ -207,7 +207,7 @@ Export variables from a given environment to the backend. \item{\code{variables}}{A character vector of variable names to export.} \item{\code{environment}}{An environment object from which to export the -variables.} +variables. Defaults to the parent frame.} } \if{html}{\out{
    }} } From 06d9e6b0bad80211bf1ae6760384ae713d14c1de Mon Sep 17 00:00:00 2001 From: mihaiconstantin Date: Wed, 3 May 2023 16:29:28 +0200 Subject: [PATCH 32/34] Fix: disable `file.create` warnings in `ProgressTrackingContext` --- R/ProgressTrackingContext.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/ProgressTrackingContext.R b/R/ProgressTrackingContext.R index 9096759..be2100c 100644 --- a/R/ProgressTrackingContext.R +++ b/R/ProgressTrackingContext.R @@ -126,7 +126,7 @@ ProgressTrackingContext <- R6::R6Class("ProgressTrackingContext", file_path <- Helper$get_option("progress_log_path") # Create the temporary file. - creation_status <- file.create(file_path) + creation_status <- file.create(file_path, showWarnings = FALSE) # If the file creation failed. if (!creation_status) { From 3cf757b9d45531bb0083bfc9963cb83849170002 Mon Sep 17 00:00:00 2001 From: mihaiconstantin Date: Wed, 3 May 2023 16:30:22 +0200 Subject: [PATCH 33/34] Feat: add `...` for `get_output` in `SyncBackend` --- R/SyncBackend.R | 4 +++- man/SyncBackend.Rd | 9 ++++++++- 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/R/SyncBackend.R b/R/SyncBackend.R index c29227c..7495632 100644 --- a/R/SyncBackend.R +++ b/R/SyncBackend.R @@ -313,6 +313,8 @@ SyncBackend <- R6::R6Class("SyncBackend", #' @description #' Get the output of the task execution. #' + #' @param ... Additional arguments currently not in use. + #' #' @details #' This method fetches the output of the task execution after calling #' the `sapply()` method. It returns the output and immediately removes @@ -325,7 +327,7 @@ SyncBackend <- R6::R6Class("SyncBackend", #' results of the `fun`. The output format differs based on the specific #' operation employed. Check out the documentation for the `apply` #' operations of [`parallel::parallel`] for more information. - get_output = function() { + get_output = function(...) { # Reset the output on exit. on.exit({ # Clear. diff --git a/man/SyncBackend.Rd b/man/SyncBackend.Rd index 2e55fef..73b2a16 100644 --- a/man/SyncBackend.Rd +++ b/man/SyncBackend.Rd @@ -293,9 +293,16 @@ abstract class, and is accessible via the \code{get_output()} method. \subsection{Method \code{get_output()}}{ Get the output of the task execution. \subsection{Usage}{ -\if{html}{\out{
    }}\preformatted{SyncBackend$get_output()}\if{html}{\out{
    }} +\if{html}{\out{
    }}\preformatted{SyncBackend$get_output(...)}\if{html}{\out{
    }} } +\subsection{Arguments}{ +\if{html}{\out{
    }} +\describe{ +\item{\code{...}}{Additional arguments currently not in use.} +} +\if{html}{\out{
    }} +} \subsection{Details}{ This method fetches the output of the task execution after calling the \code{sapply()} method. It returns the output and immediately removes From e02619ec3950b9910c6a91c9d6efe0727093059a Mon Sep 17 00:00:00 2001 From: mihaiconstantin Date: Wed, 3 May 2023 16:35:13 +0200 Subject: [PATCH 34/34] Docs: add chanes to `NEWS` --- NEWS.md | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/NEWS.md b/NEWS.md index 1ab4fe4..ef54966 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,8 @@ # Development ## Added +- Add optional arguments to the `get_output` operation of `SyncBackend` for + consistency. - Add more tests to improve coverage. - Add `par_lapply` function to the user `API`. The `par_lapply` function can be used to run tasks in parallel akin to `parallel::parLapply`. @@ -14,11 +16,18 @@ the parallel task execution functions in the user `API`. ## Changed +- Disable warnings for `file.create` in `ProgressTrackingContext` class. This + warning is superfluous since the code handles creation failures. - Refactor test helpers to avoid code duplication. - Update `par_sapply` to use the `UserApiConsumer` class. - Update the developer `API` `R6` classes to implement the `lapply` parallel operation. +## Fixed +- Fix the `export` operation in the `SyncBackend` and `Context` classes to + fallback to the parent environment if the argument `environment` is not + provided. + # parabar 1.0.3 ## Fixed