グラフィックス参考実例集:イメージ図 image, 等高線 contour, filled.contour
(グラフィックス参考実例集に戻る。Rのグラフィックスパラメータを参照する。)
image() 関数は格子点毎の (x,y,z) 座標を与えてイメージ表示する。高さの違いを用意された色調で塗分ける。3次元データの全体の様子を鳥瞰するにも重宝。
関数contourで、3次元データの等高線図を描くことができます。これも、鳥瞰図と同じように3次元の連続データを眺めるために使うことができます。contourもperspと同じように格子点上のz座標を要求します。したがって多くの場合、interpを使って格子点上の値を求めることになります。 perspはデータにNAを許しませんでしたが、contourはNAを受け入れるのでinterpの返す値をそのままcontourに渡すことができます。
filled.contour() 関数はいわば image + contour を一挙に実行(等高線は描かれず、色分けされる)
> x <- rnorm(500) > y <- rnorm(500) > require(MASS) > d <- kde2d(x,y,n=50) > image(d) > contour(d,add=T) > points(x,y,pch=20)
image1 <- function () { oldpar <- par(no.readonly = TRUE); on.exit(par(oldpar)) # (関数がエラー中断しても)パラメータ復帰 x <- y <- seq(-4*pi, 4*pi, len=27) r <- sqrt(outer(x^2, y^2, "+")) png("image1.png") # png デバイスを開く # イメージ表示(既定の heat.color 色調で色分け) image(z, axes = FALSE, main = "Math can be beautiful ...", xlab = expression(cos(r^2) * e^{-r/6})) # 等高線を重ねる(等高線ラベルは書かない) contour(z, add = TRUE, drawlabels = FALSE) }
image2 <- function () { data(volcano) x <- 10*(1:nrow(volcano)) y <- 10*(1:ncol(volcano)) png("image2.png") # png デバイスを開く # 地形図色調で色分けしてイメージ表示 image(x, y, volcano, col = terrain.colors(100), axes = FALSE) # 等高線を重ねる contour(x, y, volcano, levels = seq(90, 200, by=5), add = TRUE, col = "peru") # 下部に軸、チックマークを描く axis(1, at = seq(100, 800, by = 100)) # 左部に軸、チックマークを描く axis(2, at = seq(100, 600, by = 100)) # 全体を囲む枠を描く box() # タイトル title(main = "Maunga Whau Volcano", font.main = 4) }
library(akima) # アドオンパッケージ akima のロード data(akima) # パッケージ akima 附属のデータ読み込み # 線形補間 akima.li <- interp(akima$x, akima$y, akima$z) image(akima.li$x,akima.li$y,akima.li$z) contour(akima.li$x,akima.li$y,akima.li$z,add=TRUE) points(akima$x,akima$y) # 実際に与えられたデータ点の位置をプロット
> jj <- seq(from= -4, to=4,len=20) > jj <- outer(jj,jj,function(x,y){x})+1i*outer(jj,jj,function(x,y){y}) > f <- function(x){x^2} > contour(Im(f(jj)), nlevels=44 , labels=c(">","<")) # 複素数の虚部のイメージ
ct1 <- function() { x <- -6:16 op <- par(mfrow = c(2, 2)) #画面を4分割 contour(outer(x, x), method = "edge", vfont = c("sans serif", "plain")) z <- outer(x, sqrt(abs(x)), FUN = "/") z[!is.finite(z)] <- NA ## 不要かも知れない image(x, x, z) contour(x, x, z, col = "pink", add = TRUE, method = "edge", vfont = c("sans serif", "plain")) contour(x, x, z, ylim = c(1, 6), method = "simple", labcex = 1) contour(x, x, z, ylim = c(-6, 6), nlev = 20, lty = 2, method = "simple") par(op) }
ct2 <- function () { ## Persian Rug Art: x <- y <- seq(-4*pi, 4*pi, len = 27) r <- sqrt(outer(x^2, y^2, "+")) opar <- par(mfrow = c(2, 2), mar = rep(0, 4)) for(f in pi^(0:3)) contour(cos(r^2)*exp(-r/f), drawlabels = FALSE, axes = FALSE, frame = TRUE) }
ct3 <- function () { data("volcano") rx <- range(x <- 10*1:nrow(volcano)) ry <- range(y <- 10*1:ncol(volcano)) ry <- ry + c(-1,1) * (diff(rx) - diff(ry))/2 tcol <- terrain.colors(12) par(opar); opar <- par(pty = "s", bg = "lightcyan") plot(x = 0, y = 0,type = "n", xlim = rx, ylim = ry, xlab = "", ylab = "") u <- par("usr") rect(u[1], u[3], u[2], u[4], col = tcol[8], border = "red") contour(x, y, volcano, col = tcol[2], lty = "solid", add = TRUE, vfont = c("sans serif", "plain")) title("A Topographic Map of Maunga Whau", font = 4) abline(h = 200*0:4, v = 200*0:4, col = "lightgray", lty = 2, lwd = 0.1) par(opar) }
fc1 <- function () { data(volcano) filled.contour(volcano, color = terrain.colors, asp = 1)# simple }
fc2 <- function () { data(volcano) x <- 10*1:nrow(volcano) y <- 10*1:ncol(volcano) filled.contour(x, y, volcano, color = terrain.colors, plot.title = title(main = "The Topography of Maunga Whau", xlab = "Meters North", ylab = "Meters West"), plot.axes = { axis(1, seq(100, 800, by = 100)) axis(2, seq(100, 600, by = 100)) }, key.title = title(main="Height\n(meters)"), key.axes = axis(4, seq(90, 190, by = 10)))# maybe also asp=1 mtext(paste("filled.contour(.) from", R.version.string), side = 1, line = 4, adj = 1, cex = .66) }
fc3 <- function () { # 注釈付き a <- expand.grid(1:20, 1:20) b <- matrix(a[,1] + a[,2], 20) filled.contour(x = 1:20, y = 1:20, z = b, plot.axes={ axis(1); axis(2); points(10,10) }) }
fc4 <- function () { ## Persian Rug Art: x <- y <- seq(-4*pi, 4*pi, len = 27) r <- sqrt(outer(x^2, y^2, "+")) filled.contour(cos(r^2)*exp(-r/(2*pi)), axes = FALSE) ## rather, the key *should* be labeled: filled.contour(cos(r^2)*exp(-r/(2*pi)), frame.plot = FALSE, plot.axes = {}) }
(質問コーナーから転載 2004.01.04)
## 色分け範囲を自前で指定 -> level 引数を使用 ## image 関数なら breaks 引数で範囲の分割点のベクトルを与える > range(volcano) [1] 94 195 > x <- 10*1:nrow(volcano) > y <- 10*1:ncol(volcano) > filled.contour(x, y, volcano, color = terrain.colors, level=c(90,110,130,150,170,190,210), plot.title = title(main = "The Topography of Maunga Whau", xlab = "Meters North", ylab = "Meters West"), plot.axes = { axis(1, seq(100, 800, by = 100)), axis(2, seq(100, 600, by = 100)) }, key.title = title(main="Height\n(meters)"), key.axes = axis(4, seq(90, 190, by = 10))) > mtext(paste("filled.contour(.) from", R.version.string), side = 1, line = 4, adj = 1, cex = .66)
## 色分け範囲を自前で指定 -> level 引数を使用 ## 範囲色を自前で指定 -> col 引数で色名文字列ベクトルを指定 ## 但し色の自前の指定は一人よがりになり勝ちですから、お勧めできません。 ## すでに用意されている視覚的に慎重にデザインされたものを使うことをお勧めします。 > x <- 10*1:nrow(volcano) > y <- 10*1:ncol(volcano) > filled.contour(x, y, volcano, level=c(90,110,130,150,170,190,210), col = c("red", "blue", "yellow", "black", "cyan", "green"), plot.title = title(main = "The Topography of Maunga Whau", xlab = "Meters North", ylab = "Meters West"), plot.axes = { axis(1, seq(100, 800, by = 100)), axis(2, seq(100, 600, by = 100)) }, key.title = title(main="Height\n(meters)"), key.axes = axis(4, seq(90, 190, by = 10))) > mtext(paste("filled.contour(.) from", R.version.string), side = 1, line = 4, adj = 1, cex = .66)
## なおこの例の引数 color = terrain.colors の意味は、col 引数に与える色名ベクトルを ## カラーパレット関数 terrain.colors を用いて col = terrain.colors(10) のように ## しろという意味です。結果は以下のように色名を RGB 表記で与えたものになります。 > terrain.colors(10) [1] "#00A600" "#2DB600" "#63C600" "#A0D600" "#E6E600" "#E8C32E" "#EBB25E" [8] "#EDB48E" "#F0C9C0" "#F2F2F2"