如何解决“有趣”的事实

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. 覆盖<-识别==<-并始终delay lhs

最后一种方法是唯一一种在不改变界面的情况下工作的方法，尽管它的工作原理是覆盖<-，这通常是不可取的。

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.覆盖<-识别==<-并始终delay 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!