パイプ演算子
自作入門

x
# エラー:  オブジェクト 'x' がありません

log(x)
# エラー:  オブジェクト 'x' がありません

curve(log(x))  # これはok

ggplot2
# エラー:  オブジェクト 'ggplot2' がありません

library(ggplot2)  # これはok

1 + 2

sum(1, 2)

1 + 2

1:10

a %>% b

`%add%` <- function(a, b) {
    a + b
}

a %>% b

`%pipe%` <- function(a, b) {
    b(a)
}

1:10 %pipe% sum
# [1] 55

1:10 %pipe% sum()  # エラー

f <- function(a, b) {
    if (a > 0) b
}

curve(log(x))

f <- function(x) {
    substitute(x)
}

f(1 + 2)
# 1 + 2

quote(1 + 2)
# 1 + 2

f <- function(x) {
    substitute(x)
}

f(1 + 2)
# 1 + 2

f <- function(x) {
    quote(x)
}

f(1 + 2)
# x

quote(1 + 2)
# 1 + 2

eval(quote(1 + 2))
# [1] 3

e <- new.env()
e$x <- 40

eval(quote(x + 2), e)
# [1] 42

quote(1 + 2)
# 1 + 2

ast(1 + 2 * 3)
# \- ()
#   \- `+
#   \-  1
#   \- ()
#     \- `*
#     \-  2
#     \-  3 

expr <- quote(1 + 2)

as.list(expr)
# [[1]]
# `+`
# 
# [[2]]
# [1] 1
# 
# [[3]]
# [1] 2

expr[[1]]
# `+`

expr <- quote(1 + 2)
expr[[1]] <-  quote(`*`)

expr
# 1 * 2

f <- function(x) {
    expr <- substitute(x)
    expr[[1]] <- quote(`*`)  # 関数名を差し替える
    eval(expr)
}

3 + 4
# [1] 7

f(3 + 4)
# [1] 12

f(3 > 4)
# [1] 12

`%pipe2%` <- function(lhs, rhs) {
    env <- parent.frame()  # 関数の呼び出し環境
    expr <- substitute(rhs)
    eval(as.call(c(expr[[1]],
                   substitute(lhs),
                   as.list(expr[-1]))),
         env)
}

1:10 %pipe2% head(n = 3)
# [1] 1 2 3

1:10 %pipe2% head(.)  # エラー

has_dot <- function(expr) {
    any(vapply(expr, identical, logical(1), quote(.)))
}

has_dot(quote(1 + 2))
# [1] FALSE

has_dot(quote(1 + .))
# [1] TRUE

insert_dot <- function(expr) {
    as.call(c(expr[[1]], quote(.), as.list(expr[-1])))
}

insert_dot(quote(head(n = 3)))
# head(., n = 3)

`%pipe3%` <- function(lhs, rhs) {
    env <- parent.frame()
    expr <- substitute(rhs)
    dotted <- if (has_dot(expr)) expr else insert_dot(expr)
    eval(dotted, list(. = lhs), env)
}

1:10 %pipe3% head(.)
# [1] 1 2 3 4 5 6

1:10 %pipe3% head(n = 3)
# [1] 1 2 3

library(magrittr)