グラフィックス参考実例集：自作グラフィックス投稿欄の編集

COLOR(red){SIZE(20){グラフィックス参考実例集：自作グラフィックス投稿欄}}

([[グラフィックス参考実例集]]に戻る。[[Rのグラフィックスパラメータ]]を参照する。)~

グラフィックスはプログラムと同様(もしくはそれ以上に)時間を食います。似たような
例があれば、大いにヒントになります。車輪を二度発明する無駄を省くため、皆さんが
苦労して作った作品を是非紹介して下さい。傑作はもちろんですが、見ためは平凡な作品も
特に苦労した点があれば後進の参考になります。はまりやすかった点も注釈して下さい。
グラフは png デバイスで出力すると投稿に便利です。また、コードは関数形にしておいて
いただくと cut and paste で他の人が試すのに便利だと思います。

注：画像の投稿は該当ページ下のアイコンの左から５番目を押すとアップロード画面がでます。同じ名前のファイルをアップロードする時は、前のを消去しないといけないようです。画像の消去は、ページ下の添付ファイル一覧から、目的ファイルの詳細欄をクリックすると案内がでます。

#contents
~
** テンプレート [#u8dd4a6b]
  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()
  
* GIFアニメーション [#z5a360ee]
 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")

#ref(グラフィックス参考実例集：自作グラフィックス投稿欄/anim.gif,center)

*グラフィックスアート 極座標による花のグラフィックス [#w749f54b]
[[余談/お花１]]

*領域右端にチックマークとそのラベルを270度回転して表示 [#a93d8790]

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度回転して書く
 }
#ref(グラフィックス参考実例集：自作グラフィックス投稿欄/test.png, left)

* グラフの一部を疑似的に透明にする(NA 値による image)  r-help 記事より [#geea002a]

>  # イメージ図をまず描く
 >  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 の結果が保存される)
#ref(グラフィックス参考実例集：自作グラフィックス投稿欄/transparent.png, left)

* 球の三次元プロット  (r-help 記事より, 2003.12.27) [#wacbc8e4]

まず 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)
#ref(グラフィックス参考実例集：自作グラフィックス投稿欄/sphere.png, left)

* 球の三次元プロット２ scatterplot3d の利用  (r-help 記事より, 2003.12.27) [#dc5044a1]

> 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")
#ref(グラフィックス参考実例集：自作グラフィックス投稿欄/sphere2.png, left)

* Voronoi ダイアグラム (アドオンパッケージ tripack) 2003.12.28 [#v1aa44e1]

> 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)
#ref(グラフィックス参考実例集：自作グラフィックス投稿欄/tripack.voronoi.png, left)

* 帯グラフ 2003.3.3 [#nf7cf1ca]
 > 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),"%"))
#ref(グラフィックス参考実例集：自作グラフィックス投稿欄/obi.png, center)

タイムスタンプを変更しない