Custom pipe to silence warnings

user_2270475 0
Viewed 1309

Related to this question.

I'd like to build a custom pipe %W>% that would silence warnings for one operation

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

will be equivalent to :

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

These two tries don't work :

`%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)
}

How can I rlang this into something that works ?

magrittr rlang dplyr r
4 Answers

I'm not sure this solution works perfectly, but it's a start:

`%W>%` <- function(lhs, rhs) {
  call <- substitute(`%>%`(lhs, rhs))
  eval(withr::with_options(c("warn" = -1), eval(call)), parent.frame())
}

This seems to work for the following 2 examples:

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

Perhaps something like this with rlang:

library(rlang)
library(magrittr)

`%W>%` <- function(lhs, rhs){
  w <- options()$warn
  on.exit(options(warn=w))
  options(warn=-1)
  lhs_quo = quo_name(enquo(lhs))
  rhs_quo = quo_name(enquo(rhs))
  pipe = paste(lhs_quo, "%>%", rhs_quo)
  return(eval_tidy(parse_quosure(pipe)))
}

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

Result:

          a
1 0.5403023
2       NaN

Note:

  • You need enquo instead of quo because you are quoting the code that was supplied to lhs and rhs, not the literals lhs and rhs.

  • I couldn't figure out how to feed lhs_quo/lhs into rhs_quo (which was a quosure) before it was evaluated, neither can I evaluate rhs_quo first (throws an error saying a not found in mutate(a=sqrt(a)))

  • The workaround that I came up with turns lhs and rhs into strings, pastes them with "%>%", parses the string to quosure, then finally tidy evaluates the quosure.

user_51506290

Coming back a little more experienced, I just missed an eval.parent and substitute combo, no need for rlang :

`%W>%` <- function(lhs,rhs){
  # `options()` changes options but returns value BEFORE change
  opts <- options(warn = -1) 
  on.exit(options(warn=opts$warn))
  eval.parent(substitute(lhs %>% rhs))
}

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