graphics.txt

里面有三个PDF文件

# create X1X3 grey region and plot boundary
obsphi <- pi/24
crit <- pi/2-obsphi
theta1sA <- c(seq(-crit, crit/2, length=200), seq(crit/2, crit, length=500))
theta2sA <- asin(cos(crit)/cos(theta1sA))
theta1sB <- seq(crit, crit/2, length=500)
theta2sB <-  pi-asin(cos(crit)/cos(theta1sB))
theta1s <- c(theta1sA, theta1sB)
theta2s <- c(theta2sA, theta2sB)
vals <- k1*sin(theta1s)+k2*cos(theta1s)*cos(theta2s+pi/4)
xx1 <- cos(theta1s[vals>=0])*sin(theta2s[vals>=0]+pi/4)
yy1 <- k2*sin(theta1s[vals>=0])-k1*cos(theta1s[vals>=0])*cos(theta2s[vals>=0]+pi/4)
theta2s <-  -theta2s
vals <- k1*sin(theta1s)+k2*cos(theta1s)*cos(theta2s+pi/4)
xx3 <- cos(theta1s[vals>=0])*sin(theta2s[vals>=0]+pi/4)
yy3 <- k2*sin(theta1s[vals>=0])-k1*cos(theta1s[vals>=0])*cos(theta2s[vals>=0]+pi/4)
rev <- seq(length(xx3), 1, -1)
xx3 <- xx3[rev]
yy3 <- yy3[rev]
ang1 <-  pi+atan(xx1[length(xx1)]/yy1[length(yy1)])
ang2 <-  pi+atan(xx3[1]/yy3[1])
angs <- seq(ang1, ang2, length=50)
xx2 <- sin(angs)
yy2 <- cos(angs)
ang4 <-  pi+atan(xx1[1]/yy1[1])
ang3 <-  pi+atan(xx3[length(xx3)]/yy3[length(yy3)])
angs <- seq(ang3, ang4, length=50)
xx4 <- sin(angs)
yy4 <- cos(angs)
xxB <- c(xx1, -xx2, xx3, xx4)
yyB <- c(yy1, -yy2, yy3, yy4)
polygon(xxB, yyB, border="grey", col="grey")
xx1B <- xx1
yy1B <- yy1
xx3B <- xx3
yy3B <- yy3

# create X1X2 grey region and plot boundary
vals <- k1*sin(theta1s)+k2*cos(theta1s)*cos(theta2s-pi/4)
xx1 <- cos(theta1s[vals>=0])*sin(theta2s[vals>=0]-pi/4)
yy1 <- k2*sin(theta1s[vals>=0])-k1*cos(theta1s[vals>=0])*cos(theta2s[vals>=0]-pi/4)
theta2s <-  -theta2s
vals <- k1*sin(theta1s)+k2*cos(theta1s)*cos(theta2s-pi/4)
xx3 <- cos(theta1s[vals>=0])*sin(theta2s[vals>=0]-pi/4)
yy3 <- k2*sin(theta1s[vals>=0])-k1*cos(theta1s[vals>=0])*cos(theta2s[vals>=0]-pi/4)
rev <- seq(length(xx3), 1, -1)
xx3 <- xx3[rev]
yy3 <- yy3[rev]
ang1 <-  pi+atan(xx1[length(xx1)]/yy1[length(yy1)])
ang2 <-  pi+atan(xx3[1]/yy3[1])
angs <- seq(ang1, ang2, length=50)
xx2 <- sin(angs)
yy2 <- cos(angs)
ang4 <-  pi+atan(xx1[1]/yy1[1])
ang3 <-  pi+atan(xx3[length(xx3)]/yy3[length(yy3)])
angs <- seq(ang3, ang4, length=50)
xx4 <- sin(angs)
yy4 <- cos(angs)
xx <- c(xx1, -xx2, xx3, xx4)
yy <- c(yy1, -yy2, yy3, yy4)
polygon(xx, yy, border="grey", col="grey")
xx1C <- xx1
yy1C <- yy1
xx3C <- xx3
yy3C <- yy3


# plot boundaries to grey regions
lines(xx1C[2:45], yy1C[2:45], lwd=2)
lines(xx1C[69:583], yy1C[69:583], lwd=2)
lines(xx1C[660:1080], yy1C[660:1080], lwd=2)
lines(xx3C[13:455], yy3C[13:455], lwd=2)
lines(xx3C[538:1055], yy3C[538:1055], lwd=2)
lines(xx3C[1079:1135], yy3C[1079:1135], lwd=2)
lines(xx1A[6:113], yy1A[6:113], lwd=2)
lines(xx1A[153:346], yy1A[153:346], lwd=2)
lines(xx1A[389:484], yy1A[389:484], lwd=2)
lines(xx3A[1:93], yy3A[1:93], lwd=2)
lines(xx3A[140:362], yy3A[140:362], lwd=2)
lines(xx3A[408:497], yy3A[408:497], lwd=2)
lines(xx1B[2:45], yy1B[2:45], lwd=2)
lines(xx1B[69:583], yy1B[69:583], lwd=2)
lines(xx1B[660:1080], yy1B[660:1080], lwd=2)
lines(xx3B[13:455], yy3B[13:455], lwd=2)
lines(xx3B[538:1055], yy3B[538:1055], lwd=2)
lines(xx3B[1079:1135], yy3B[1079:1135], lwd=2)

# Plot longitudes
vals <- seq(-7, 8, 1)*pi/8
for(lambda in vals){
  sl <- sin(lambda)
  cl <- cos(lambda)
  phi <- atan(((0-1)*k2*cl)/(k1))
  angs <- seq(phi, 5.6*pi/12, length=500)
  xx <- cos(angs)*sl
  yy <- k2*sin(angs)-k1*cos(angs)*cl
  lines(xx, yy, lwd=.5)
}


# Plot Latitudes
# vals2 <- seq(-2.8, 5.6, 1.4)*pi/12
vals2 <- c(-1.5, 0, 1.5, 3.0, 4.5, 5.6)*pi/12
for(phi in vals2){
  if (k1*sin(phi) > k2 * cos(phi)) 
    crit <- pi 
  else 
    crit <- acos((-k1*sin(phi))/(k2*cos(phi)))
  lambdas <- seq(-crit, crit, length=500)
  xx <- cos(phi)*sin(lambdas)
  yy <- k2*sin(phi)-k1 * cos(phi)*cos(lambdas)
  lines(xx, yy, lwd=.5)
}


# create lines for X1X2- and X1X3-planes
lambda <- pi/4
sl <- sin(lambda)
cl <- cos(lambda)
phi <- atan(((0-1)*k2*cl)/(k1))
angs <- seq(phi, pi+phi, length=500)
xx <- cos(angs)*sl
yy <- k2*sin(angs)-k1*cos(angs)*cl
lines(xx, yy, lwd=2)
lambda <- 3*pi/4
sl <- sin(lambda)
cl <- cos(lambda)
phi <- atan(((0-1)*k2*cl)/(k1))
angs <- seq(phi, pi+phi, length=500)
xx <- cos(angs)*sl
yy <- k2*sin(angs)-k1*cos(angs)*cl
lines(xx, yy, lwd=2)

# create line for X2X3-plane
phi <- 0
crit <- acos((-k1*sin(phi))/(k2 * cos(phi)))
lambdas <- seq(-crit, crit, length=500)
xx <- cos(phi)*sin(lambdas)
yy <- k2*sin(phi)-k1 * cos(phi)*cos(lambdas)
lines(xx, yy, lwd=2)

# create axes
lines(c(0.00, 0.00), c(k2*sin(pi/2), 1.11), lwd=4)
lines(c(0.00, 0.00), c(-1, -1.12), lwd=4)
a2x <- sin(-pi/4)
a2y <- cos(-pi/4)*(-k1)
lines(c(a2x, 1.5*a2x), c(a2y, 1.5*a2y), lwd=4)
a3x <- sin(pi/4)
a3y <- cos(pi/4)*(-k1)
lines(c(a3x, 1.5*a3x), c(a3y, 1.5*a3y), lwd=4)
k <- sqrt(a3x^2+a3y^2)
lines(c(-a3x/k, 1.2*(-a3x/k)), c(-a3y/k, 1.2*(-a3y/k)), lwd=4)
k <- sqrt(a2x^2+a2y^2)
lines(c(-a2x/k, 1.2*(-a2x/k)), c(-a2y/k, 1.2*(-a2y/k)), lwd=4)


# add text
text(-1.07, -.85, expression(bold(X[2])))
text(1.11, -.85, expression(bold(X[3])))
text(0.1, 1.12, expression(bold(X[1])))

lines(XX, YY, type="l")
#########################################################################
10>Figure 1.10 
A music score 

#
# Comment:
#
# Code by Steve Miller 
# (Graduate student in the Statistics Department, The University of Auckland).
#
# An example of a one-off image using the traditional graphics system.  
# All parameters are hard-coded and the image only looks right when 
# drawn with a specific aspect ratio (4:1).
#
# Also an example of drawing an empty plot with a specific coordinate system
# and then building up a final image by drawing individual lines and
# and pieces of text.
# 
# Small point of interest is the use of some special glyphs (e.g., treble
# clef) from the Hershey vector fonts.
#



# TOP: music
par(yaxt = "n", xaxt = "n", ann = F, fig = c(0, 1, 0, 1), 
    mar = c(0, 0, 0, 0), cex=0.5)
plot(1:10, type = "n", xlab = "", ylab = "")
title(main = "A Little Culture", line = -1)
E = 5; F = 5.2; G = 5.4; A = 5.6; B = 5.8; C = 6; D = 6.2; E2 = 6.4; F2 = 6.6

# stave
for (i in c(E, G, B, D, F2)) {
	lines(x = c(1, 10), y = rep(i, 2))
}

# Hershey characters (treble clef, crotchet rest, sharp)
s1 = list(x = 1.2, y = G) #place clef on G
text(list(x = c(s1$x, s1$x + 8.5, s1$x + .5), y = c(s1$y, s1$y + .4, F2)), 
     vfont = c("serif", "plain"), 
     labels = c("\\#H2330", "\\#H2378", "\\#H2323"), 
     cex = 2) 

# time signature
text(x = rep(s1$x + .3, 2), y = c(s1$y, s1$y + .8), 
     labels = c("4", "4"), cex = 0.8)

# notes
points(list(y = c(B, A, G, A, B, B, B), 
            x = c(s1$x + 1, s1$x + 2, s1$x + 3, s1$x + 4, s1$x + 5.5, 
                  s1$x + 6.5, s1$x + 7.5)), 
       pch = 16, cex = 1.2)

# note tails
tail = 1.05
for (n in c(B, A, G, A)) {
  lines(x = rep(s1$x + tail, 2), y = c(n, n + 1))
  tail = tail + 1
}

tail = tail + .5
for (n in c(B, B, B)) {
  lines(x = rep(s1$x + tail, 2), y = c(n, n + 1))
  tail = tail + 1
}

# bar lines
lines(x = rep(1, 2), y = c(E, F2))
lines(x = rep(s1$x + 4.75, 2), y = c(E, F2))
lines(x = rep(9.9, 2), y = c(E, F2))
lines(x = rep(10, 2), y = c(E, F2), lwd = 2)

# lyrics
text(x = seq(s1$x + 1, s1$x + 8.5, by = 0.5), y = rep(4, 16), 
     labels = c("Ma-", "", "ry", "", "had", "", "a", "", "", 
                "lit-", "", "tle", "", "lamb", "", ""), 
     cex = 1, font = 4)
##################################################################
11>Figure 1.11 
A piece of clip art 
#
# Comment:
#
# An example of a one-off image drawn using the grid system.
#
# The code is somewhat modular and general, with functions
# for producing different shapes, but the sizes and
# locations used in this particular image assume a 2:1 aspect ratio.
#
# The gradient-fill background (dark at the top to lighter at the 
# bottom) is achieved by filling multiple overlapping polygons with
# slowly changing shades of grey.
#


pushViewport(viewport(xscale=c(0, 1), yscale=c(0.5, 1),
             clip=TRUE))
             
res <- 50
for (i in 1:res)
  grid.rect(y=1 - (i-1)/res, just="top",
            gp=gpar(col=NULL, fill=grey(0.5*i/res)))

moon <- function(x, y, size) {
  angle <- seq(-90, 90, length=50)/180*pi
  x1 <- x + size*cos(angle)
  y1 <- y + size*sin(angle)
  mod <- 0.8
  x2 <- x + mod*(x1 - x)
  grid.polygon(c(x1, rev(x2)), c(y1, rev(y1)),
               default.unit="native",
               gp=gpar(col=NULL, fill="white"))
}

moon(.1, .9, .03)

star <- function(x, y, size) {
  x1 <- c(x,           x + size*.1, x + size*.5, x + size*.1,
          x,           x - size*.1, x - size*.5, x - size*.1) + .05
  y1 <- c(y - size,    y - size*.1, y,           y + size*.1,
          y + size*.7, y + size*.1, y,           y - size*.1) + .05
  grid.polygon(x1, y1, 
               default.unit="native",
               gp=gpar(col=NULL, fill="white"))
}

star(.5, .7, .02)
star(.8, .9, .02)
star(.72, .74, .02)
star(.62, .88, .02)

grid.circle(runif(20, .2, 1), runif(20, .6, 1), r=.002,
            default.unit="native",
            gp=gpar(col=NULL, fill="white"))

hill <- function(height=0.1, col="black") {
  n <- 100
  x <- seq(0, 1, length=n)
  y1 <- sin(runif(1) + x*2*pi)
  y2 <- sin(runif(1) + x*4*pi)
  y3 <- sin(runif(1) + x*8*pi)
  y <- 0.6 + height*((y1 + y2 + y3)/3)
  grid.polygon(c(x, rev(x)), c(y, rep(0, n)),
               default.unit="native",
               gp=gpar(col=NULL, fill=col))
}

hill()

rdir <- function(n) {
  sample(seq(-45, 45, length=10), n)/180*pi
}

grid.text("Once upon a time ...",
          x=.15, y=.51, just="bottom",
          default.unit="native",
          gp=gpar(col="white", fontface="italic", fontsize=10))

popViewport()

grid.rect()
####################################################################
Figure 1.12 
The structure of the R graphics system 
#
# Comment:
#
# Makes use of the roundRect grob defined in the RGraphics package
#

require(RGraphics)

label <- function(label, row, col, title=FALSE, box=TRUE, tcol="black",
                  fill=NA, lwd=1) {
  if (title) {
    face <- "bold"
    cex <- 0.8
  } else {
    face <- "plain"
    cex <- 0.8
  }
  pushViewport(viewport(layout.pos.row=row,
                         layout.pos.col=col))
  if (box)
    grid.roundRect(w=unit(0.82, "inches"), h=unit(1.2, "lines"),
                   r=unit(0.2, "snpc"), 
                   gp=gpar(col=tcol, lwd=lwd, fill=fill))
  grid.text(label, gp=gpar(fontface=face, cex=cex, col=tcol))
  popViewport()
}

arrow <- function(row1, col1, row2, col2, col="black") {
  pushViewport(viewport(layout.pos.row=row1,
                         layout.pos.col=col1))
  grid.move.to(x=0.5, y=unit(0.5, "npc") - unit(0.6, "lines"))
  popViewport()
  pushViewport(viewport(layout.pos.row=row2,
                         layout.pos.col=col2))
  grid.arrows(grob=lineToGrob(x=0.5,
                y=unit(0.5, "npc") + unit(0.6, "lines")),
              angle=10, type="closed", 
              length=unit(0.15, "inches"), gp=gpar(col=col, fill=col))
  popViewport()
} 

pushViewport(viewport(width=unit(4.9, "inches"),
                      layout=grid.layout(7, 5,
                         heights=unit(c(3,.7,3,.7,2,.7,3),
                           c("lines", "inches",
                             "lines", "inches",
                             "lines", "inches",
                             "lines")))
                       ))

pushViewport(viewport(layout.pos.row=1,
                       layout.pos.col=2:5))
grid.roundRect(gp=gpar(lty="dashed"), r=unit(0.1, "snpc"))
popViewport()

label("Graphics\nPackages", 1, 1, title=TRUE, box=FALSE)
label("lattice", 1, 4, lwd=3, fill="grey80")
label("...", 1, 5)
label("maps", 1, 2)
label("...", 1, 3)
arrow(1, 2, 3, 3)
arrow(1, 3, 3, 3)
arrow(1, 4, 3, 4)
arrow(1, 5, 3, 4)

pushViewport(viewport(layout.pos.row=3,
                       layout.pos.col=2:5))
grid.roundRect(gp=gpar(lty="dashed"), r=unit(0.1, "snpc"))
popViewport()

label("Graphics\nSystems", 3, 1, title=TRUE, box=FALSE)
label("graphics", 3, 3, lwd=3, fill="grey80")
label("grid", 3, 4, lwd=3, fill="grey80")
arrow(3, 3, 5, 3:4)
arrow(3, 4, 5, 3:4)

label("Graphics\nEngine\n&\nDevices", 5, 1, title=TRUE, box=FALSE)
label("grDevices", 5, 3:4, lwd=3, fill="grey80")
# arrow(5, 3:4, 7, 2)
# arrow(5, 3:4, 7, 3)
# arrow(5, 3:4, 7, 4)
# arrow(5, 3:4, 7, 5)

pushViewport(viewport(layout.pos.row=7,
                       layout.pos.col=2:5))
grid.roundRect(gp=gpar(lty="dashed"), r=unit(0.1, "snpc"))
popViewport()

label("Graphics\nDevice\nPackages", 7, 1, title=TRUE, box=FALSE)
label("gtkDevice", 7, 3)
label("...", 7, 4)
      
popViewport()