Question

我想构建一个自定义管道%W>%，它会使一个操作的警告静音

library(magrittr)
data.frame(a= c(1,-1)) %W>% mutate(a=sqrt(a)) %>% cos

将等同于：

w <- options()$warn
data.frame(a= c(1,-1)) %T>% {options(warn=-1)} %>%
  mutate(a=sqrt(a))    %T>% {options(warn=w)}  %>%
  cos

这两个尝试不起作用：

`%W>%` <- function(lhs,rhs){
  w <- options()$warn
  on.exit(options(warn=w))
  options(warn=-1)
  lhs %>% rhs
}

`%W>%` <- function(lhs,rhs){
  lhs <- quo(lhs)
  rhs <- quo(rhs)
  w <- options()$warn
  on.exit(options(warn=w))
  options(warn=-1)
  (!!lhs) %>% (!!rhs)
}

我怎样才能将rlang变成有效的东西？

Answer 1

我想我会这样做，通过调整magrittr管道来包含这个新选项。这种方式应该非常强大。

首先，我们需要在magrittr函数%W>%中插入一个新选项，通过该函数确定某个函数是否为管道。我们需要它来识别new_is_pipe = function (pipe) { identical(pipe, quote(`%>%`)) || identical(pipe, quote(`%T>%`)) || identical(pipe, quote(`%W>%`)) || identical(pipe, quote(`%<>%`)) || identical(pipe, quote(`%$%`)) } assignInNamespace("is_pipe", new_is_pipe, ns="magrittr", pos="package:magrittr") `%W>%` = magrittr::`%>%`

%W>%

我们还需要一个新的辅助函数来检查正在处理的管道是否为is_W = function(pipe) identical(pipe, quote(`%W>%`)) environment(is_W) = asNamespace('magrittr')

magrittr:::wrap_function

最后，我们需要将一个新分支放入%W>%，检查这是否是options(warn = -1)管道。如果是这样，它会将on.exit(options(warn = w)和new_wrap_function = function (body, pipe, env) { w <- options()$warn if (magrittr:::is_tee(pipe)) { body <- call("{", body, quote(.)) } else if (magrittr:::is_dollar(pipe)) { body <- substitute(with(., b), list(b = body)) } else if (is_W(pipe)) { body <- as.call(c(as.name("{"), expression(options(warn=-1)), parse(text=paste0('on.exit(options(warn=', w, '))')), body)) } eval(call("function", as.pairlist(alist(. = )), body), env, env) } assignInNamespace("wrap_function", new_wrap_function, ns="magrittr", pos="package:magrittr")插入到函数调用的主体中。

data.frame(a= c(1,-1)) %W>% mutate(a=sqrt(a)) %>% cos
#           a
# 1 0.5403023
# 2       NaN

测试工作原理：

data.frame(a= c(1,-1)) %>% mutate(a=sqrt(a)) %>% cos
#           a
# 1 0.5403023
# 2       NaN
# Warning message:
# In sqrt(a) : NaNs produced

与...相比。

"webkit.webprefs.javascript_enabled": false
"profile.content_settings.exceptions.javascript.*.setting": 2
"profile.default_content_setting_values.javascript": 2
"profile.managed_default_content_settings.javascript": 2

Answer 2

再来一点经验，我只是错过了eval.parent和substitute组合，不需要 rlang ：

`%W>%` <- function(lhs,rhs){
  w <- options()$warn
  on.exit(options(warn=w))
  options(warn=-1)
  eval.parent(substitute(lhs %>% rhs))
}

data.frame(a= c(1,-1)) %W>% mutate(a=sqrt(a)) %>% cos
#           a
# 1 0.5403023
# 2       NaN

定制管道以消除警告

2 个答案: