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アニメーション
* 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)
#ref(グラフィックス参考実例集：自作グラフィックス投稿欄/anim.gif,center)
*グラフィックスアート 極座標による花のグラフィックス
*グラフィックスアート 極座標による花のグラフィックス [#w749f54b]
[[余談/お花１]]
*領域右端にチックマークとそのラベルを270度回転して表示
*領域右端にチックマークとそのラベルを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)
#ref(グラフィックス参考実例集：自作グラフィックス投稿欄/test.png, left)
* グラフの一部を疑似的に透明にする(NA 値による image) r-help 記事より
* グラフの一部を疑似的に透明にする(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)
#ref(グラフィックス参考実例集：自作グラフィックス投稿欄/transparent.png, left)
* 球の三次元プロット (r-help 記事より, 2003.12.27)
* 球の三次元プロット (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)
#ref(グラフィックス参考実例集：自作グラフィックス投稿欄/sphere.png, left)
* 球の三次元プロット２ scatterplot3d の利用 (r-help 記事より, 2003.12.27)
* 球の三次元プロット２ 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)
#ref(グラフィックス参考実例集：自作グラフィックス投稿欄/sphere2.png, left)
* Voronoi ダイアグラム (アドオンパッケージ tripack) 2003.12.28
* 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)
#ref(グラフィックス参考実例集：自作グラフィックス投稿欄/tripack.voronoi.png, left)
* 帯グラフ 2003.3.3
* 帯グラフ 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)
#ref(グラフィックス参考実例集：自作グラフィックス投稿欄/obi.png, center)
![[RjpWiki]](image/../Rlogo.png "[RjpWiki]")
