3D Surface Plot with lattice/rgl

slashdot を眺めていると hirax さんによる Mathematica を利用した曲面プロットのチュートリアルが紹介されていた。
Excel Maxima には移植されているのに、残念なことに R には移植されていない模様。

ということで R lattice/rgl(OpenGL) で描いてみた。


lattice Version

lattice Bell Labs で開発された S/S-PLUS 向け可視化フレームワーク Trellis Graphics を R で実装したもの。
2004年には John Chambers Award を受賞している。

以前書いたコードをそのまま流用したのが以下

library(lattice)

g <- function(x, y) {
 1/8 * (6 * exp(-((2/3 * abs(x) - 1)^2 + (2/3 * y)^2) - 1/3 * (2/3 * y + 1/2)^3) +
        2/3 * exp(-2.818^11 * ((abs(2/3 * x) - 1)^2 + (2/3 * y)^2)^2) +
        2/3 * y - (2/3 * x)^4)
}
m <- 50
x <- seq(-3, 3, length.out=m)
y <- seq(-3, 3, length.out=m)
grid   <- expand.grid(x=x, y=y)
grid$z <- g(grid$x, grid$y)
wireframe(z ~ x * y, grid, shade=TRUE)

expand.grid {base} は 直積を作ってくれる関数。

rgl Version

rgl は R で OpenGL を呼び出すパッケージ。
2003年には John Chambers Award を受賞している。

男の子ならマウスでオッパイをグリグリしたいよね、ということで GUI でのインタラクティブ性を実現したもの。

library(rgl)

grid$col <- ifelse(sqrt((abs(grid$x) - 3/2) ^ 2 + grid$y ^2 ) < 0.45, 'hotpink', 'lightpink')# nipple
open3d()
rgl.surface(x, y, grid$z, color=grid$col)

デコルテが好みではないという方は、自分で修正をどうぞ。

Advertisements
Tagged with: ,
Posted in algorithm, R

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

Archives
%d bloggers like this: