如何绕过“乐趣”这一事实，从评估“价值”开始？

Question

考虑以下函数，如果条件为TRUE，则它将lhs替换为值。

`==<-` <- function (e1, e2, value) replace(e1, e1 == e2, value)

如果x == 3将x替换为42：

x <- 3
x == 3 <- 42
x
# [1] 42

到目前为止还不错，但是如果value有副作用呢？到目前为止，即使我的条件是FALSE，也会对其进行评估。

# desired: if x == 100, stop
x == 100 <- stop("equals 100!")
# Error: equals 100!

有办法绕道吗？

请看下面我找到的一些解决办法，但我想看看是否还有更多。

编辑:

这是针对sotos的评论：

`==<-` <- function (e1, e2, value) {
  cond <- e1 == e2
  if(any(cond)) 
    replace(e1, cond, value)
  else e1
}

x <- 3; x == 100 <- 'xyz'
x
# [1] 3

Answer 1

以下是一些解决这一问题的方法：

1. quote和修改==<-，因此它总是计算引用的调用。
2. 使用~作为引用函数
3. 使用~作为函数的缩写，并使用rlang::as_function
4. 使用函数delay来引用输入，并添加一个类delayed，以便只计算未引用的输入和delayed引用的输入。
5. 覆盖<-以识别==<-，并始终对lhs进行delay

最后一种方法是在不改变接口的情况下工作的唯一方法，尽管它的工作方式是重写<-，这通常是不可取的。

1. quote和修改==<-，以便它总是计算引用的调用

如果我们知道我们不想分配未评估的调用，我们可以确保我们的函数评估所有内容，并引用我们的输入。

`==<-` <- function (e1, e2, value) {
  cond <- e1 == e2
  if(any(cond)) 
    replace(e1, e1 == e2, eval.parent(value))
  else e1
}

x <- 42
x == 100 <- quote(stop("equals 100!"))
x <- 100
x == 100 <- quote(stop("equals 100!"))
# Error in eval(expr, envir, enclos) : equals 100! 

2.使用~作为引用函数

如果我们知道我们不想分配公式，我们可以使用~而不是引用。

`==<-` <- function (e1, e2, value) {
  cond <- e1 == e2
  if(any(cond)) 
    replace(e1, e1 == e2,
            if(inherits(value, "formula")) 
              eval.parent(as.list(value)[[2]])
            else
              value)
  else e1
}


x <- 42
x == 100 <- ~stop("equals 100!")
x <- 100
x == 100 <- ~stop("equals 100!")
# Error in eval(expr, envir, enclos) : equals 100! 

3.使用~作为函数的缩写，并使用rlang::as_function

如果我们知道我们不想分配函数或公式，我们可以更进一步，用它构建一个特性。

`==<-` <- function (e1, e2, value) {
  cond <- e1 == e2
  if(any(cond)) 
    replace(e1, e1 == e2,
            if(inherits(value, "formula") || is.function(value)) 
              rlang::as_function(value)(e1)
            else
              value)
  else e1
}

x <- 42
x == 100 <- ~stop("equals 100!")
x <- 100
x == 100 <- ~stop("equals 100!")
# Error in eval(expr, envir, enclos) : equals 100! 
x == 100 <- sqrt
x
# [1] 10

4.使用函数delay引用输入，并添加类delayed

我们可以创建一个函数delay，它将quote value表达式，并添加一个类"delayed"，我们的函数将在正确的时候将该调用识别给trigger：

`==<-` <- function (e1, e2, value) {
  cond <- e1 == e2
  if(any(cond)) 
    replace(e1, e1 == e2, 
            if (inherits(x,"delayed")) eval.parent(x) else x)
  else e1
}

delay <- function(x) {
  x <- substitute(x)
  class(x) <- "delayed"
  x
}

x <- 42
x == 100 <- delay(stop("equals 100!"))
x <- 100
x == 100 <- delay(stop("equals 100!"))
# Error in eval(expr, envir, enclos) : equals 100! 

好的地方是它可以处理任何可能触发错误的代码，坏的是delay是一个奇怪的函数，只有在特定的上下文中才有意义。

我们可以通过定义引用包帮助的适当打印方法来减轻尴尬：

print.delayed <- function(x,...){
  message(
    "Delayed call, useful as a `value` argument of `mmassign` assignment functions.\n",
    "See ?mmassign::delay.")
  print(unclass(x),...)
  x
}

delay(stop("equals 100!"))
# delayed call, useful as a `value` argument of `mmassign` assignment functions.
# See ?mmassign::delay.
# stop("equals 100!")

我们可以用同样的原则设计一个STOP函数，它将表现为“延迟”。

STOP <- function(...) `class<-`(substitute(stop(...)), "delayed")
x <- 42
x == 100 <- STOP("equals 100!")
x <- 100
x == 100 <- STOP("equals 100!")
# Error in eval(expr, envir, enclos) : equals 100! 

STOP("equals 100!")
# delayed call, useful as a `value` argument of `mmassign` assignment functions.
# See ?mmassign::delay.
# stop("equals 100!")

5.覆盖<-以识别==<-，并始终识别lhs

如果我们覆盖<-，我们可以让它工作，但这当然是不好的做法，所以只是为了好玩。如果LHS的第一个元素是==，那么引用值并添加类"delayed"并按上面的方式进行。

`<-` <- function(e1,e2) {
  .Primitive("<-")(lhs, match.call()[[2]])
  if(length(lhs) > 1 && identical(lhs[[1]],quote(`==`))) {
    invisible(eval.parent(substitute(
      .Primitive("<-")(e1,e2),
      list(e1=substitute(e1), 
           e2= substitute(`class<-`(quote(e2),"delayed"))
      ))))
  } else {
    invisible(eval.parent(substitute(.Primitive("<-")(e1,e2))))
  }
}

x <- 4
x == 100 <-stop("equals 100!")
x <- 100
x == 100 <-stop("equals 100!")
# Error in eval(expr, envir, enclos) : equals 100!