有条件地修改父函数的行为

Question

背景

我感兴趣的是return将对象连接到函数的父框架并停止执行父函数而不会出错。

备注

我经历了一些讨论 on the SO and agree with a wider point that this is not necessarily best practice. I'm mostly interested in doing this for educational purposed and gaining better understanding of how to make use of the function call stack。

可重现的例子

check_conditions

此函数应检查条件，并在某些特定情况下 return 结果返回给父函数。

check_conditions <- function(x) {
    stopifnot(is.numeric(x),
              x %% 1 == 0)
    # And for x == 9 always return 9
    if (x == 9) {
        eval.parent(return(1))
        stop()
    }
}

其他功能

其余函数利用 check_conditions 函数并在以后做自己的事情（或不做，如果停止）。

fun_a <- function(x) {
    check_conditions(x)
    x^2
}

fun_b <- function(x) {
    check_conditions(x)
    x+1
}

问题

>> fun_b(1)
[1] 2

>> fun_a(9)
[1] 81

>> fun_b(9)
[1] 10

在上面的示例中，我希望 fun_a 和 fun_b 为 return 值 1，按照条件：

if (x == 9) {
            eval.parent(return(1))
            stop()
        }

备注

• 我不想 return 错误消息。 应该没有消息 表明 fun_a 和 fun_b 之间的其余调用未被处理。

更新 （根据评论）

• 我不想改fun_a或fun_b的正文，check_conditions可以改。

• 应该可以更改假设的 fun_n 的行为，该 fun_n 也引用了 check_conditions 而无需 编辑该函数。 check_conditions 应该能够 return 并停止 （没有错误或警告） 和 return 函数父环境中的值，R-ish 伪代码

  check_conditions <- function(x) {
  if (x == 9) {
     call(env = parent.frame(),
          expr = {
                  return(1)
                  # Do not execute anything else from 
                  # the parent environment.
          }
    }
   }
  

Answer 1

这是根据旧答案修改的。它不要求更改 check_conditions 或 fun_a，但确实要求：

• fun_a通过fun_a <- validity_check(fun_a)等调用注册，之后可以使用fun_a
• 对check_conditions的调用必须在正文的第一行
• check_conditions 采用与 fun_a
相同的参数

代码：

validity_check <- function(fun) {
   cl <- body(fun)[[2]][[1]]
   function(...) {
     mc <- match.call()
     mc[[1]] <- cl
     check_val <- eval.parent(mc)
     if (!is.null(check_val)) check_val
     else fun(...) 
   }
}

# test - fun_a and check_conditions as in question

fun_a <- validity_check(fun_a)

fun_a(9)
## [1] 1

fun_a(2)
## [1] 4

较早的答案我不清楚什么可以改变什么不能改变但是如果我们可以修改所有功能那么：

check_conditions <- function(x) {
    stopifnot(is.numeric(x), x %% 1 == 0)
    if (x == 9) structure(1, class = "bad")
}

fun_a <- function(x) {
  cc <- check_conditions(x)
  if (inherits(cc, "bad")) unclass(cc) else x^2
}

fun_a(9)
## [1] 1

fun_a(2)
## [1] 4