R：访问被中止的 R 代码的结果

Question

我正在使用 R 编程语言。

假设我有以下功能：

library(GA)

Rastrigin <- function(x1, x2)
{
  20 + x1^2 + x2^2 - 10*(cos(2*pi*x1) + cos(2*pi*x2))
}

举个例子，假设我尝试使用某种优化算法来优化此函数并请求大量迭代：

GA <- ga(type = "real-valued", 
         fitness =  function(x) -Rastrigin(x[1], x[2]),
         lower = c(-5.12, -5.12), upper = c(5.12, 5.12), 
         popSize = 50, maxiter = 10000, run = 10000)

在运行执行此代码后，我快速单击“红色停止标志按钮”以中止此代码：

如此处所示：

我请求优化算法运行进行 10000 次迭代，但我在 959 次迭代后手动中止了代码。
因此，从未创建“GA 对象”（即存储优化进度的 R 对象）。

GA

错误：找不到对象 'GA'

我的问题：计算机仍然执行了大量工作 - 理想情况下，我想看看计算机在优化和检查在代码中止之前获得的最新解决方案。 但是由于从未创建“GA 对象”，我无法从日志中推断出最新的解决方案是什么 - 我只能看到“平均值”和在最新解决方案（而不是当前解决方案本身）评估的函数的“最佳”值。

例如，假设我让优化运行完成 - 然后我可以访问优化的全部结果：

GA_complete <- ga(type = "real-valued", 
         fitness =  function(x) -Rastrigin(x[1], x[2]),
         lower = c(-5.12, -5.12), upper = c(5.12, 5.12), 
         popSize = 50, maxiter = 10, run = 10)

head(GA_complete@population)
            [,1]        [,2]
[1,] -0.04222106 -0.04219359
[2,]  0.33339796 -0.03329398
[3,]  0.59785640 -0.31436130
[4,] -0.07623396  0.15844942
[5,]  0.96052009 -0.04702174
[6,]  0.02373485 -0.03466375

head(GA_complete@fitness)
[1]  -0.7027423 -15.3337890 -32.5594724  -5.7160470  -1.6641805  -0.3490039

是否有可能在代码中止时以某种方式“访问”最新的解决方案？ 我们能否以某种方式访问日志并查看中间结果results/progress 的中止代码？

谢谢！

Answer 1

在large-scale处理过程中保存工作的能力完全依赖于函数本身，这意味着如果你想有一个可中断的调用并保留中间结果，那么你需要重写函数本身，以便它具有此功能，将优雅地捕获错误和 return 数据。建议这样做的一件事是 https://community.rstudio.com/t/how-to-catch-the-keyboard-interruption-in-r/7336，其中可以将 tryCatch 与 interrupt= 处理程序一起使用，如：

tryCatch(for (i in 1:1e6) mean(rcauchy(1:1e6)), interrupt = function(e) "foo")

我认为tryCatch的常规用法是捕捉error=，可能还有warning=，但interrupt=的用法在野外并不常见。（我没有寻找它......但我从来没有一个函数对我打断它做出优雅的反应。我知道一些 purrr:: 函数使用它。）

如果您不愿意花时间重写 ga 的内部结构来处理这个问题（也许这不是一件小事），我建议您在外部处理它。而不是运行将它 10000 次，也许你只运行它 100 或 10 左右，并在外部重复它以填充到所需的体积。

这里有一个可能对您有用的辅助函数。（我没有用 ga 测试过它，但我想它仍然可以适应它。）

interruptible <- function(expr, n = 1) {
  stopifnot(n > 0)
  n <- as.integer(n)
  expr <- substitute(expr)
  out <- list()
  interrupted <- structure(list(), class = "interrupted")
  i <- 0L
  while (i < n) {
    this <- tryCatch(eval(expr), interrupt = function(e) interrupted)
    if (inherits(this, "interrupted")) break
    out <- c(out, list(this))
    i <- i + 1L
  }
  if (i < n) warning(sprintf("interrupted, %i/%i completed", i, n), call. = FALSE)
  out
}

还有一个简单的 test-run:

out <- interruptible({Sys.sleep(2); message(Sys.time()); runif(1);}, 3)
# 2022-04-02 13:55:46
# 2022-04-02 13:55:48
# 2022-04-02 13:55:50
out
# [[1]]
# [1] 0.2934904
# [[2]]
# [1] 0.7578942
# [[3]]
# [1] 0.8208736

让我们打断那个mid-run:

out <- interruptible({Sys.sleep(2); message(Sys.time()); runif(1);}, 3)
# 2022-04-02 13:55:55
# 2022-04-02 13:55:57
C-c C-c                           # <--- I use emacs/ess, this is me interrupting it
# Warning: interrupted, 1/3 completed
out
# [[1]]
# [1] 0.7229554
# [[2]]
# [1] 0.4721477

由调用者决定如何合并结果。在这种情况下，它可能只是 c 连接结果（unlist 或 do.call(c, out)），但如果帧或矩阵是 returned，那么它可能会合并使用 do.call(rbind, out) 或 dplyr::bind_rows(out) 或 data.table::rbindlist(out).

我怀疑（未经测试）您可以做类似的事情：

GA_complete <- interruptible(
  ga(type = "real-valued", 
     fitness =  function(x) -Rastrigin(x[1], x[2]),
     lower = c(-5.12, -5.12), upper = c(5.12, 5.12), 
     popSize = 50, maxiter = 10, run = 10),
  n = 1000)

然后找到一种方法来组合每个结果；因为 return 值不是一个简单的框架，所以可能 elbow-grease 将每个 @-slots 组合起来，或者你不应该尝试将它们全部组合起来，只是您需要的特定结果。

N.B.: 我认识到运行将一个遗传算法用于 10 代并重复 1000 次与一个单一的 10000 代运行不同。不幸的是，为了在能够用 saved-state 打断它的同时获得这种效果，你需要改变 ga 本身，而且我不愿意只是“尝试”一个 SO 问题. ga 可以运行在 parallel.

R：访问被中止的 R 代码的结果

R: Accessing the Results of R Code that was Aborted

optimization

r

function

abort