Как обойти тот факт, что `fun <-` начинается с оценки` value`? - PullRequest
Новая
       9

Как обойти тот факт, что `fun <-` начинается с оценки` value`?

0 голосов
/ 07 февраля 2019

Рассмотрим следующую функцию: она заменяет значения lhs на значение, если условие TRUE

`==<-` <- 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!

Есть ли способ обойти это?

См. Ниже некоторые обходные пути, которые я нашел вокруг этого, но яхотел бы узнать, есть ли еще.

РЕДАКТИРОВАТЬ:

это адрес комментарий сотос: 

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

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

1 Ответ

0 голосов
/ 07 февраля 2019

Вот несколько способов обойти это:

  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!
...