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

(グラフィックス参考実例集に戻る。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()
 

GIFアニメーション

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")
anim.gif

グラフィックスアート 極座標による花のグラフィックス

余談/お花1

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

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度回転して書く
}
 left

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

>  # イメージ図をまず描く
>  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 の結果が保存される)
 left

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

まず 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)
 left

球の三次元プロット2 scatterplot3d の利用 (r-help 記事より, 2003.12.27)

> 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")
 left

Voronoi ダイアグラム (アドオンパッケージ tripack) 2003.12.28

> 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)
 left

帯グラフ 2003.3.3

> 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),"%"))
 center

添付ファイル: fileobi.png 2297件 [詳細] filetest.png 2404件 [詳細] fileanim.gif 2399件 [詳細] filenpp2.png 1078件 [詳細] filesphere2.png 2217件 [詳細] filetripack.voronoi.png 2320件 [詳細] filenpp1.png 1072件 [詳細] filetransparent.png 2418件 [詳細] filenpp3.png 1086件 [詳細] filesphere.png 2251件 [詳細] filelog-log-plot.png 1122件 [詳細] filelog-plot.png 1101件 [詳細]

トップ   編集 凍結 差分 バックアップ 添付 複製 名前変更 リロード   新規 一覧 検索 最終更新   ヘルプ   最終更新のRSS
Last-modified: 2023-03-25 (土) 11:19:16