Summary

いわゆるifブロックを多段階に設けて場合分け処理を実行したいことがある。R言語では、それを実現するための構文が複数通り考えられ、それぞれに長所短所がある。コードの保守性の向上と、解析作業の所要時間短縮を図り、うまく使い分けよう。

Introduction

『Rで論文っぽい図を描く③　ggplot2で作った複数の図を論文風にまとめるにはggpubrがアツい（おまけ：凡例のみ得て任意の場所にプロット）』という記事を拝見した。実践的で参考になる記事である。私の知らなかった関数の使い方が紹介されていて、いずれ使わせていただこうと思っている。

ただ、そのサンプルコードを見ていて気になったことがあった。

sig <- function(a) {
    if (a > 0.1) {
      return("")
    } else {
      if ((a <= 0.1)&&(a > 0.05)) {
        return(".")
      } else {
        if ((a <= 0.05)&&(a > 0.01)) {
          return("*")
        } else {
          if ((a <= 0.01)&&(a > 0.001)) {
          return("**")
          } else return("***")
        }
      }
    }
}

もう少し簡単に書けるんじゃね?

実際のところ思ったとおりであり、改良できたのだが、検討の過程でちょっと思いがけない発見があった。その経緯を記事にまとめておきたいと思う。

そのような次第で、元記事のsigなる関数に含まれている「多重ifブロック」をもう少しいい感じに書き換えたい。つまり、可読性・保守性・そして実行速度をそれぞれ改善したいというのが今回のゴールである。

Materials and Methods

試行錯誤の旅

サンプルコード１：ロジックの改良

その前に、オリジナルには冗長な条件判定があるので、まずそこを修正した。

sig1 <- function(a) {                                                                                                                                                                                        
    if (a > 0.1) {                                                                                                                                                                                           
      return("")                                                                                                                                                                                             
    } else {                                                                                                                                                                                                 
      if (a > 0.05) {                                                                                                                                                                                        
        return(".")                                                                                                                                                                                          
      } else {                                                                                                                                                                                               
        if (a > 0.01) {                                                                                                                                                                                      
          return("*")                                                                                                                                                                                        
        } else {                                                                                                                                                                                             
          if (a > 0.001) {                                                                                                                                                                                   
          return("**")                                                                                                                                                                                       
          } else return("***")                                                                                                                                                                               
        }                                                                                                                                                                                                    
      }                                                                                                                                                                                                      
    }                                                                                                                                                                                                        
}

サンプルコード２：ifelse関数

まず思いついたのが、if-elseブロックをifelse関数に置き換えることである。

sig2 <- function(a){
  return(
    ifelse( a > 0.1,   "",
    ifelse( a > 0.05,  ".",
    ifelse( a > 0.01,  "*",
    ifelse( a > 0.001, "**", "***"))))
  )
}

少なくとも、見た目は断然すっきりしていると言えるのではないだろうか。

サンプルコード３：ifにこんな書き方が！

全く知らなかったのだ! こんなコーディングが可能だったなんて。

sig3 <- function(a){
  return(
    `if`( a > 0.1,   "",
    `if`( a > 0.05,  ".",
    `if`( a > 0.01,  "*",
    `if`( a > 0.001, "**", "***"))))
  )
}

プロファイリングしてみる

プロファイリングとは、プログラムを実行した時にそれぞれの関数がどれぐらい時間を消費したかをチェックし、プログラムの品質改良に役立てようとするアプローチである。R言語にはそのための関数RprofとRprofSummaryが用意されている。前者が所要時間のデータを取り、後者がそれを表形式にまとめてくれる。

テストコード

# オリジナルのコード
sig <- function(a) {
    if (a > 0.1) {
      return("")
    } else {
      if ((a <= 0.1)&&(a > 0.05)) {
        return(".")
      } else {
        if ((a <= 0.05)&&(a > 0.01)) {
          return("*")
        } else {
          if ((a <= 0.01)&&(a > 0.001)) {
          return("**")
          } else return("***")
        }
      }
    }
}
sigcall <- function(x){
   sapply(x, sig)
}

# 改良版コード1
sig1 <- function(a) {
    if (a > 0.1) {
      return("")
    } else {
      if (a > 0.05) {
        return(".")
      } else {
        if (a > 0.01) {
          return("*")
        } else {
          if (a > 0.001) {
          return("**")
          } else return("***")
        }
      }
    }
}
sig1call <- function(x){
   sapply(x, sig1)
}

# 改良版コード2
sig2 <- function(a){
  return(
    ifelse( a > 0.1,   "",
    ifelse( a > 0.05,  ".",
    ifelse( a > 0.01,  "*",
    ifelse( a > 0.001, "**", "***"))))
  )
}
sig2call <- function(x){
  sapply(x, sig2)
}

# 改良版コード3
sig3 <- function(a){
  return(
    `if`( a > 0.1,   "",
    `if`( a > 0.05,  ".",
    `if`( a > 0.01,  "*",
    `if`( a > 0.001, "**", "***"))))
  )
}
sig3call <- function(x){
  sapply(x, sig3)
}

# サンプルデータ
x <- runif(1000000, 0, 0.2)

# プロファイリング実行
Rprof(tmp<-tempfile(), interval=0.01)

res0 <- sigcall(x)
res1 <- sig1call(x)
res2 <- sig2call(x)
res3 <- sig3call(x)

Rprof(NULL)
summaryRprof(tmp)

このコードをtest.rとしてセーブし、次のようにすると各関数の所要時間等を知ることができる。

R --vanilla < test.r > test.log
awk 'total\.time|sig' test.log

簡単にスクリプトの内容について説明しておこう。

前述のようにテスト用ユーザー定義関数としてsig1, sig2, sig3の３つを作った。sigがオリジナルである。この4つの関数の比較を一義的には行いたいわけだ。

しかし、なんだかんだ言ってPCは高速なので、これらを単純に1回だけ試行したのでは、観測可能な所要時間の差異を検出することは困難だ。そこで、ある程度大きなテストデータを用意し、そのテストデータ内の要素を一つ一つチェック対象の関数に与えて実行させ、総所要時間を比較することにする。

サンプルデータはxとして用意した。ここでは100万要素の0≦x≦0.2の実数からなるベクトルとした。

対象データから取り出した要素について個別にこれらのユーザ関数に実行させるためのラッパーとして、sigcall, sigcall1, sigcall2, sigcall3の4つを用意した。このラッパー関数の中で、上に述べた「テストデータ内の要素を一つ一つチェック対象の関数に与えて…」を実行する仕組みである。

Results

上記のtest.logをawk '$1~/sig|total\.time/'して関連項目だけを抽出してみた。得られた結果は以下の通りだ。

                       total.time total.pct self.time self.pct
"sig2call"                   4.73     62.73      0.00     0.00
"sigcall"                    1.05     13.93      0.00     0.00
"sig1call"                   0.90     11.94      0.00     0.00
"sig3call"                   0.86     11.41      0.00     0.00

sig2callの総所要時間が4.73秒。他に比べて大幅に時間がかかっている。ifelseを使うバージョンである。

sigcallに比べてsig1callは1割ほど所要時間が少ない。両者の違いは&&演算の有無である。

sig1callとsig3callは僅差だが、後者が勝った。両者の違いはifブロックか`if`記法かである。

Discussion

見やすくて速い`if`記法

R言語の世界では次のような約束になっている。

全ての演算子やブロックは内部的には関数呼び出しとして処理される。
名前がシステムによって最初から予約済みであるようなオブジェクトは、名前をバッククォートで挟むことによって参照できる。

バッククオートをRの中で使えることは、白状すると"Advanced R"のEvery operation is a function call節を今回見るまで私は認識していなかった。

この知見に基づくと、下の二つのコードは同値と結論できるだろう。

if(True) print("Yes") else ("No")

`if`(True, print("yes"), print("no"))

両コードが同値なのであれば、プロファイリングの結果も同一になるはずである。上記結果を見ると、同値といってもコードの解釈時間には差が生じるのか微妙に結果が違い、sig3callの方がわずかに速いという結果だった。もっともこれを「速い」とするか「ほぼ同じ」とするかは見解が分かれるかもしれない。

他方、コードの見やすさという点ではどうか。
本例のようにifブロックで導く先が短いコードであった場合は、sig3のスタイルの方がずっとシンプルで読みやすく感じられる。
しかし、呼び出す先が大変長いコードだった場合は、却って見にくくなるかもしれない。ケースバイケースで使い分けるべきではあるだろう。

遅かったifelse関数

ifelse関数は遅かった。その一因は内部での処理のされ方にあるようだ。

参考：
Is `if` faster than ifelse?

if is a primitive (complied) function called through the .Primitive interface, while ifelse is R bytecode, so it seems that if will be faster.

ifelse関数はベクトル相手に直接使用すべし

ただし、我々はここまで当該のユーザー定義関数について、ある前提のもとに議論してきていた。それは：

引数は単値（より正確にはたった1つの要素のみを含むベクトル）である。

見てきたとおり、今回のプロファイルにおいては、わざわざラッパー関数の中でデータをsapplyを介してユーザー関数に渡している。ユーザー関数はあくまでも「一つの値」しか受け取っていないのである。

一方、ifelse関数はベクトルを直に処理できる。本来はsapply関数に頼る必要はないのであって、上のプロファイリングはifelse関数の長所を殺した形での比較になってしまっているといえる。ここを考慮した比較を行えば、ifelse関数の成績は相当あがると予想できる。

Conclusion

何気ない疑問から始まったベターコード探索の旅であったが、意外な発見があった。

バッククオートの使い方次第でコーディングスタイルの幅が広がる。
ifelse関数には長所と短所が存在する。

こうしたちょっとした仕様上の注意事項とそれに基づくコーディングテクニックを身につけておくことで、大規模データの処理で何時間とか（下手すれば何日とか）待ち時間が短縮できることもある。たまにはこういう勉強もしておこう。