⏲️

Rでの関数実行時間管理 関数の実行時間を計測してまとめるツールの作成方法

2023/09/18に公開

はじめに

大規模なプログラムの開発をすると、思わぬところでエラーが発生したり、想定しているより重い処理になったりすることがあります。

Rは他の言語に比べて速度が遅いと言われていおり(処理に関しては、ベクトル化することで改善に繋がります)、特にファイルの入出力では時間がかかる印象です。

今回、仕事で開発しているRのプログラムでプロセス内の関数処理で時間がかかる部分があったため、プロセス内の各関数の処理時間をまとめて管理するツールを作成しました。

ボトルネックになっている処理を把握するためにも活用する場面はあると思います。特に独自で副すの関数を作成し、それをまとめて実行するプログラムを書いている場合、各処理の実行時間を把握することは大切なことです。しかし、毎回 Sys.time() を書くのはスマートではありませんし、管理が面倒くさいです。
物臭な自分のために作成し、使いどころは限られていると思いますが他の方にも有用だと思いますのでここに掲載します。

プログラム構成

作成するに当たり、以下の点が考慮されるようにしました。

  • 関数単位で実行時間を計測する
  • 同じ関数が複数回登場する場合は処理時間を合計していく
  • 時間の計測は、関数呼び出しだけで都度変数に代入することはめんどくさいからしたくない
  • 最後に一覧として結果を表示したい

特に3つ目の条件はクロージャを使って実装する必要が有りますので、Rでは環境の操作が必要です。

プログラム全体

作成したプログラムは以下のとおりです。

関数名は適当です。ベンチマークではなく時間の計測なので、カウンター関数とするほうが間違いではないと思います。

set_benchimarktest <- function(x = character()) {
    stopifnot(!is.null(x))

    ## set time list
    tc <- list(process_name = x)

    ## create call function
    eval(bquote(
        call_benchimark <- function() {
            e <- .(environment())
            eval(quote(tc), envir = e)
        }), envir = parent.frame())

    ## create benchimark function
    function(f = NULL) {

        f <- substitute(f)

        tar <- if (f[[1]] == quote(`<-`)) {
                   f[[3]][[1]]
               } else if(f[[1]] == quote(`{`)) {
                   stop("More than one process is specified. Only one process is accepted.")
               } else {
                   f[[1]]
               }
        e <- parent.env(environment())
        d <- bquote(tc[[.(deparse(tar))]])
        diff <- eval(bquote(
            system.time(.(f))
        ), envir = parent.frame())
        if (is.null(eval(d, envir = e))) {
            eval(bquote(
                .(d) <- bquote(.(diff), where = environment())
            ), envir = e)
        } else {
            eval(bquote(
                .(d) <- .(d) + bquote(.(diff), where = environment())
            ), envir = e)
        }
    }
}

コードの解説

コードは次のような構成になっています。

set_benchimarktest()

この関数で、クロージャの定義、計測用関数、結果の呼び出し用関数を定義します。

クロージャの定義

tc <- list(process_name = x)

この部分で束縛変数を定義しています。

計測された値は、全てこの変数 tc に入力されていきます。

結果の呼び出し用関数の定義

eval(bquote(
    call_benchimark <- function() {
        e <- .(environment())
        eval(quote(tc), envir = e)
    }), envir = parent.frame())

call_benchimark() は、先定義した tc を呼び出して表示します。

関数の定義は、 set_benchimarktest() を実行した環境内に定義するため、 parent.frame() での実行を eval() で定義します。

また、 set_benchimarktest() 内の環境で定義された変数を呼び出すため、呼び出し時は定義したときの環境を呼び出すため eset_benchimarktest() の実行環境を事前に設定するため、 bquote() で環境定義のみを一部評価して実行しています。

実行n時間を計測・得録する関数の定義

function(f = NULL) {

    f <- substitute(f)

    tar <- if (f[[1]] == quote(`<-`)) {
               f[[3]][[1]]
           } else if(f[[1]] == quote(`{`)) {
               stop("More than one process is specified. Only one process is accepted.")
           } else {
               f[[1]]
           }
    e <- parent.env(environment())
    d <- bquote(tc[[.(deparse(tar))]])
    diff <- eval(bquote(
        system.time(.(f))
    ), envir = parent.frame())
    if (is.null(eval(d, envir = e))) {
        eval(bquote(
            .(d) <- bquote(.(diff), where = environment())
        ), envir = e)
    } else {
        eval(bquote(
            .(d) <- .(d) + bquote(.(diff), where = environment())
        ), envir = e)
    }
}

実際に関数をしたときに時間を計測するのはこの関数です。 set_benchimarktest() 実行時に作成されます。

引数 f に実行する処理を入力します。想定として、単に関数のみ実行する場合(e.g. sum(1:100))と、関数実行の結果を変数に代入する(e.g. a <- sum(1:100))を考えています。単に代入処理(e.g. a <- 1)は想定していません。

まずは f が関数のみ実行か代入かを判別するため、 f を表現式にして、1番めの式で判別しています。 <- の場合は代入、それ以外は関数実行です。

このとき、複数の処理(e.g. {a <- sum(1:100);b <- sum(1:1000)})が実行されるように指定された場合はエラー出力してストップがかかるようになっています。

ここまでの処理で、計測する関数名が tar 変数に入ります。

続いて、実行する環境( parent.frame() )で f を実行し、その結果が diff に入ります。 diff の結果は、束縛された tc に代入するため、この関数が定義されている実親環境( parent.env(environment()))で事項するようにそれぞれ環境を定義しています。

また、 tc に代入する場合は、すでに登録されている変数であるか処理を分岐しています。

テスト

それでは実際に実行してみます。

ben <- set_benchimarktest(x = "test case")
ben(f = mean(1:40000))
ben(f = sum(1:10^4))
ben(a <- seq(1, 10^10))
ben(b <- lapply(1:5000, function(x) {x ^ 3 + 2 * x ^ 2 + 12 * x}))
ben({a <- seq(1, 10^100); b <- mean(1:400)})
Error in ben({: More than one process is specified. Only one process is accepted.
message("results test case")
call_benchimark()
$process_name
[1] "test case"

$mean
   ユーザ   システム       経過  
         0          0          0 

$sum
   ユーザ   システム       経過  
         0          0          0 

$seq
   ユーザ   システム       経過  
     0.001      0.000      0.001 

$lapply
   ユーザ   システム       経過  
     0.004      0.000      0.004 
message("results a")
head(a)
[1] 1 2 3 4 5 6
message("results b")
head(b)
[[1]]
[1] 15

[[2]]
[1] 40

[[3]]
[1] 81

[[4]]
[1] 144

[[5]]
[1] 235

[[6]]
[1] 360

代入処理も問題なく出来ています。
役に立つかはおいておいても、環境と表現式の練習には使えると思います。

Discussion