グラフィックス参考実例集:自作グラフィックス投稿欄
(グラフィックス参考実例集に戻る。Rのグラフィックスパラメータを参照する。)
グラフィックスはプログラムと同様(もしくはそれ以上に)時間を食います。似たような 例があれば、大いにヒントになります。車輪を二度発明する無駄を省くため、皆さんが 苦労して作った作品を是非紹介して下さい。傑作はもちろんですが、見ためは平凡な作品も 特に苦労した点があれば後進の参考になります。はまりやすかった点も注釈して下さい。 グラフは png デバイスで出力すると投稿に便利です。また、コードは関数形にしておいて いただくと cut and paste で他の人が試すのに便利だと思います。
注:画像の投稿は該当ページ下のアイコンの左から5番目を押すとアップロード画面がでます。同じ名前のファイルをアップロードする時は、前のを消去しないといけないようです。画像の消去は、ページ下の添付ファイル一覧から、目的ファイルの詳細欄をクリックすると案内がでます。
foo <- function () { old.par <- par(no.readonly = TRUE) on.exit(par(old.par)) png("foo.png") ---- グラフィックス命令 ---- dev.off() } #ref(foo.png, left)
例えば画面を複数に分割したグラフィックス等では、何故か X11 デバイスにはうまく出力されるのに、他のデバイスでは一部しか出力されないことが起こる(なにかコツがあるらしいが不明)。ひとつの便法として X11 デバイスへの出力を記録し、それを他のデバイスに再現する方法がある。
---- グラフィックス命令を X11 画面に出力 ---- pp <- recordPlot() # 作図内容を記録 png("foo.png") # png デバイスを開く replayPlot(pp) # png デバイスに再現 dev.off()
for (i in formatC(1:20,width=2,flag="0")) { a <- data.frame(rnorm(26),rnorm(26)) eval(parse(text=paste("png(file=\"",i,".png\")",sep=""))) plot(a, pch=LETTERS, col=rainbow(26), axes=F, xlab="", ylab="") dev.off() } system("convert -loop 0 -delay 20 -transparent '#ffffff' -dispose Background [0-9]*.png anim.gif") system("rm -i [0-9]*.png")
test <- function () { oldpar <- par(no.readonly = TRUE); on.exit(par(oldpar)) # 終了時パラメータ復帰 par(xpd=T) # text()関数で描画領域の余白に書くことを許す plot(1:10) axis(4, labels=F) # 領域の右端にラベル無しでチックマークを描く text(rep(11, 5), seq(2,10,2), seq(2,10,2), srt=270) # チックラベルを270度回転して書く }
> # イメージ図をまず描く > z=matrix(outer(1:10,1:10,"*"),10,10) > image(z) > # 50 以上の値を NA にする > z[z>50] = NA > # 別のグラフィックスを描く > plot(runif(1000),runif(1000)) > # z を再び image 関数で描く(その際 NA 値の部分は何も描かれないので直前の plot の結果が保存される)
まず persp 関数で空の三次元プロットを生成。次に、それを "trans3d" ("persp" のヘルプ参照) で変換したポリゴンで埋める。隠れ面を消去していないが、もしそうしたければ、ポリゴンを「背後」から「前面」へと順序づけしてから、solid color (例えば col="red")で描けば、隠れるべき面は塗りつぶされるので見えなくなる。
pmat <- persp(0:1, 0:1, matrix(,2,2), xlim=c(-1,1), ylim=c(-1,1), zlim=c(-1,1), theta=25, phi=30, expand=.9, xlab="X", ylab="Y", zlab="Z") trans3d <- function(x,y,z, pmat) { # From the help for "persp" tr <- cbind(x,y,z,1) %*% pmat list(x = tr[,1]/tr[,4], y= tr[,2]/tr[,4]) } theta <- seq(0, 2*pi, length=51) phi <- seq(0, pi, length=26) x <- cos(theta) %o% sin(phi) y <- sin(theta) %o% sin(phi) z <- rep(1, length(theta)) %o% cos(phi) for (j in seq(phi)[-1]) for (i in seq(theta)[-1]) { idx <- rbind(c(i-1,j-1), c(i,j-1), c(i,j), c(i-1,j)) polygon(trans3d(x[idx], y[idx], z[idx], pmat)) } > image(z,add=T)
> library(scatterplot3d) # アドオンパッケージ scatterplot3d 読み込み > a=seq(-pi,pi, length=100) > x=c(rep(1, 100) %*% t(cos(a))) > y=c(cos(a) %*% t(sin(a))) > z=c(sin(a) %*% t(sin(a))) > scatterplot3d(x, y, z, type="l")
> library(tripack) # アドオンパッケージ tripack 使用 > coords <- cbind(runif(100), runif(100)) # ランダムな点を発生 > plot(coords, pch=19, col="blue") > plot(voronoi.mosaic(coords[,1], coords[,2], duplicate ="remove"),add=TRUE)
> data(HairEyeColor) > a <- as.table( apply(HairEyeColor, c(1,2), sum) ) > b <- a / apply(a, 1, sum) > barplot(t(b),horiz=TRUE, axes=F) > d.seg.ys <- rep((0.2 + 1) * 1:(ncol(t(b)) - 1), each=nrow(t(b))) > d.seg.ye <- rep((0.2 + 1) * 2:ncol(t(b)) - 1, each=nrow(t(b))) > d.seg.xs <- apply(t(b)[,1:(ncol(t(b)) - 1)], 2, cumsum) > d.seg.xe <- apply(t(b)[,2:ncol(t(b))], 2, cumsum) > segments(d.seg.xs, d.seg.ys, d.seg.xe, d.seg.ye) > axis(1,seq(0,1,by=0.2),paste(seq(0,100,by=20),"%"))