VOYAGE GROUP エンジニアブログ

voyagegroup_techのブログ
VOYAGE GROUPエンジニアブログです。

r

メタプログラミングR:重い関数をキャッシュする

こんにちは、VOYAGE GROUPの水越(@Akiyah)です。

最近、仕事でデータ解析環境「R」を使ってデータベースからデータを取り出して加工することが多いです。
そういったとき、データベースからデータをとる部分はSQLでまるまる取得して、その後Rでもりもり加工するのが好きです。
ですがその場合、何度も実行するとSQLの処理が重いしデータベースに負担をかけることになるので、ちょっと困っていました。

そこで今回、Rのメタプログラミングで関数呼び出しをキャッシュ化してみることにしました。
キャッシュと言ってもずっと同じ値を返すのではデータベースに新しいデータが入ったときに更新されないで困るので、ある一定期間(例えば24時間)を過ぎたら最新の値をとるように作ります。

キャッシュ無し

まず最初に、"重い処理"という文字列を出力する関数を作ります。
heavy_func1 <- function() {
  print("重い処理")
  result <- rnorm(1) # ランダムな数字
  return(result)
}
このprint("重い処理")が重いSQLであると思ってください。
heavy_func1を何度か実行すると、
> heavy_func1()
[1] "重い処理"
[1] -2.146503
> heavy_func1()
[1] "重い処理"
[1] 0.07116749
> heavy_func1()
[1] "重い処理"
[1] -0.277692
何度も"重い処理"が実行されているのがわかります。

グローバル変数を用いたキャッシュ

それではキャッシュするバージョンを作ってみましょう。Rでは実行環境(ワークスペース)にデータを持たせて、Rの終了時にファイルに保存して次のR起動時に読み込む事ができるので、グローバル変数にキャッシュを入れておけば今回の用途には十分です。単純に書くとこうなります。
heavy_func2.cache <- NULL
heavy_func2 <- function() {
  now <- Sys.time()
  if(!is.null(heavy_func2.cache)) {
    if (10 > now - heavy_func2.cache$updated_at) {
      return(heavy_func2.cache$value)
    }
  }
  print("重い処理")
  result <- rnorm(1) # ランダムな数字
  heavy_func2.cache <<- list(value=result, updated_at=now)
  return(result)
}
<<-は永続代入と言って、関数定義からグローバル変数に代入するときに使います。キャッシュ(heavy_func2.cache)にはキャッシュする値(value)と更新日時(updated_at)のリストを入れておきます。

実行してみると、
> heavy_func2()
[1] "重い処理"
[1] -0.06969717
> heavy_func2()
[1] -0.06969717
> heavy_func2()
[1] -0.06969717
"重い処理"がはじめの一回しか呼ばれていない事がわかります。そして戻り値はキャッシュが効いて同じ値を返しています。キャッシュの更新時間はここでは10秒にしているので10秒経つともう一度処理が実行されて、値も新しいものになります。
> heavy_func2()
[1] "重い処理"
[1] 0.8203284
ちなみにRでは変数名に"."(ピリオド)が使えます。逆に言うとピリオドが使われていたからと言ってそれはJavaやRubyなどの言語のようなオブジェクトの属性へのアクセスと言うわけではありません。

明示的なグローバル変数宣言を削除

実はこのままだと困る事があります。関数定義の直前にキャッシュのグローバル変数を定義しているので、たとえば関数定義を別ファイルにして何度も呼び出すと、その度にキャッシュが消えてしまうのです。そこを改善してみます。
heavy_func3 <- function() {
  now <- Sys.time()
  if(exists("heavy_func3.cache")) {
    if (10 > now - heavy_func3.cache$updated_at) {
      return(heavy_func3.cache$value)
    }
  }
  print("重い処理")
  result <- rnorm(1) # ランダムな数字
  heavy_func3.cache <<- list(value=result, updated_at=now)
  return(result)
}
グローバル変数を直接定義するのではなく、変数が定義されているかどうか確認する関数existを使うようにした事で、明示的なグローバル変数の定義を消す事ができました。やっとメタプログラミングっぽくなってきましたね。もうちょっと進めてみます。

明示的なグローバル変数アクセスを関数経由に

heavy_func4 <- function() {
  now <- Sys.time()
  cache_name <- paste("heavy_func4", "cache", sep=".")
  if(exists(cache_name)) {
    cache <- get(cache_name)
    if (10 > now - cache$updated_at) {
      return(cache$value)
    }
  }
  print("重い処理")
  result <- rnorm(1) # ランダムな数字
  assign(cache_name, list(value=result, updated_at=now), envir=.GlobalEnv)
  return(result)
}
グローバル変数へのアクセスを全て関数(exists, get, assign)経由にしました。assignの引数にある.GlobalEnvはグローバル環境を表します(このあたりをもっと有効に使う例はまた今度)。

キャッシュを別関数化

そろそろ仕上げです。このキャッシュの仕組みを共通化して別の関数に出します。
cache.get <- function(key) {
  now <- Sys.time()
  cache_name <- paste(key, "cache", sep=".")
  if(exists(cache_name)) {
    cache <- get(cache_name)
    if (10 > now - cache$updated_at) {
      return(cache$value)
    }
  }
  return(NULL)
}

cache.set <- function(key, value) {
  now <- Sys.time()
  cache_name <- paste(key, "cache", sep=".")
  assign(cache_name, list(value=value, updated_at=now), envir=.GlobalEnv)
}

heavy_func5 <- function() {
  cache <- cache.get("heavy_func5")
  if(!is.null(cache)) return(cache)
  print("重い処理")
  result <- rnorm(1) # ランダムな数字
  cache.set("heavy_func5", result)
  return(result)
}
キャッシュしたい関数の最初と最後にちょっと差し込めばキャッシュ化が可能になりました! ふー、一段落ですね。

残りタスク

    残りタスク
  • キャッシュの更新時間を設定できるようにする
  • キャッシュを高階関数化して関数を渡すとキャッシュ化した関数を返すようにする
  • グローバル環境を使わないようにする
  • キャッシュ化する関数のソースコードが変更された場合はキャッシュをクリアするようにする
残りタスクは解決できたらまた報告します。

FizzBuzz問題をデータ解析環境「R」で

こんにちは、VOYAGE GROUPの水越(@Akiyah)です。
いま話題のFizzBuzz問題をデータ解析環境「R」で書いてみました。

メインの参考ページはここです。
FizzBuzz問題を使って社内プログラミングコンテストを開催してみた - ITは芸術だ
仕様
・1から順番に数をコマンドプロンプト/ターミナルに表示する。
・その数が3で割り切れるなら"Fizz“
・5で割り切れるなら"Buzz“
・両方で割り切れるなら"FizzBuzz"と表示する。
まずは上記のページで紹介されているperl版をほぼそのままRに移植してみます。
args <- commandArgs()
endval <- args[6]

for (i in 1:endval) {
    fizz = i %% 3
    buzz = i %% 5

    if (fizz == 0 && buzz == 0) {
        cat("FizzBuzz")
    }
    else if (fizz == 0) {
        cat("Fizz")
    }
    else if (buzz == 0) {
        cat("Buzz")
    }
    else {
        cat(i)
    }
    cat("\n")
}
Rというなじみのない言語ですが、コードはいたって普通ですね。<-は代入で、catは画面表示する関数です。
このファイルをfizzbuzz.rというファイルに保存して、Rscriptコマンドで実行します。(この記事書くまでRファイルをコマンドラインから実行する方法を知りませんでした! Rでは環境に入って作業するのが普通なのです。)
$ Rscript fizzbuzz.r 20
1
2
Fizz
4
Buzz
Fizz
7
8
Fizz
Buzz
11
Fizz
13
14
FizzBuzz
16
17
Fizz
19
Buzz
もとのperl版からほとんど変えずに動きました。よかったよかった。
さて、Rらしく変更してみます。
args <- commandArgs()
endval <- args[6] i <- 1:endval x <- i x[i%%3==0] <- "Fizz" x[i%%5==0] <- "Buzz" x[i%%3==0 & i%%5==0] <- "FizzBuzz" cat(paste(x, collapse="\n")) cat("\n")
だいぶ短くなりましたね。実行結果はまったく同じです。
ちょっと解説しますね。Rのベクトル(配列みたいなものです)はまとめて演算したり、条件を判断して新しいベクトルを作ることができます。下記はRコマンドでRの実行環境に移動して試しています。
> i <- 1:20
> i
 [1]  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20
> i%%3
 [1] 1 2 0 1 2 0 1 2 0 1 2 0 1 2 0 1 2 0 1 2
> i%%3==0
 [1] FALSE FALSE  TRUE FALSE FALSE  TRUE FALSE FALSE  TRUE FALSE FALSE  TRUE
[13] FALSE FALSE  TRUE FALSE FALSE  TRUE FALSE FALSE
そしてベクトルの[ ](インデックス)にベクトルを入れたり、それをつかって<-でまとめて値を変更したりできるのです。
> x <- 1:20
> x[i%%3==0]
[1]  3  6  9 12 15 18
> x[i%%3==0] <- "Fizz"
> x
 [1] "1"    "2"    "Fizz" "4"    "5"    "Fizz" "7"    "8"    "Fizz" "10"  
[11] "11"   "Fizz" "13"   "14"   "Fizz" "16"   "17"   "Fizz" "19"   "20"  
このベクトル操作を利用して、ベクトルの3、5、15の倍数の時の値を変更したのです。実は『
FizzBuzz R』で検索するとたくさん見つかって、R業界ではFizzBuzz問題は有名みたいです。上に書いた例と同様のコードも見つかりました。考えてみると、FizzBuzz問題はRの得意分野なんですよね。

参考
The R Project for Statistical Computing
FizzBuzz問題を使って社内プログラミングコンテストを開催してみた - ITは芸術だ
FizzBuzz問題をJavaScriptで - jsdo.it - Share JavaScript, HTML5 and CSS
Fizz-Buzz問題 初級Q&A アーカイブ(7) - RjpWiki

Rを使ってお絵描き(アンパンマン方程式)

こんにちは、ECナビの水越(@Akiyah)です。

Rでお絵描きの完結編です。アンパンマン方程式というものを作ってみました。
anpanman_equation
この方程式を解くと、こうなります。

anpanman_equation

アン、アン、アンパンマーン!
Rのコードはこんな感じです。
library(rgl)                           # パッケージの呼び出し
open3d()                               # デバイスの起動

rgl.bg(color="#808080")
rgl.light(theta = 5, phi = 5)
x <- seq(-110, 110, length = 880)
y <- x
anpanman <- function(x,y) {
    s(((x   )/85)^2+((y   )/85)^2-1) * # face
    s(((x-55)/24)^2+((y +5)/24)^2-1) * # cheek
    s(((x   )/28)^2+((y +5)/23)^2-1) * # nose
    s(((x-18)/ 9)^2+((y-40)/15)^2-1) * # eye
   s((((x-18)/12)^2+((y-45)/20)^2-2) * h(y-45) + 1) * # eyebrow
   s((((x   )/42)^2+((y+35)/18)^2-2) * h(-y-35) + 1)   # mouse
}
s <- function(z) { sin(z*pi/2) * ((z < 1) * (z > -1)) + (z >= 1)*1 + (z <= -1)*(-1) }
h <- function(z) { z>0 } # function(z) { (abs(z)/z + 1)/2 }
anpanman_view <- function(x,y) {
  -abs(anpanman(abs(x),y) * 30)
}
z <- outer(x, y, anpanman_view)

col_g <- gray(0:3/3)
col <- col_g[1 + 1-((z < 3) & (z > -3))]
terrain3d(x, y, z, color=col)
方程式の正体は、楕円の方程式の組み合わせです。
眉毛と口の式を工夫して、うまく楕円の半分になるようにしました。
前の二回のアンパンマンは眉毛がかけなくて悔しかったのですが、やっと完璧なアンパンマンにすることができましたよ。

Rを使ってお絵描き(アンパンマン3D)

こんにちは、ECナビの水越明哉(@Akiyah)です。

Rでお絵描きの続きです。今回は3Dに挑戦してみました。Rなら簡単でしたよ。

まずは、R-Tips57. パッケージ RGLを参考にしてRGLをインストールしておきます。私の環境はWindowsXPとUbuntu11.04なのですが、Ubuntuのほうは「rgl」パッケージをインストール - ryamadaの弟子日記をみてsynapticでインストールしました。

まずパッケージの呼び出しをします。
 library(rgl)                           # パッケージの呼び出し
そのあと、rglをつかって描画します。
 open3d()                               # デバイスの起動

 rgl.clear(type="lights")               # 光源の設定の消去
 rgl.light(theta = 15, phi = 25)
 rgl.viewpoint(0,0)

 spheres3d(  0,  0,  0, 85, color=heat.colors(24)[23])
 spheres3d(-55, -5, sqrt(85**2-55**2-5**2),  24, color=heat.colors(12)[5]) # ほっぺ
 spheres3d( 55, -5, sqrt(85**2-55**2-5**2),  24, color=heat.colors(12)[5]) # ほっぺ
 spheres3d(  0, -5, sqrt(85**2-5**2),        28, color=heat.colors(12)[4]) # 鼻
 spheres3d(-18, 40, sqrt(85**2-18**2-40**2), 15, color="black") # 目
 spheres3d( 18, 40, sqrt(85**2-18**2-40**2), 15, color="black") # 目
これでR上でアンパンマンができました!かんたん!
マウスで向きを変えることもできます。
ただこの素敵な動きをそのままブログに貼ることができないので、ぐりぐり写真に変換してみました。

Rで少しずつ角度を変えた画像をファイルに出力して
 for(i in -10:20) {rgl.viewpoint(i*3,i/4); rgl.postscript(paste(i+10,".eps",sep=""), fmt="eps")} 
そのあとGIMPでまとめて、ぐりぐり写真に加工しました。
{"src":"http://art48.photozou.jp/pub/876/237876/photo/96064293_org.png", "width":"480", "height":"360"}

R上では左右だけでなく上下にも動かせるのですが、雰囲気は伝わりますよね。
ハナやほっぺのテカリがうまく表現できていて、さすがRです。

参考:

Rを使ってお絵描き(アンパンマン)

こんにちは、6月からECナビで働いている水越明哉(@Akiyah)ともうします。

最近、Rを使いはじめました。Rとはオープンソースの統計解析ソフトで、解析したデータをグラフにするのも得意です。まだ手探り中ですが、なかなか良いツールだなぁと思っています。そこでRと仲良くなるためにRでお絵描きをしてみることにしました。

まずは、R -- 図形描画関数群を参考にして図形描画関数をインストールします。
source("http://aoki2.si.gunma-u.ac.jp/R/src/plot.R", encoding="euc-jp")
この図形描画関数を使ってアンパンマンを書いてみます。アンパンマンのソースはJavaScriptでアンパンマンを描くコードを参考にしました。
plot.start(asp=1)
plot.circlef( 200,    200,    85,        col=heat.colors(24)[23]) # 輪郭
plot.circlef( 200-55, 200-5,  24,        col=heat.colors(12)[5]) # 左ほっぺ
plot.circlef( 200+55, 200-5,  24,        col=heat.colors(12)[5]) # 右ほっぺ
plot.ellipsef(200,    200-5,  28, 23, 0, col=heat.colors(12)[4]) # 鼻
plot.ellipsef(200-18, 200+40,  9, 15, 0, col="black") # 左目
plot.ellipsef(200+18, 200+40,  9, 15, 0, col="black") # 右目
plot.ellipse( 200,    200-30, 42, 18, 0, 180, 360, lwd=3) # 口
げんき100ばい!アンパンマンがかけましたね。



あとは画像ファイルとして出力して、
dev.print(file="rpanman1.eps", width=10, height=10, horizontal=FALSE)
GIMPでまとめてgifアニメにしましたよ。
またRでお絵描きしたら投稿します。

参考:
記事検索
QRコード
QRコード