Question

mclapply()所有已发出的警告似乎都会被取消：

library(multicore) 
mclapply(1:3, function(x) warning(x))
[[1]]
[1] "1"

[[2]]
[1] "2"

[[3]]
[1] "3"

而lapply会给出：

lapply(1:3, function(x) warning(x))
[[1]]
[1] "1"

[[2]]
[1] "2"

[[3]]
[1] "3"

Warning messages:
1: In FUN(1:3[[3L]], ...) : 1
2: In FUN(1:3[[3L]], ...) : 2
3: In FUN(1:3[[3L]], ...) : 3

有关如何避免丢失警告的任何提示？

Answer 1

根据mclapply的帮助页面，在我看来，论据mc.silent应该允许您选择是否要打印警告。奇怪的是，它没有那样做。明确地将其设置为TRUE或FALSE对您的情况没有任何影响。

因此，只留下一些有点肮脏的黑客：迫使R在出现警告时打印警告。

options(warn=1)
mclapply(1:3, function(x) warning(x))

# Warning in FUN(1L[[1L]], ...) : 1
# Warning in FUN(2L[[1L]], ...) : 2
# Warning in FUN(3L[[1L]], ...) : 3
# [[1]]
# [1] "1"
#
# [[2]]
# [1] "2"
#
# [[3]]
# [1] "3"

Answer 2

我也有这个问题。如果我正确阅读代码，parallel::mclapply()会将mc.silent选项传递给parallel:mcparallel()。但是mcparallel()有这一行：

sendMaster(try(eval(expr, env), silent = TRUE))

我认为这是将警告发送回主进程的地方，但mc.silent不受尊重。这是我对正在发生的事情的最好猜测。

Answer 3

对于将遇到相同问题的任何人，这是一种解决方法：

safe_mclapply <- function(X, FUN, mc.cores, stop.on.error=T, ...){
  fun <- function(x){
    res_inner <- tryCatch({
      withCallingHandlers(
        expr = {
          FUN(x, ...)
        }, 
        warning = function(e) {
          message_parallel(trimws(paste0("WARNING [element ", x,"]: ", e)))
          # this line is required to continue FUN execution after the warning
          invokeRestart("muffleWarning")
        },
        error = function(e) {
          message_parallel(trimws(paste0("ERROR [element ", x,"]: ", e)))
        }
      )},
      error = function(e){
        # error is returned gracefully; other results of this core won't be affected
        return(e)
      }
    )
    return(res_inner)
  }
  
  res <- mclapply(X, fun, mc.cores=mc.cores)
  failed <- sapply(res, inherits, what = "error")
  if (any(failed == T)){
    error_indices <- paste0(which(failed == T), collapse=", ")
    error_traces <- paste0(lapply(res[which(failed == T)], function(x) x$message), collapse="\n\n")
    error_message <- sprintf("Elements with following indices failed with an error: %s. Error messages: \n\n%s", 
                             error_indices,
                             error_traces)
    if (stop.on.error)
      stop(error_message)
    else
      warning(error_message, "\n\n### Errors will be ignored ###")
  }
  return(res[!failed])
}

#' Function which prints a message using shell echo; useful for printing messages from inside mclapply when running in Rstudio
message_parallel <- function(...){
  system(sprintf('echo "\n%s\n"', paste0(..., collapse="")))
}

上面的

safe_mclapply是mclapply的包装。对于每次迭代，它使用withCallingHandlers捕获并打印警告和错误；请注意，需要invokeRestart("muffleWarning")才能继续执行FUN并返回结果。通过message_parallel函数进行打印，该函数使用外壳程序echo将消息打印到R控制台（经测试可在Rstudio中使用）。

safe_mclapply提供了一些其他功能，您可能会发现它们是可选的：

在警告和错误的同时，它还会打印x的字符表示形式，这对我很有用，因为它给出了消息来自何处的提示
tryCatch周围的{li} withCallingHandlers有助于正常返回错误，从而不会影响核心的其他结果
执行mclapply后，将打印错误结果的索引
stop.on.error提供了一个选项，可以忽略任何包含错误的结果，即使出现错误也可以继续执行

旁注：我个人更喜欢pbmcapply中的pbmclapply函数而不是mclapply，后者增加了进度条。您可以在上面的代码中将mclapply更改为pbmclapply。

小段代码进行测试：

X <- list(1, 2, 3, 4, 5, 6)
f <- function(x){
  if (x == 3){
    warning("a warning")
    warning("second warning")
  }
  if (x == 6){
    stop("an error")
  }
  return(x + 1)
}

res <- safe_mclapply(X = X, FUN = f, mc.cores=16)
res_no_stop <- safe_mclapply(X = X, FUN = f, mc.cores=16, stop.on.error = F)

在R中使用mclapply抑制警告

3 个答案: