グラフィックス参考実例集:ラティスグラフィックス

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

アドオンパッケージ lattice は S 用に開発されたグラフィックスパラダイムの R への移植であり、R の標準的な高水準関数の代替関数が用意されている。より細かい表現が可能になる。library(help=lattice) で関数一覧が得られる。総合的案内は ?Lattice で得られる。なお lattice パッケージは grid パッケージに依存しているので一緒にインストールしておく必要がある。場合によれば library(grid) を同時に実行する。もしかすると R 1.8 以上でないと動かないかも。lattice 関数は lightgrey の背景色等幾つかの固有の既定値を採用しているので、必要に応じ par 関数で変更する。


wireframe 関数

wireframe1 <- function() {
  library(lattice)
  x <- seq(-pi, pi, len = 20)
  y <- seq(-pi, pi, len = 20)
  g <- expand.grid(x = x, y = y)
  g$z <- sin(sqrt(g$x^2 + g$y^2))
  wireframe(z ~ x * y, g, drape = TRUE,
            perspective = FALSE,
            aspect = c(3,1), colorkey = FALSE)
   pp <- recordPlot(); png("lattice.wireframe1.png"); replayPlot(pp); dev.off()
}
lattice.wireframe1.png
wireframe2 <- function() {
  library(lattice)
  g <- expand.grid(x = 1:10, y = 5:15, gr = 1:2)
  g$z <- log((g$x^g$g + g$y^2) * g$gr)
  wireframe(z ~ x * y, data = g, groups = gr,
            scales = list(arrows = FALSE),
            shade = TRUE,
            shade.colors = function(cosangle, height)
            palette.shade(cosangle, height = .15, saturation = .05),
            light.source = c(0, 0, 1),
            screen = list(z = 30, x = -60))
   pp <- recordPlot(); png("lattice.wireframe2.png"); replayPlot(pp); dev.off()
}
lattice.wireframe2.png

cloud 関数(三次元散布図)

cloud1 <- function() {
  library(lattice)
  data(iris)
  cloud(Sepal.Length ~ Petal.Length * Petal.Width, data = iris,
        groups = Species, screen = list(x = -90, y = 70),
        aspect = c(1, 1), distance = .4, zoom = .6,
        key = list(title = "Iris Data", x = .1, y=.9,
          corner = c(0,1),
          border = TRUE,
          points = Rows(trellis.par.get("superpose.symbol"), 1:3),
          text = list(levels(iris$Species))))
   pp <- recordPlot(); png("lattice.cloud1.png"); replayPlot(pp); dev.off()
}
lattice.cloud1.png

histogram 関数

histogram1 <- function() {
  library(lattice)
  data(singer)
  histogram( ~ height | voice.part, data = singer, nint = 17,
            endpoints = c(59.5, 76.5), layout = c(2,4), aspect = 1,
            xlab = "Height (inches)")
   pp <- recordPlot(); png("lattice.histogram1.png"); replayPlot(pp); dev.off()
}
lattice.histogram1.png
## この例は  S-Plus では表示できないかも知れない
histogram2 <- function() {
  library(lattice)
  data(singer)
  histogram( ~ height | voice.part, data = singer,
            xlab = "Height (inches)", type = "density",
            panel = function(x, ...) {
            panel.histogram(x, ...)
            panel.mathdensity(dmath = dnorm,
                                args = list(mean=mean(x),sd=sd(x)))
           } )
  pp <- recordPlot(); png("lattice.histogram2.png"); replayPlot(pp); dev.off()
}
lattice.histogram2.png

densityplot 関数

densityplot3 <- function() {
  library(lattice)
  data(singer)
  densityplot( ~ height | voice.part, data = singer, layout = c(2, 4),
              xlab = "Height (inches)", bw = 5)
  pp <- recordPlot(); png("lattice.densityplot1.png"); replayPlot(pp); dev.off()
}
lattice.histogram3.png

levelplot 関数

levelplot1 <- function() {
  library(lattice)
  x <- seq(pi/4, 5*pi, length = 100)
  y <- seq(pi/4, 5*pi, length = 100)
  r <- as.vector(sqrt(outer(x^2, y^2, "+")))
  grid <- expand.grid(x=x, y=y)
  grid$z <- cos(r^2) * exp(-r/(pi^3))
  levelplot(z~x*y, grid, cuts = 50, xlab="", ylab="",
            main="Weird Function", colorkey = FALSE)
}
lattice.levelplot1.png

contourplot 関数

contourplot1 <- function() { #S+ example
  library(modreg)
  library(lattice)
  data(environmental)
  attach(environmental)
  ozo.m <- loess((ozone^(1/3)) ~ wind * temperature * radiation,
                 parametric = c("radiation", "wind"), span = 1, degree = 2)
  w.marginal <- seq(min(wind), max(wind), length = 50)
  t.marginal <- seq(min(temperature), max(temperature), length = 50)
  r.marginal <- seq(min(radiation), max(radiation), length = 4)
  wtr.marginal <- list(wind = w.marginal, temperature = t.marginal,
                       radiation = r.marginal)
  grid <- expand.grid(wtr.marginal)
  grid[, "fit"] <- c(predict(ozo.m, grid))
  contourplot(fit ~ wind * temperature | radiation, data = grid,
              cuts = 10, region = TRUE,
              xlab = "Wind Speed (mph)",
              ylab = "Temperature (F)",
              main = "Cube Root Ozone (cube root ppb)",
              col.regions = trellis.par.get("regions")$col)
  detach()
}  
lattice.contourplot1.png

グラフの回転 r-help 記事より

> library(lattice)
> library(grid)
> myhist <- histogram(rnorm(50))
> # Make two square regions side by side
> push.viewport(viewport(layout=grid.layout(1, 2, respect=TRUE)))
> # Go to the left region
> push.viewport(viewport(layout.pos.col=1))
> # Draw the histogram in normal orientation
> print(myhist, newpage=FALSE)
> pop.viewport()
> # Go to the right region then rotate 90 degrees
> push.viewport(viewport(layout.pos.col=2), viewport(angle=90))
> # Draw the histogram (rotated 90 degrees)
> print(myhist, newpage=FALSE
> pop.viewport(3) 

#ref(): The style ref(filename,pagename) is ambiguous and become obsolete. Please try ref(pagename/filename)

P. Murrel の gridBase パッケージによるグラフィックス例 (Rnews 3.2 の記事より)

gridBase.ex.1 <- function() {
#library(grid)
library(gridBase)
#library(lattice)
midpts <- barplot(1:10, axes=FALSE)
axis(2)
axis(1, at=midpts, labels=FALSE)
vps <- baseViewports()
par(new=TRUE)
push.viewport(vps$inner, vps$figure, vps$plot)
grid.text(c("0ne", "two", "three", "four", "five", "six", 
            "seven", "eight", "nine", "ten"),
          x = unit(midpts, "native"),
          y = unit(-1, "lines"),
          just = "right",
          rot = 60)
pop.viewport(3)
}
gridBase1.png

添付ファイル: filelattice.histogram2.png 2481件 [詳細] filelattice.cloud1.png 2715件 [詳細] filelattice.levelplot1.png 2564件 [詳細] filelattice.contourplot1.png 2487件 [詳細] filegridBase1.png 2585件 [詳細] filelattice.histogram3.png 2466件 [詳細] filelattice.wireframe1.png 2583件 [詳細] filelattice.histogram1.png 2510件 [詳細] filelattice.wireframe2.png 2505件 [詳細] filerotate.graph.png 1329件 [詳細]

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