COLOR(blue){SIZE(20){L. Tierney 氏の R バイトコンパイラー}}~

「なんでも掲示板」記事より転載

以前から噂になっている R のバイトコンパイラーですが、すでに公開されているようですね。おそらくまだ機能は限定的だと思いますが、どんな感じでしょうか。新しもの好きな人は試してみられたら。物によりますが、1.5 倍から 2 倍の早さになるようです。

ソース URL は [[ここだよ:http://www.stat.uiowa.edu/~luke/R/compiler/]]~

 いつものいつもの使い方：
 
 (1) パッケージ compiler_0.1-3.tar.gz を通常のようにインストール。
 (2) R から library(compiler) でロード。詳細説明は ?compile で得られる。
 (3) 適当な関数 foo をバイトコンパイル foo.c <- cmpfun(foo) で
     foo のバイトコンパイル版 foo.c (名前は任意) ができる。
 (4) foo.c の実際の定義は disassemble(foo.c) で得られる。
 (5) 関数定義ファイル infile をバイトコンパイルしたものを outfile に
     かきだす： cmpfile(infile, outfile)
 (6) バイトコンパイル済みファイル file を読み込むには
     loadcmp(file) 

ソースコードに附属の例を実行してみました。それなりに早くなっているようですね。試してみる価値はあるかも。

 > source("cmp.R")
 > # old R version of lapply
 > la1 <- function(X, FUN, ...) {
 +     FUN <- match.fun(FUN)
 +     if (!is.list(X))
 +         X <- as.list(X)
 +     rval <- vector("list", length(X))
 +     for(i in seq(along = X))
 +         rval[i] <- list(FUN(X[[i]], ...))
 +     names(rval) <- names(X)               # keep `names' !
 +     return(rval)
 + }
 > # a small variation
 > la2 <- function(X, FUN, ...) {
 +     FUN <- match.fun(FUN)
 +     if (!is.list(X))
 +         X <- as.list(X)
 +     rval <- vector("list", length(X))
 +     for(i in seq(along = X)) {
 +         v <- FUN(X[[i]], ...)
 +         if (is.null(v)) rval[i] <- list(v)
 +         else rval[[i]] <- v
 +     }
 +     names(rval) <- names(X)               # keep `names' !
 +     return(rval)
 + }
 > # Compiled versions
 > la1c <- cmpfun(la1)                       # la1 をバイトコンパイル
 Note: local functions used: FUN 
 > la2c <- cmpfun(la2)                       # la2 をバイトコンパイル
 Note: local functions used: FUN 
 > # some timings
 > x<-1:10
 > y<-1:100
 > system.time(for (i in 1:10000) lapply(x, is.null))
 [1] 7.13 0.00 7.12 0.00 0.00
 > system.time(for (i in 1:10000) la1(x, is.null))
 [1] 13.68  0.01 13.68  0.00  0.00
 > system.time(for (i in 1:10000) la1c(x, is.null))  # 1.556314 倍
 [1] 8.79 0.00 8.79 0.00 0.00
 > system.time(for (i in 1:10000) la2(x, is.null))
 [1] 13.89  0.00 13.89  0.00  0.00
 > system.time(for (i in 1:10000) la2c(x, is.null))  # 1.587429 倍
 [1] 8.75 0.00 8.75 0.00 0.00
 > system.time(for (i in 1:1000) lapply(y, is.null))
 [1] 0.93 0.00 0.93 0.00 0.00
 > system.time(for (i in 1:1000) la1(y, is.null))
 [1] 5.57 0.00 5.58 0.00 0.00
 > system.time(for (i in 1:1000) la1c(y, is.null))   # 4.565574 倍 （y が大きいと効果が大）
 [1] 1.22 0.00 1.23 0.00 0.00
 > system.time(for (i in 1:1000) la2(y, is.null))
 [1] 5.72 0.00 5.71 0.00 0.00
 > system.time(for (i in 1:1000) la2c(y, is.null))   # 4.727273 倍  （y が大きいと効果が大）
 [1] 1.21 0.00 1.21 0.00 0.00

ちなみにコンパイル済みのコードは次のようになります。実体は（当然かも知れませんが）隠されているようです。

 >  la1c
 function (X, FUN, ...) 
 {
     FUN <- match.fun(FUN)
     if (!is.list(X)) 
         X <- as.list(X)
     rval <- vector("list", length(X))
     for (i in seq(along = X)) rval[i] <- list(FUN(X[[i]], ...))
     names(rval) <- names(X)
     return(rval)
 }
 <bytecode: 0x8b84878>

「データサイエンス入門」中の qiuck 関数で検査。必ずしもいつも早くなるとは限らないようだ。

 > qiuckc <- cmpfun(quick)
 > set.seed(1123); system.time(x <- quick(runif(10000)))
 [1] 3.92 0.00 3.92 0.00 0.00
 > set.seed(1123); system.time(x <- quickc(runif(10000)))
 [1] 3.91 0.00 3.92 0.00 0.00                               # ほぼ同じ
 
 > set.seed(1123); system.time(x <- quick(runif(100000)))
 [1] 180.98  43.33 229.42   0.00   0.00
 > set.seed(1123); system.time(x <- quickc(runif(100000)))
 [1] 163.52  29.56 193.31   0.00   0.00                     # 1.11倍

disassemble(la1c)で覗けば, パース(構文解析)後のデータになっているのがわかるかと思います.fun1から何度もfun2を呼ぶ場合はfun2をバイトコンパイルすればfun2の構文解析時間が稼げます.半面,　function()1:10^9 みたいなのは展開されてしまいますから、超巨大オブジェクトになってしまいます. 使いかたとしては八方美人の小股の切れ上がった演算ルーチン等をバイトコンパイルして使うのが嬉しいのではないかと思います. -- なかま 

なるほど、かなり意味不明のコードに変わっていますね。構文解析の手間を省くわけですか。 -- 間瀬

 > disassemble(la1c)
 list(.Code, list(4, GETSYMFUN.OP, 1, MAKEPROM.OP, 2, CALL.OP, 
    3, SETVAR.OP, 4, POP.OP, GETBUILTIN.OP, 5, GETVAR.OP, 6, 
    PUSHARG.OP, CALLBUILTIN.OP, 7, NOT.OP, BRIFNOT.OP, 30, GETSYMFUN.OP, 
    8, MAKEPROM.OP, 9, CALL.OP, 10, SETVAR.OP, 6, GOTO.OP, 31, 
    LDNULL.OP, POP.OP, GETINTLBUILTIN.OP, 11, PUSHCONSTARG.OP, 
    12, GETBUILTIN.OP, 13, GETVAR.OP, 6, PUSHARG.OP, CALLBUILTIN.OP, 
    14, PUSHARG.OP, CALLBUILTIN.OP, 15, SETVAR.OP, 16, POP.OP, 
    GETSYMFUN.OP, 17, MAKEPROM.OP, 18, SETTAG.OP, 19, CALL.OP, 
    20, STARTFOR.OP, 21, 93, GETBUILTIN.OP, 22, GETFUN.OP, 4, 
    MAKEPROM.OP, 23, DODOTS.OP, CALL.OP, 24, PUSHARG.OP, CALLBUILTIN.OP, 
    25, STARTASSIGN.OP, 16, 26, GETVAR.OP, 16, STARTSUBASSIGN.OP, 
    27, 89, GETVAR.OP, 21, PUSHARG.OP, GETVAR.OP, 26, PUSHARG.OP, 
    SETTAG.OP, 28, DFLTSUBASSIGN.OP, ENDASSIGN.OP, 16, 26, SETLOOPVAL.OP, 
    STEPFOR.OP, 60, ENDFOR.OP, POP.OP, GETSYMFUN.OP, 29, MAKEPROM.OP, 
    30, CALL.OP, 31, STARTASSIGN.OP, 16, 26, GETSYMFUN.OP, 32, 
    MAKEPROM.OP, 33, MAKEPROM.OP, 34, SETTAG.OP, 28, CALL.OP, 
    35, ENDASSIGN.OP, 16, 26, POP.OP, CALLSPECIAL.OP, 36, RETURN.OP), 
    list({
        FUN <- match.fun(FUN)
        if (!is.list(X)) 
            X <- as.list(X)
        rval <- vector("list", length(X))
        for (i in seq(along = X)) rval[i] <- list(FUN(X[[i]], 
            ...))
        names(rval) <- names(X)
        return(rval)
    }, match.fun, list(.Code, list(4, GETVAR.OP, 0, RETURN.OP), 
        list(FUN)), match.fun(FUN), FUN, is.list, X, is.list(X), 
        as.list, list(.Code, list(4, GETVAR.OP, 0, RETURN.OP), 
            list(X)), as.list(X), vector, "list", length, length(X), 
        vector("list", length(X)), rval, seq, list(.Code, list(
            4, GETVAR.OP, 0, RETURN.OP), list(X)), along, seq(along = X), 
        i, list, list(.Code, list(4, GETVAR.OP, 1, STARTSUBSET2.OP, 
            2, 10, GETVAR.OP, 3, PUSHARG.OP, DFLTSUBSET2.OP, 
            RETURN.OP), list(X[[i]], X, X[[i]], i)), FUN(X[[i]], 
            ...), list(FUN(X[[i]], ...)), `*ctmp*`, "[<-"(rval, 
            i, value = `*ctmp*`), value, names, list(.Code, list(
            4, GETVAR.OP, 0, RETURN.OP), list(X)), names(X), 
        `names<-`, list(.Code, list(4, GETVAR.OP, 0, RETURN.OP), 
            list(rval)), list(.Code, list(4, GETVAR.OP, 0, RETURN.OP), 
            list(`*ctmp*`)), "names<-"(rval, value = `*ctmp*`), 
        return(rval)))

R最適化Tips 中のトランプシミュレーションプログラム test4 中の使用関数をすべてバイトコンパイルして試してみると、ほぼ二倍の速度向上。R のシステム関数をすべてバイトコンパイルしたバージョンを作れば、幸せになれる？もちろん eigen 等の C, Fortran ライブラリを単に呼び出すだけの関数の単独使用ではほとんど速度は変わりません。 -- 間瀬

 >  test44 <- function (repl) {
                x <- matrixc(0, nrow = 10, ncol=repl) 
                a <- repc(0:3,13)
                for (i in 1:repl) x[,i] <- samplec(a, 10)
                y <- matrixc(x, nrow=5)
                z <- y - matrixc(y[1,], nrow=5, ncol=2*repl, byrow=TRUE)
                w <- matrix(colSumsc(abs(z)), nrow=2)
                pass <- sumc(w[1,]*w[2,]==0)
                pass/repl
             }
 > test44c <- cmpfun(test44)                   # 本体もバイトコンパイル 
 > set.seed(1111); system.time(test4(10000))   # オリジナルバージョン
 [1] 1.11 0.01 1.11 0.00 0.00
 > set.seed(1111); system.time(test44c(10000))  # バイトコンパイルバージョン
 [1] 0.58 0.01 0.59 0.00 0.00
 > set.seed(1111); system.time(test4(100000))   # オリジナルバージョン
 [1] 10.66  0.08 10.74  0.00  0.00
 > set.seed(1111); system.time(test44c(100000)) # バイトコンパイルバージョン
 [1] 5.71 0.07 5.79 0.00 0.00

しつっこく実験。不思議なことに気づきました。中で使うシステム関数を前もってバイトコンパイルすると当然早くなるかと思ったらそうでもない。システム関数はすでに十分高速化されているようです。 -- 間瀬

 > gc(); set.seed(1111); system.time(test4(10000))  # オリジナル
 [1] 1.07 0.02 1.09 0.00 0.00
 > gc(); set.seed(1111); system.time(test4c(10000)) # それをバイトコンパイル
 [1] 0.61 0.01 0.62 0.00 0.00
 > gc(); set.seed(1111); system.time(test44(10000)) #  中で使う関数全部をバイトコンパイル
 [1] 1.02 0.00 1.02 0.00 0.00
 > gc(); set.seed(1111); system.time(test44c(10000)) # それを更にバイトコンパイル
 [1] 0.57 0.00 0.57 0.00 0.00
- 1.3.0 のパッケージに含まれていますね。３倍速になるようですが。 --  &new{2011-04-21 (木) 17:50:55};
- 2.13.0 のパッケージに含まれていますね。３倍速になるようですが。 --  &new{2011-04-21 (木) 17:50:55};

#comment
トップ   編集 差分 バックアップ 添付 複製 名前変更 リロード   新規 一覧 検索 最終更新   ヘルプ   最終更新のRSS