r - 如何解决 `fun<-` 从评估 `value` 开始的事实？

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!