Nothing
source("incl/start.R")
if (requireNamespace("future.apply", quietly = TRUE)) {
future_lapply <- future.apply::future_lapply
library("listenv")
## Setup all strategies including custom once for testing on HPC environments
print(all_strategies())
message("All HPC strategies:")
strategies <- c("batchtools_lsf", "batchtools_openlava", "batchtools_sge",
"batchtools_slurm", "batchtools_torque")
mprint(strategies, debug = TRUE)
message("Supported HPC strategies:")
strategies <- strategies[sapply(strategies, FUN = test_strategy)]
mprint(strategies, debug = TRUE)
strategies <- c("batchtools_local", strategies)
if (fullTest) {
strategies <- c("batchtools_interactive", strategies)
batchtools_custom_local <- function(expr, substitute = TRUE,
cluster.functions = batchtools::makeClusterFunctionsInteractive(external = TRUE), ...) {
if (substitute) expr <- substitute(expr)
batchtools_custom(expr, substitute = FALSE, ...,
cluster.functions = cluster.functions)
}
class(batchtools_custom_local) <- c("batchtools_custom_local",
class(batchtools_custom))
strategies <- c("batchtools_custom_local", strategies)
}
## CRAN processing times: Don't run these tests on Windows 32-bit
if (!fullTest && isWin32) strategies <- character(0L)
message("Strategies to test with:")
mprint(strategies, debug = TRUE)
message("*** future_lapply() ...")
message("- future_lapply(x, FUN = vector, ...) ...")
x <- list(a = "integer", c = "character", c = "list")
str(list(x = x))
y0 <- lapply(x, FUN = vector, length = 2L)
str(list(y0 = y0))
for (strategy in strategies) {
mprintf("- plan('%s') ...\n", strategy)
plan(strategy)
mprint(plan, debug = TRUE)
if (nbrOfWorkers() > 2) plan(strategy, workers = 2L)
stopifnot(nbrOfWorkers() < Inf)
for (scheduling in list(FALSE, TRUE)) {
y <- future_lapply(x, FUN = vector, length = 2L,
future.scheduling = scheduling)
str(list(y = y))
stopifnot(identical(y, y0))
}
}
message("- future_lapply(x, FUN = base::vector, ...) ...")
x <- list(a = "integer", c = "character", c = "list")
str(list(x = x))
y0 <- lapply(x, FUN = base::vector, length = 2L)
str(list(y0 = y0))
for (strategy in strategies) {
mprintf("- plan('%s') ...\n", strategy)
plan(strategy)
mprint(plan, debug = TRUE)
if (nbrOfWorkers() > 2) plan(strategy, workers = 2L)
stopifnot(nbrOfWorkers() < Inf)
for (scheduling in list(FALSE, TRUE)) {
y <- future_lapply(x, FUN = base::vector, length = 2L,
future.scheduling = scheduling)
str(list(y = y))
stopifnot(identical(y, y0))
}
}
message("- future_lapply(x, FUN = future:::hpaste, ...) ...")
x <- list(a = c("hello", b = 1:100))
str(list(x = x))
y0 <- lapply(x, FUN = future:::hpaste, collapse = "; ", maxHead = 3L)
str(list(y0 = y0))
for (strategy in strategies) {
mprintf("- plan('%s') ...\n", strategy)
plan(strategy)
mprint(plan, debug = TRUE)
if (nbrOfWorkers() > 2) plan(strategy, workers = 2L)
stopifnot(nbrOfWorkers() < Inf)
for (scheduling in list(FALSE, TRUE)) {
y <- future_lapply(x, FUN = future:::hpaste, collapse = "; ",
maxHead = 3L, future.scheduling = scheduling)
str(list(y = y))
stopifnot(identical(y, y0))
}
}
message("- future_lapply(x, FUN = listenv::listenv, ...) ...")
x <- list()
y <- listenv()
y$A <- 3L
x$a <- y
y <- listenv()
y$A <- 3L
y$B <- c("hello", b = 1:100)
x$b <- y
print(x)
y0 <- lapply(x, FUN = listenv::mapping)
str(list(y0 = y0))
for (strategy in strategies) {
mprintf("- plan('%s') ...\n", strategy)
plan(strategy)
if (nbrOfWorkers() > 2) plan(strategy, workers = 2L)
stopifnot(nbrOfWorkers() < Inf)
for (scheduling in list(FALSE, TRUE)) {
y <- future_lapply(x, FUN = listenv::mapping, future.scheduling = scheduling)
str(list(y = y))
stopifnot(identical(y, y0))
}
}
message("- future_lapply(x, FUN, ...) for large length(x) ...")
a <- 3.14
x <- 1:1e5
y <- future_lapply(x, FUN = function(z) sqrt(z + a))
y <- unlist(y, use.names = FALSE)
stopifnot(all.equal(y, sqrt(x + a)))
message("- future_lapply() with global in non-attached package ...")
library("tools")
my_ext <- function(x) file_ext(x)
y_truth <- lapply("abc.txt", FUN = my_ext)
for (strategy in strategies) {
plan(strategy)
if (nbrOfWorkers() > 2) plan(strategy, workers = 2L)
stopifnot(nbrOfWorkers() < Inf)
y <- future_lapply("abc.txt", FUN = my_ext)
stopifnot(identical(y, y_truth))
}
message("*** future_lapply() ... DONE")
}
source("incl/end.R")
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.