Use magrittr dot placeholder IN FUNCTION DEFINITION to pass object via pipe operator to argument in arbitrary position by default?

Question

I want to define a function in a way that the magrittr pipe operator passes the object to the second argument by default.

library(magrittr)

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

Pipe operator passes object to first argument of foo.

1 %>% foo(2)

Pipe passes object to second argument of foo when using the . placeholder.

1 %>% foo(2, .)

Is there a way to build a function so that it directly has the . placeholder in its definition, so that the pipe will use the second argument by default? In pseudo code this would be something along the lines of:

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

Answer 1

The problem is that foo doesn't "know" how the pipe was written it just knows how it is called once magrittr has added the dot (if relevant) so from the function itself we cannot differentiate implicit and explicit dots.

This issue aside we can just switch the 2 first arguments if the first one is a dot and return the evaluated modified call:

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

^{Created on 2019-10-09 by the reprex package (v0.3.0)}

It will need to be adjusted if a can take a default value and be left empty, and possibly other edge cases.

edit: I lied when I said foo doesn't know how the pipe was written, it's in the call stack and we can see it by calling sys.call() in the function, but I think the solution is convoluted enough as it is!

---

Another way would be to define a pipe that inserts in second position, it's a bit more flexible and possibly less surprising :

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

^{Created on 2019-10-09 by the reprex package (v0.3.0)}

---

Note: piping to second is a bit weird, I'd rather pipe to last (it would have the same result for your question's example), if you want to pipe to last you would do :

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

^{Created on 2019-10-09 by the reprex package (v0.3.0)}