From 0d4afaa577d089d8bd5b224fc9b2e7b7c8ca7238 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Sat, 28 Dec 2019 19:54:55 -0800 Subject: [PATCH] Now all future_nnn() functions set a label on each future [#15] --- NEWS | 6 +++++ R/future_Map.R | 4 ++-- R/future_apply.R | 5 ++-- R/future_by.R | 4 ++-- R/future_eapply.R | 4 ++-- R/future_lapply.R | 29 ++++++++++++++++++++---- R/future_mapply.R | 24 ++++++++++++++++---- R/future_replicate.R | 5 ++-- R/future_sapply.R | 4 ++-- R/future_tapply.R | 5 ++-- R/future_vapply.R | 4 ++-- man/future_apply.Rd | 7 +++++- man/future_lapply.Rd | 54 +++++++++++++++++++++++++++++++++++++++----- man/future_mapply.Rd | 10 ++++++-- 14 files changed, 131 insertions(+), 34 deletions(-) diff --git a/NEWS b/NEWS index ac633be..e786330 100644 --- a/NEWS +++ b/NEWS @@ -3,6 +3,12 @@ Package: future.apply Version: 1.3.0-9000 [2019-12-28] +NEW FEATURES: + + * Now all future_nnn() functions set a label on each future that reflects the + name of the future_nnn() function and the index of the chunk. The format + can be controlled by argument 'future.label'. + BUG FIXES: * future_lapply(X) and future_mapply(FUN, X) would drop 'names' argument of diff --git a/R/future_Map.R b/R/future_Map.R index 68055ec..05f21e9 100644 --- a/R/future_Map.R +++ b/R/future_Map.R @@ -16,7 +16,7 @@ #' GPL (>= 2) with 'The R Core Team' as the copyright holder. #' #' @rdname future_mapply -future_Map <- function(f, ...) { +future_Map <- function(f, ..., future.label = "future_Map-%d") { f <- match.fun(f) - future_mapply(FUN = f, ..., SIMPLIFY = FALSE) + future_mapply(FUN = f, ..., SIMPLIFY = FALSE, future.label = future.label) } diff --git a/R/future_apply.R b/R/future_apply.R index 4ba5896..acdc8a3 100644 --- a/R/future_apply.R +++ b/R/future_apply.R @@ -32,8 +32,7 @@ #' @example incl/future_apply.R #' #' @export -future_apply <- function(X, MARGIN, FUN, ...) -{ +future_apply <- function(X, MARGIN, FUN, ..., future.label = "future_apply-%d") { FUN <- match.fun(FUN) ## Ensure that X is an array object @@ -86,7 +85,7 @@ future_apply <- function(X, MARGIN, FUN, ...) } else newX <- lapply(1L:d2, FUN = function(i) array(newX[,i], dim = d.call, dimnames = dn.call)) - ans <- future_lapply(newX, FUN = FUN, ...) + ans <- future_lapply(newX, FUN = FUN, ..., future.label = future.label) ## answer dims and dimnames diff --git a/R/future_by.R b/R/future_by.R index 9697946..9ae688d 100644 --- a/R/future_by.R +++ b/R/future_by.R @@ -63,7 +63,7 @@ future_by.data.frame <- function(data, INDICES, FUN, ..., simplify = TRUE) { -future_by_internal <- function(data, INDICES, FUN, ..., simplify = TRUE, .SUBSETTER, .CALL, .INDICES.NAME) { +future_by_internal <- function(data, INDICES, FUN, ..., simplify = TRUE, .SUBSETTER, .CALL, .INDICES.NAME, future.label = "future_by-%d") { FUN <- if (!is.null(FUN)) match.fun(FUN) stop_if_not(is.function(.SUBSETTER)) @@ -108,7 +108,7 @@ future_by_internal <- function(data, INDICES, FUN, ..., simplify = TRUE, .SUBSET group <- NULL ## Not needed anymore grouped_data <- lapply(X = ans[index], FUN = .SUBSETTER) - ans <- future_lapply(X = grouped_data, FUN = FUN, ...) + ans <- future_lapply(X = grouped_data, FUN = FUN, ..., future.label = future.label) grouped_data <- NULL ## Not needed anymore ansmat <- array({ diff --git a/R/future_eapply.R b/R/future_eapply.R index fc74854..e9e2aee 100644 --- a/R/future_eapply.R +++ b/R/future_eapply.R @@ -12,9 +12,9 @@ #' #' @rdname future_lapply #' @export -future_eapply <- function(env, FUN, ..., all.names = FALSE, USE.NAMES = TRUE) { +future_eapply <- function(env, FUN, ..., all.names = FALSE, USE.NAMES = TRUE, future.label = "future_eapply-%d") { names <- ls(envir = env, all.names = all.names, sorted = FALSE) X <- mget(names, envir = env, inherits = FALSE) if (!USE.NAMES) names(X) <- NULL - future_lapply(X = X, FUN = FUN, ...) + future_lapply(X = X, FUN = FUN, ..., future.label = future.label) } diff --git a/R/future_lapply.R b/R/future_lapply.R index fc3271a..7d4db0e 100644 --- a/R/future_lapply.R +++ b/R/future_lapply.R @@ -51,6 +51,11 @@ #' If `Inf`, then all elements are processed in a single future. #' If `NULL`, then argument `future.scheduling` is used. #' +#' @param future.label If a character string, then each future is assigned +#' a label `sprintf(future.label, chunk_idx)`. If TRUE, then the +#' same as `future.label = "future_lapply-%d"`. If FALSE, no labels +#' are assigned. +#' #' @return #' For `future_lapply()`, a list with same length and names as `X`. #' See [base::lapply()] for details. @@ -134,7 +139,7 @@ #' @importFrom future future resolve values as.FutureGlobals nbrOfWorkers getGlobalsAndPackages FutureError #' @importFrom utils head str #' @export -future_lapply <- function(X, FUN, ..., future.stdout = TRUE, future.conditions = NULL, future.globals = TRUE, future.packages = NULL, future.lazy = FALSE, future.seed = FALSE, future.scheduling = 1.0, future.chunk.size = NULL) { +future_lapply <- function(X, FUN, ..., future.stdout = TRUE, future.conditions = NULL, future.globals = TRUE, future.packages = NULL, future.lazy = FALSE, future.seed = FALSE, future.scheduling = 1.0, future.chunk.size = NULL, future.label = "future_lapply-%d") { stop_if_not(is.function(FUN)) stop_if_not(is.logical(future.stdout), length(future.stdout) == 1L) @@ -149,6 +154,9 @@ future_lapply <- function(X, FUN, ..., future.stdout = TRUE, future.conditions = stop_if_not(length(future.scheduling) == 1L, !is.na(future.scheduling), is.numeric(future.scheduling) || is.logical(future.scheduling)) + stop_if_not(length(future.label) == 1L, !is.na(future.label), + is.logical(future.label) || is.character(future.label)) + ## Coerce to as.list()? if (!is.vector(X) || is.object(X)) X <- as.list(X) @@ -247,6 +255,17 @@ future_lapply <- function(X, FUN, ..., future.stdout = TRUE, future.conditions = nchunks <- length(chunks) fs <- vector("list", length = nchunks) if (debug) mdebugf("Number of futures (= number of chunks): %d", nchunks) + + ## Create labels? + if (isTRUE(future.label)) { + future.label <- "future_lapply-%d" + } + if (is.character(future.label)) { + labels <- sprintf(future.label, seq_len(nchunks)) + stopifnot(length(labels) == nchunks) + } else { + labels <- NULL + } if (debug) mdebugf("Launching %d futures (chunks) ...", nchunks) for (ii in seq_along(chunks)) { @@ -304,7 +323,7 @@ future_lapply <- function(X, FUN, ..., future.stdout = TRUE, future.conditions = if (debug) mdebugf(" - Adjusted option 'future.globals.maxSize': %g -> %d * %g = %g (bytes)", globals.maxSize.default, length(chunk), globals.maxSize.default, getOption("future.globals.maxSize")) on.exit(options(future.globals.maxSize = globals.maxSize), add = TRUE) } - + ## Using RNG seeds or not? if (is.null(seeds)) { if (debug) mdebug(" - seeds: ") @@ -323,7 +342,8 @@ future_lapply <- function(X, FUN, ..., future.stdout = TRUE, future.conditions = conditions = future.conditions, globals = globals_ii, packages = packages_ii, seed = future.seed, - lazy = future.lazy) + lazy = future.lazy, + label = labels[[ii]]) } else { if (debug) mdebugf(" - seeds: [%d] ", length(chunk)) globals_ii[["...future.seeds_ii"]] <- seeds[chunk] @@ -343,7 +363,8 @@ future_lapply <- function(X, FUN, ..., future.stdout = TRUE, future.conditions = conditions = future.conditions, globals = globals_ii, packages = packages_ii, seed = NULL, ## As seed=FALSE but without the RNG check - lazy = future.lazy) + lazy = future.lazy, + label = labels[[ii]]) } ## Not needed anymore diff --git a/R/future_mapply.R b/R/future_mapply.R index d8f8745..5793bb1 100644 --- a/R/future_mapply.R +++ b/R/future_mapply.R @@ -45,7 +45,7 @@ #' @importFrom future Future future resolve values as.FutureGlobals nbrOfWorkers getGlobalsAndPackages FutureError #' @importFrom utils head str #' @export -future_mapply <- function(FUN, ..., MoreArgs = NULL, SIMPLIFY = TRUE, USE.NAMES = TRUE, future.stdout = TRUE, future.conditions = NULL, future.globals = TRUE, future.packages = NULL, future.lazy = FALSE, future.seed = FALSE, future.scheduling = 1.0, future.chunk.size = NULL) { +future_mapply <- function(FUN, ..., MoreArgs = NULL, SIMPLIFY = TRUE, USE.NAMES = TRUE, future.stdout = TRUE, future.conditions = NULL, future.globals = TRUE, future.packages = NULL, future.lazy = FALSE, future.seed = FALSE, future.scheduling = 1.0, future.chunk.size = NULL, future.label = "future_mapply-%d") { FUN <- match.fun(FUN) stop_if_not(is.function(FUN)) @@ -92,6 +92,9 @@ future_mapply <- function(FUN, ..., MoreArgs = NULL, SIMPLIFY = TRUE, USE.NAMES stop_if_not(length(future.scheduling) == 1L, !is.na(future.scheduling), is.numeric(future.scheduling) || is.logical(future.scheduling)) + stop_if_not(length(future.label) == 1L, !is.na(future.label), + is.logical(future.label) || is.character(future.label)) + debug <- getOption("future.debug", FALSE) if (debug) mdebug("future_mapply() ...") @@ -182,7 +185,18 @@ future_mapply <- function(FUN, ..., MoreArgs = NULL, SIMPLIFY = TRUE, USE.NAMES nchunks <- length(chunks) fs <- vector("list", length = nchunks) if (debug) mdebugf("Number of futures (= number of chunks): %d", nchunks) - + + ## Create labels? + if (isTRUE(future.label)) { + future.label <- "future_mapply-%d" + } + if (is.character(future.label)) { + labels <- sprintf(future.label, seq_len(nchunks)) + stopifnot(length(labels) == nchunks) + } else { + labels <- NULL + } + if (debug) mdebugf("Launching %d futures (chunks) ...", nchunks) for (ii in seq_along(chunks)) { chunk <- chunks[[ii]] @@ -256,7 +270,8 @@ future_mapply <- function(FUN, ..., MoreArgs = NULL, SIMPLIFY = TRUE, USE.NAMES conditions = future.conditions, globals = globals_ii, packages = packages_ii, seed = future.seed, - lazy = future.lazy) + lazy = future.lazy, + label = labels[ii]) } else { if (debug) mdebugf(" - seeds: [%d] ", length(chunk)) globals_ii[["...future.seeds_ii"]] <- seeds[chunk] @@ -277,7 +292,8 @@ future_mapply <- function(FUN, ..., MoreArgs = NULL, SIMPLIFY = TRUE, USE.NAMES conditions = future.conditions, globals = globals_ii, packages = packages_ii, seed = NULL, ## As seed=FALSE but without the RNG check - lazy = future.lazy) + lazy = future.lazy, + label = labels[ii]) } ## Not needed anymore diff --git a/R/future_replicate.R b/R/future_replicate.R index e1400f9..594da04 100644 --- a/R/future_replicate.R +++ b/R/future_replicate.R @@ -16,8 +16,9 @@ #' #' @rdname future_lapply future_replicate <- function(n, expr, simplify = "array", - future.seed = TRUE, ...) + future.seed = TRUE, ..., + future.label = "future_replicate-%d") future_sapply(X = integer(n), FUN = eval.parent(substitute(function(...)expr)), simplify = simplify, - future.seed = future.seed, ...) + future.seed = future.seed, ..., future.label = future.label) diff --git a/R/future_sapply.R b/R/future_sapply.R index 24d5fb0..49f8923 100644 --- a/R/future_sapply.R +++ b/R/future_sapply.R @@ -17,8 +17,8 @@ #' 'The R Core Team' as the copyright holder. #' #' @rdname future_lapply -future_sapply <- function(X, FUN, ..., simplify = TRUE, USE.NAMES = TRUE) { - answer <- future_lapply(X = X, FUN = FUN, ...) +future_sapply <- function(X, FUN, ..., simplify = TRUE, USE.NAMES = TRUE, future.label = "future_sapply-%d") { + answer <- future_lapply(X = X, FUN = FUN, ..., future.label = future.label) if (USE.NAMES && is.character(X) && is.null(names(answer))) names(answer) <- X diff --git a/R/future_tapply.R b/R/future_tapply.R index be6e15f..ee7e300 100644 --- a/R/future_tapply.R +++ b/R/future_tapply.R @@ -15,7 +15,8 @@ #' @rdname future_lapply #' @export future_tapply <- function(X, INDEX, FUN = NULL, ..., - default = NA, simplify = TRUE) { + default = NA, simplify = TRUE, + future.label = "future_tapply-%d") { FUN <- if (!is.null(FUN)) match.fun(FUN) if (!is.list(INDEX)) @@ -49,7 +50,7 @@ future_tapply <- function(X, INDEX, FUN = NULL, ..., ans <- split(X, f = group) names(ans) <- NULL index <- as.logical(lengths(ans)) - ans <- future_lapply(X = ans[index], FUN = FUN, ...) + ans <- future_lapply(X = ans[index], FUN = FUN, ..., future.label = future.label) ansmat <- array({ if (simplify && all(lengths(ans) == 1L)) { diff --git a/R/future_vapply.R b/R/future_vapply.R index 50f0315..4a6cd26 100644 --- a/R/future_vapply.R +++ b/R/future_vapply.R @@ -13,7 +13,7 @@ #' @export #' #' @rdname future_lapply -future_vapply <- function(X, FUN, FUN.VALUE, ..., USE.NAMES = TRUE) { +future_vapply <- function(X, FUN, FUN.VALUE, ..., USE.NAMES = TRUE, future.label = "future_vapply-%d") { ## Coerce to as.list()? if (!is.vector(X) || is.object(X)) X <- as.list(X) @@ -44,7 +44,7 @@ future_vapply <- function(X, FUN, FUN.VALUE, ..., USE.NAMES = TRUE) { } stop_if_not(all(dim(value) == dim), typeof(value) %in% valid_types) value - }, ...) + }, ..., future.label = future.label) if (!is.null(dim)) { dim_res <- c(dim, n) diff --git a/man/future_apply.Rd b/man/future_apply.Rd index 2516877..21a52c5 100644 --- a/man/future_apply.Rd +++ b/man/future_apply.Rd @@ -4,7 +4,7 @@ \alias{future_apply} \title{Apply Functions Over Array Margins via Futures} \usage{ -future_apply(X, MARGIN, FUN, ...) +future_apply(X, MARGIN, FUN, ..., future.label = "future_apply-\%d") } \arguments{ \item{X}{an array, including a matrix.} @@ -17,6 +17,11 @@ dimension names.} \item{FUN}{A function taking at least one argument.} +\item{future.label}{If a character string, then each future is assigned +a label \code{sprintf(future.label, chunk_idx)}. If TRUE, then the +same as \code{future.label = "future_lapply-\%d"}. If FALSE, no labels +are assigned.} + \item{\ldots}{(optional) Additional arguments passed to \code{FUN()}, except \verb{future.*} arguments, which are passed on to \code{future_lapply()} used internally.} diff --git a/man/future_lapply.Rd b/man/future_lapply.Rd index 43f7b86..24dac9e 100644 --- a/man/future_lapply.Rd +++ b/man/future_lapply.Rd @@ -11,7 +11,14 @@ \alias{future_vapply} \title{Apply a Function over a List or Vector via Futures} \usage{ -future_eapply(env, FUN, ..., all.names = FALSE, USE.NAMES = TRUE) +future_eapply( + env, + FUN, + ..., + all.names = FALSE, + USE.NAMES = TRUE, + future.label = "future_eapply-\%d" +) future_lapply( X, @@ -24,16 +31,46 @@ future_lapply( future.lazy = FALSE, future.seed = FALSE, future.scheduling = 1, - future.chunk.size = NULL + future.chunk.size = NULL, + future.label = "future_lapply-\%d" ) -future_replicate(n, expr, simplify = "array", future.seed = TRUE, ...) +future_replicate( + n, + expr, + simplify = "array", + future.seed = TRUE, + ..., + future.label = "future_replicate-\%d" +) -future_sapply(X, FUN, ..., simplify = TRUE, USE.NAMES = TRUE) +future_sapply( + X, + FUN, + ..., + simplify = TRUE, + USE.NAMES = TRUE, + future.label = "future_sapply-\%d" +) -future_tapply(X, INDEX, FUN = NULL, ..., default = NA, simplify = TRUE) +future_tapply( + X, + INDEX, + FUN = NULL, + ..., + default = NA, + simplify = TRUE, + future.label = "future_tapply-\%d" +) -future_vapply(X, FUN, FUN.VALUE, ..., USE.NAMES = TRUE) +future_vapply( + X, + FUN, + FUN.VALUE, + ..., + USE.NAMES = TRUE, + future.label = "future_vapply-\%d" +) } \arguments{ \item{env}{An \R environment.} @@ -46,6 +83,11 @@ See \code{\link[base:eapply]{base::eapply()}} for details.} \item{USE.NAMES}{See \code{\link[base:sapply]{base::sapply()}}.} +\item{future.label}{If a character string, then each future is assigned +a label \code{sprintf(future.label, chunk_idx)}. If TRUE, then the +same as \code{future.label = "future_lapply-\%d"}. If FALSE, no labels +are assigned.} + \item{X}{A vector-like object to iterate over.} \item{future.stdout}{If \code{TRUE} (default), then the standard output of the diff --git a/man/future_mapply.Rd b/man/future_mapply.Rd index b7de41c..9e4e0b1 100644 --- a/man/future_mapply.Rd +++ b/man/future_mapply.Rd @@ -5,7 +5,7 @@ \alias{future_mapply} \title{Apply a Function to Multiple List or Vector Arguments} \usage{ -future_Map(f, ...) +future_Map(f, ..., future.label = "future_Map-\%d") future_mapply( FUN, @@ -20,13 +20,19 @@ future_mapply( future.lazy = FALSE, future.seed = FALSE, future.scheduling = 1, - future.chunk.size = NULL + future.chunk.size = NULL, + future.label = "future_mapply-\%d" ) } \arguments{ \item{f}{A function of the arity \eqn{k} if \code{future_Map()} is called with \eqn{k} arguments.} +\item{future.label}{If a character string, then each future is assigned +a label \code{sprintf(future.label, chunk_idx)}. If TRUE, then the +same as \code{future.label = "future_lapply-\%d"}. If FALSE, no labels +are assigned.} + \item{FUN}{A function to apply, found via \code{\link[base:match.fun]{base::match.fun()}}.} \item{MoreArgs}{A list of other arguments to \code{FUN}.}