Использовать заполнитель точки magrittr В ОПРЕДЕЛЕНИИ ФУНКЦИЙ, чтобы передать объект через оператор канала в аргумент в произвольной позиции по умолчанию? - PullRequest
Новая
       29

Использовать заполнитель точки magrittr В ОПРЕДЕЛЕНИИ ФУНКЦИЙ, чтобы передать объект через оператор канала в аргумент в произвольной позиции по умолчанию?

0 голосов
/ 05 октября 2019

Я хочу определить функцию так, чтобы оператор канала magrittr по умолчанию передавал объект второму аргументу. 

library(magrittr)

foo <- function(a, b) c(a,b)

Оператор трубы передает объект первому аргументу foo. 

1 %>% foo(2)

Канал передает объект второму аргументу foo при использовании заполнителя .. 

1 %>% foo(2, .)

Есть ли способ построить функцию так, чтобы она непосредственно содержала заполнитель . в своем определении, чтобы канал по умолчанию использовал второй аргумент? В псевдокоде это будетбыть чем-то вроде: 

foo2 <- function(a, b = <pipe arg placeholder>) {
    b = <process arg placeholder> 
    c(a, b)
}

Ответы [ 2 ]

1 голос
/ 09 октября 2019

Проблема в том, что foo не "знает", как был написан канал, он просто знает, как он вызывается, когда magrittr добавил точку (если уместно), поэтому из самой функции мыне может различить неявные и явные точки.

В этом случае мы можем просто переключить 2 первых аргумента, если первый является точкой, и вернуть оцененный модифицированный вызов: 

library(magrittr)
foo <- function(a, b) {
  mc <- match.call()
  if(mc[[2]] == quote(.)) {
    mc[[2]] <- mc[[3]]
    mc[[3]] <- quote(.)
    return(eval.parent(mc))
  }
  c(a,b)
  }
1 %>% foo(2)
#> [1] 2 1
1 %>% foo(2, .)
#> [1] 2 1
# but also, because of disclaimer above
1 %>% foo(., 2)
#> [1] 2 1

Создано в 2019-10-09 пакетом представ. (v0.3.0)

Это необходимо настроить, если a может принимать значение по умолчанию и оставаться пустыми, возможно, другие крайние случаи.

edit: я солгал, когда сказал, что foo не знает, как был написан канал, он находится в стеке вызовов, и мы можем увидеть его, вызвав sys.call() вфункция, но я думаю, что решение достаточно запутанно, как оно есть!

Другим способом было бы определить трубу, которая вставляется во вторую позицию, это немного более гибко и, возможно, менее удивительно: 

foo <- function(a=2, b) {
  c(a,b)
}

`%>2%` <-
  function (lhs, rhs) {
    rhs_call <- insert_dot2(substitute(rhs))
    eval(rhs_call, envir = list(. = lhs), enclos = parent.frame())
  }

insert_dot2 <-
  function(expr, special_cases = TRUE) {
    if(is.symbol(expr) || expr[[1]] == quote(`(`)) {
      # if a symbol or an expression inside parentheses, make it a call with 
      # a missing first argument and a dot on second position
      expr <- as.call(c(expr,alist(x=)[[1]], quote(`.`)))
    } else if(length(expr) ==1) {
      # if a call without arg, same thing
      expr <- as.call(c(expr[[1]],alist(x=)[[1]], quote(`.`)))
    } else if (expr[[1]] != quote(`{`) &&
               all(sapply(expr[-1], `!=`, quote(`.`)))) {
      # if a call with args but no dot in arg, insert dot in second place first
      expr <- as.call(c(as.list(expr[1:2]), quote(`.`), as.list(expr[-(1:2)])))
    }
    expr
  }
1 %>2% foo(2)
#> [1] 2 1
1 %>2% foo(2, .)
#> [1] 2 1
1 %>2% foo(., 2)
#> [1] 1 2
1 %>2% foo()
#> [1] 2 1

Создано в 2019-10-09 в пакете Представить (v0.3.0)

Примечание: конвейерная передача во вторую немного странная, я бы предпочел трубу в последнюю (это будет иметьтот же результат для примера вашего вопроса), если вы хотите передать до конца, вы должны сделать: 

foo <- function(a=2, b) {
  c(a,b)
}

`%>last%` <-
  function (lhs, rhs) {
    rhs_call <- insert_dot_last(substitute(rhs))
    eval(rhs_call, envir = list(. = lhs), enclos = parent.frame())
  }

insert_dot_last <-
  function(expr, special_cases = TRUE) {
    if(is.symbol(expr) || expr[[1]] == quote(`(`)) {
      # if a symbol or an expression inside parentheses, make it a call with 
      # a dot arg
      expr <- as.call(c(expr, quote(`.`)))
    } else if(length(expr) ==1) {
      # if a call without arg, same thing
      expr <- as.call(c(expr[[1]], quote(`.`)))
    } else if (expr[[1]] != quote(`{`) &&
               all(sapply(expr[-1], `!=`, quote(`.`)))) {
      # if a call with args but no dot in arg, insert dot in last place
      expr <- as.call(c(as.list(expr), quote(`.`)))
    }
    expr
  }
1 %>last% foo(2)
#> [1] 2 1
1 %>last% foo(2, .)
#> [1] 2 1
1 %>last% foo(., 2)
#> [1] 1 2

Создано в 2019-10-09 с помощью пакета представить (v0.3.0)

1 голос
/ 05 октября 2019

В этом примере вход в канал используется как второй аргумент f. Мы должны использовать {...}, но, возможно, это достаточно близко. 

f <- function(x, y = parent.frame()$.) x - y
12 %>% { f(20) }
## [1] 8
...