From da3dc980a315f4617c435a0f4083248e86e2f8b9 Mon Sep 17 00:00:00 2001 From: Moritz Lell Date: Sat, 13 Nov 2021 00:45:48 +0100 Subject: [PATCH 1/2] Fix the number of progressor steps in the relay_progress example The steps= argument of progressor did not match the actual number of emitted progressions or rather the sum of their `amount=`s (there are progressions with amount=0) as well in slow_sum() --- incl/progress_aggregator.R | 6 +++--- man/progress_aggregator.Rd | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/incl/progress_aggregator.R b/incl/progress_aggregator.R index cc470b42..94de9dff 100644 --- a/incl/progress_aggregator.R +++ b/incl/progress_aggregator.R @@ -3,11 +3,11 @@ library(progressr) message("progress_aggregator() ...") with_progress({ - progress <- progressor(steps = 4L) + progress <- progressor(steps = 8L) relay_progress <- progress_aggregator(progress) progress() - relay_progress(slow_sum(1:3)) - relay_progress(slow_sum(1:10)) + relay_progress(slow_sum(1:2)) + relay_progress(slow_sum(1:4)) progress() }) diff --git a/man/progress_aggregator.Rd b/man/progress_aggregator.Rd index 52308ecb..04e3bb70 100644 --- a/man/progress_aggregator.Rd +++ b/man/progress_aggregator.Rd @@ -21,11 +21,11 @@ library(progressr) message("progress_aggregator() ...") with_progress({ - progress <- progressor(steps = 4L) + progress <- progressor(steps = 8L) relay_progress <- progress_aggregator(progress) progress() - relay_progress(slow_sum(1:3)) - relay_progress(slow_sum(1:10)) + relay_progress(slow_sum(1:2)) + relay_progress(slow_sum(1:4)) progress() }) From 9742c56da23916609c235dd0d2f7ec3941d59672 Mon Sep 17 00:00:00 2001 From: Moritz Lell Date: Sat, 13 Nov 2021 00:59:05 +0100 Subject: [PATCH 2/2] Forward progression properties when relaying a progression When the progression condition that is to be relayed was created with any arguments, they need to be relayed as well when creating a new progression object in progress_aggregator(). Fixes #126. --- R/progress_aggregator.R | 23 ++++++++++++++++++++++- R/progressor.R | 3 +++ 2 files changed, 25 insertions(+), 1 deletion(-) diff --git a/R/progress_aggregator.R b/R/progress_aggregator.R index fa177bc7..023ddad1 100644 --- a/R/progress_aggregator.R +++ b/R/progress_aggregator.R @@ -31,7 +31,7 @@ progress_aggregator <- function(progress) { } else if (type == "reset") { } else if (type == "shutdown") { } else if (type == "update") { - progress(child = p) + call_progressor_with_progression(progress, p) } else { stop("Unknown 'progression' type: ", sQuote(type)) } @@ -49,3 +49,24 @@ progress_aggregator <- function(progress) { fcn } + +#' Rewrite a progression condition and emit using another progressor +#' +#' The progression condition `prog_cnd` is disassembled, the properties that are +#' set by the original progressor are removed and the progression is re-created +#' using the progressor `progr`. +#' +call_progressor_with_progression <- function(progr, prog_cond){ + c <- setdiff(class(prog_cond), c("progression", "immediateCondition", "condition")) + arg_list <- unclass(prog_cond) + # Remove all arguments from the list that are not included by the progressor + # (the function generated by a call to the progressor() function) into the + # resulting condition object but are set by the progressor itself. See + # the function that is the return value of progressor() for those arguments. + arg_list$owner_session_uuid <- NULL + arg_list$progressor_uuid <- NULL + arg_list$progression_index <- NULL + arg_list$call <- NULL + arg_list$calls <- NULL + do.call(progr, arg_list) +} diff --git a/R/progressor.R b/R/progressor.R index 4b9afe0f..40088ec9 100644 --- a/R/progressor.R +++ b/R/progressor.R @@ -86,6 +86,9 @@ progressor <- local({ type = type, message = message, ..., + # If adding values here that do not come from the parameters of this + # inner function, include them in call_progressor_with_progress() as + # well progressor_uuid = progressor_uuid, progression_index = progression_index, owner_session_uuid = owner_session_uuid,