inst/testme/test-future.apply-future_mapply.R

In futurize: Parallelize Common Functions via One Magic Function

#' @tags future_mapply
#' @tags sequential multisession multicore

if (requireNamespace("future.apply", quietly = TRUE)) {

library(futurize)

message("*** future_mapply() ...")

message("- Parallel RNG truth (for later)...")
plan(sequential)
y_rng_0 <- mapply(stats::runif, n = 1:4, max = 2:5,
                         MoreArgs = list(min = 1)) |> futurize(seed = 0xBEEF)
print(y_rng_0)

for (strategy in supportedStrategies()) {
  message(sprintf("*** strategy = %s ...", sQuote(strategy)))
  plan(strategy)

  message("- From example(mapply) ...")
  y0 <- mapply(rep, 1:4, 4:1)
  y1 <- mapply(rep, 1:4, 4:1) |> futurize()
  stopifnot(identical(y1, y0))
  y2 <- mapply("rep", 1:4, 4:1) |> futurize()
  stopifnot(identical(y2, y0))
  
  y0 <- mapply(rep, times = 1:4, x = 4:1)
  y1 <- mapply(rep, times = 1:4, x = 4:1) |> futurize()
  stopifnot(identical(y1, y0))
  
  y0 <- mapply(rep, times = 1:4, MoreArgs = list(x = 42))
  y1 <- mapply(rep, times = 1:4, MoreArgs = list(x = 42)) |> futurize()
  stopifnot(identical(y1, y0))
  
  y0 <- mapply(function(x, y) seq_len(x) + y,
               c(a =  1, b = 2, c = 3),  # names from first
               c(A = 10, B = 0, C = -10))
  y1 <- mapply(function(x, y) seq_len(x) + y,
                      c(a =  1, b = 2, c = 3),  # names from first
                      c(A = 10, B = 0, C = -10)) |> futurize()
  stopifnot(identical(y1, y0))

  message("- future_.mapply()")
  dots <- list(c(a =  1, b = 2, c = 3),  # names from first
               c(A = 10, B = 0, C = -10))
  y2 <- .mapply(function(x, y) seq_len(x) + y, dots = dots, MoreArgs = list())
  names(y0) <- NULL  ## .mapply() don't set names
  stopifnot(all.equal(y2, y0))
  y3 <- .mapply(function(x, y) seq_len(x) + y, dots = dots, MoreArgs = list()) |> futurize()
  stopifnot(all.equal(y3, y2))

  word <- function(C, k) paste(rep.int(C, k), collapse = "")
  for (chunk_size in list(1L, structure(2L, ordering = "random"), structure(3L, ordering = 5:1))) {
    y0 <- mapply(word, LETTERS[1:5], 5:1, SIMPLIFY = FALSE)
    y1 <- mapply(word, LETTERS[1:5], 5:1, SIMPLIFY = FALSE) |> futurize(chunk_size = chunk_size)
    stopifnot(identical(y1, y0))

    dots <- list(LETTERS[1:5], 5:1)
    MoreArgs <- list()
    y2 <- .mapply(word, dots = dots, MoreArgs = list())
    names(y0) <- NULL  ## .mapply() don't set names
    stopifnot(all.equal(y2, y0))
    y3 <- .mapply(word, dots = dots, MoreArgs = list()) |> futurize()
    stopifnot(all.equal(y3, y2))
  }

  message("- Subsetting (Issue #17) ...")
  X <- as.Date("2018-06-01")
  y0 <- mapply(FUN = identity, X, SIMPLIFY = FALSE)
  y1 <- mapply(FUN = identity, X, SIMPLIFY = FALSE) |> futurize()
  stopifnot(identical(y1, y0))

  dots <- list(X)
  y2 <- .mapply(FUN = identity, dots = dots, MoreArgs = MoreArgs)
  stopifnot(identical(y2, y0))
  y3 <- .mapply(FUN = identity, dots = dots, MoreArgs = MoreArgs) |> futurize()
  stopifnot(identical(y3, y2))

  message("- Non-recycling of MoreArgs (Issue #51) ...")
  y0 <- base::mapply(
    function(x, y) y,
    x = 1:2, MoreArgs = list(y = 3:4)
  )
  y1 <- mapply(
    function(x, y) y,
    x = 1:2, MoreArgs = list(y = 3:4)
  ) |> futurize(seed = FALSE)
  stopifnot(identical(y1, y0))
  y2 <- mapply(
    function(x, y) y,
    x = 1:2, MoreArgs = list(y = 3:4)
  ) |> futurize(seed = TRUE)
  stopifnot(identical(y2, y0))

  dots <- list(x = 1:2)
  MoreArgs <- list(y = 3:4)
  y3 <- .mapply(function(x, y) y, dots = dots, MoreArgs = MoreArgs)
  y4 <- .mapply(function(x, y) y, dots = dots, MoreArgs = MoreArgs) |> futurize()
  stopifnot(identical(y4, y3))

  message("- Recycle arguments to same length ...")
  y0 <- mapply(rep, 1:4, 2:1)
  y1 <- mapply(rep, 1:4, 2:1) |> futurize()
  stopifnot(identical(y1, y0))

  
  message("- Parallel RNG ...")
  y_rng_1 <- mapply(stats::runif, n = 1:4, max = 2:5,
                           MoreArgs = list(min = 1)) |> futurize(seed = 0xBEEF)
  print(y_rng_1)
  stopifnot(all.equal(y_rng_1, y_rng_0))

  message("- future_Map() ...")
  xs <- replicate(5, stats::runif(10), simplify = FALSE)
  ws <- replicate(5, stats::rpois(10, 5) + 1, simplify = FALSE)
  y0 <- Map(weighted.mean, xs, ws)
  y1 <- Map(stats::weighted.mean, xs, ws) |> futurize()
  stopifnot(all.equal(y1, y0))

  message("- future_mapply() - 'max-or-0-if' recycling rule ...")
  ## R (>= 4.2.0): mapply() & Map() follow usual "max-or-0-if" recycling rule
  ## and keeps returning a named list in the "empty" case.
  
  truth <- list()
  if (getRversion() >= "4.2.0") {
    y0 <- mapply(`+`, 1:3, NULL)
    stopifnot(identical(y0, truth))
  }
  y <- mapply(`+`, 1:3, NULL) |> futurize()
  stopifnot(identical(y, truth))
  
  truth <- setNames(list(), character())
  if (getRversion() >= "4.2.0") {
    y0 <- mapply(paste, character(), NULL)
    stopifnot(identical(y0, truth))
  }
  y <- mapply(paste, character(), NULL) |> futurize()
  stopifnot(identical(y, truth))
  
  if (getRversion() >= "4.2.0") {
    y0 <- mapply(paste, character(), letters)
    stopifnot(identical(y0, truth))
  }
  y <- mapply(paste, character(), letters) |> futurize()
  stopifnot(identical(y, truth))
  
  if (getRversion() >= "4.2.0") {
    y0 <- mapply(paste, "A", character())
    stopifnot(identical(y0, truth))
  }
  y <- mapply(paste, "A", character()) |> futurize()
  stopifnot(identical(y, truth))
  
  if (getRversion() >= "4.2.0") {
    y0 <- mapply(paste, character(), letters) 
    stopifnot(identical(y0, truth))
  }
  y <- mapply(paste, character(), letters) |> futurize()
  stopifnot(identical(y, truth))
  
  if (getRversion() >= "4.2.0") {
    y0 <- mapply(paste, character(), NULL)
    stopifnot(identical(y0, truth))
  }
  y <- mapply(paste, character(), NULL) |> futurize()
  stopifnot(identical(y, truth))
  
  if (getRversion() >= "4.2.0") {
    y0 <- mapply(paste, character(), letters)
    stopifnot(identical(y0, truth))
  }
  y <- mapply(paste, character(), letters) |> futurize()
  stopifnot(identical(y, truth))
  
  if (getRversion() >= "4.2.0") {
    y0 <- mapply(paste, "A", character()) 
    stopifnot(identical(y0, truth))
  }
  y <- mapply(paste, "A", character()) |> futurize()
  stopifnot(identical(y, truth))
  
  if (getRversion() >= "4.2.0") {
    y0 <- mapply(paste, character(), letters) 
    stopifnot(identical(y0, truth))
  }
  y <- mapply(paste, character(), letters) |> futurize()
  stopifnot(identical(y, truth))

  ## Gives an error in R-devel (2021-11-26 r81252)
  if (getRversion() >= "4.2.0" && FALSE) {
    y0 <- mapply(paste, c(a = "A"), character())
    stopifnot(identical(y0, truth))
  }
  y <- mapply(paste, c(a = "A"), character()) |> futurize()
  stopifnot(identical(y, truth))

  ## R (>= 4.2.0): Map() now recycles similar to basic Ops:
  truth <- as.list(1 + 1:3)
  if (getRversion() >= "4.2.0") {
    y0 <- Map(`+`, 1, 1:3)
    stopifnot(identical(y0, truth))
  }
  y <- Map(`+`, 1, 1:3) |> futurize()
  stopifnot(identical(y, truth))
  
  truth <- as.list(numeric() + 1:3)
  if (getRversion() >= "4.2.0") {
    y0 <- Map(`+`, numeric(), 1:3)
    stopifnot(identical(y0, truth))
  }
  y <- Map(`+`, numeric(), 1:3) |> futurize()
  stopifnot(identical(y, truth))

  message("- mapply(x, ...) |> futurize() where x[[i]] subsets via S3 method ...")
  x <- structure(list(a = 1, b = 2), class = "Foo")
  `[[.Foo` <- function(x, ...) 0
  registerS3method("[[", class = "Foo", method = `[[.Foo`)
  y0 <- mapply(x, FUN = identity)
  stopifnot(identical(y0, c(a = 0, b = 0)))
  y1 <- mapply(x, FUN = identity) |> futurize()
  if (getOption("future.apply.chunkWith", "[[") == "[") {
    stopifnot(identical(y1, unlist(x)))
  } else {
    stopifnot(identical(y1, y0))
  }

  plan(sequential)
  message(sprintf("*** strategy = %s ... done", sQuote(strategy)))
} ## for (strategy in ...) 

message("- Empty input [non parallel] ...")
y0 <- mapply(search)
y1 <- mapply(search) |> futurize()
stopifnot(identical(y1, y0))

y0 <- mapply(list, integer(0L))
y1 <- mapply(list, integer(0L)) |> futurize()
stopifnot(identical(y1, y0))

message("*** future_mapply() - special cases ...")

X <- list()
names(X) <- character(0L)

y <- mapply(FUN = identity, X) |> futurize()
stopifnot(length(y) == 0L, !is.null(names(y)), identical(y, X))

y <- mapply(FUN = identity, X, X) |> futurize()
stopifnot(length(y) == 0L, !is.null(names(y)), identical(y, X))

message("*** future_mapply() - special cases ... DONE")

message("*** future_mapply() ... DONE")

} ## if (requireNamespace("future.apply", quietly = TRUE))