初めての
Rメタプログラミング

Sendai.R #1

@igjit

@igjit

いくつかのプログラミング言語を使ってきたけど

Rはすごく不思議な言語

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

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

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

いくつかのプログラミング言語を使ってきたけど

Rはすごく強力な言語

Tokyo.R#76 BeginneRSession-data pipeline by @kilometer00

Tokyo.R#76 BeginneRSession-data pipeline by @kilometer00

すごい。

何がすごいか

渡したコードの意味が変わっている

  • 引数が先頭に追加される
  • プレースホルダー (.)

例えばJava​Script

https://developer.mozilla.org/ja/docs/Web/JavaScript/Reference/Operators/Pipeline_operator

Java​Scriptでパイプ演算子を使うには

言語の進化を待たなければならない

Rだと

%>%はmagrittr packageで定義された単なる演算子

library(magrittr)

1:10 %>% sum

自分で作ることもできる

https://igjit.github.io/slides/2018/01/tiny_pipe/#/

宇宙のできる前のR(1.0.0)に異世界転生しても
パイプ演算子を実装できる

宇宙が生まれる前の話 by @0_u0

このセッションの目標

R言語について知る

  • 演算子
  • 遅延評価
  • NSE

そしてメタプログラミングを使って

パイプ演算子を実装できるようになる

※以降の内容は基本的にパイプ演算子自作入門を加筆修正したものになります。

1. 演算子

中置演算子

1 + 2

関数呼び出し

sum(1, 2)

実は

R内で起きることすべては関数呼び出しである。

これは

1 + 2

これと等価

`+`(1, 2)

これは

1:10

これと等価

`:`(1, 10)

なのでこれは

a %>% b

これと等価

`%>%`(a, b)

演算子を定義する

`%add%` <- function(a, b) {
  a + b
}
1 %add% 2
# [1] 3

ここまでの知識で

パイプ演算子を実装してみよう

これは

a %>% b

こういうことなので

b(a)

こう実装できる

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

動いた

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

chainもできる

1:10 %pipe% log %pipe% plot

でも右辺が関数呼び出しだとだめ

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

もう少し知識が必要

2. 遅延評価

Rの関数では

引数は遅延評価される

つまり

引数が使われた場合に初めて評価される

f <- function(a, b) {
  if (a > 0) b
}
f(1, stop("This is an error!"))
# f(1, stop("This is an error!")) でエラー (#1 から) : This is an error!

f(0, stop("This is an error!"))  # 何も起きない

3. 非標準評価

curve(log(x))

Rの関数は、引数の値だけでなく

引数を計算するコードを参照できる

この引数を計算するコードを利用する評価方法が

非標準評価

NSE (Non-standard evaluation)

substitute() で表現式を捕捉できる

f <- function(x) {
  substitute(x)
}
f(1 + 2)
# 1 + 2

quote() でも表現式を捕捉できる

quote(1 + 2)
# 1 + 2

ただし関数内での挙動が違う

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

f(1 + 2)
# 1 + 2
f <- function(x) {
  quote(x)
}

f(1 + 2)
# x

eval() で表現式を評価できる

quote(1 + 2)
# 1 + 2

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

eval() の第2引数で環境を指定できる

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

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

4. メタプログラミング

quote() は表現式を返す

quote(1 + 2)
# 1 + 2

表現式は

木構造

abstract syntax tree (AST) とも呼ばれる

pryr::ast() で木構造を見ることができる

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

表現式はlistのように扱える

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

構文木を読み書きする

メタプログラミング

もういちどパイプ演算子を実装してみよう

x %>% f(y) が f(x, y) と等価

f の引数の先頭に x を追加すれば良い

バージョン2

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

バージョン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)

magrittrのソースコード読むと楽しいよ。

https://github.com/tidyverse/magrittr

参考文献

  • 私が今まで読んだ中で最高のRの本
  • 本当に徹底解説
  • 興味深い話題
    • 環境オブジェクト
    • 関数型プログラミング
    • DSL
    • コードの最適化

追加情報

原著 (Advanced R) の2nd editionでは

rlangを使ったよりモダンなメタプログラミングを説明している。

まとめ

構文木を読み書きできる

メタプログラミング

偉大なる力

使用例

Rはすごく不思議な言語

Rはすごく強力な言語

Rはすごく楽しい言語

Enjoy!

// reveal.js plugins