网格包的一些乐趣
如果我们了解视口的概念，使用 grid 包的工作真的很简单。一旦我们得到它，我们可以做很多有趣的事情。例如，困难是绘制年龄的多边形。stickBoy 和stickGirl 只是为了搞笑，你可以跳过它。
set.seed (123)
xvar <- round (rnorm (100, 54, 10), 0)
xyvar <- round (rnorm (100, 54, 10), 0)
myd <- data.frame (xvar, xyvar)
valut <- as.numeric (cut(c(myd$xvar,myd$xyvar), 12))
myd$xwt <- valut[1:100]
myd$xywt <- valut[101:200]
xy.pop <- data.frame (table (myd$xywt))
xx.pop <- data.frame (table (myd$xwt))
stickBoy <- function() {
grid.circle(x=.5, y=.8, r=.1, gp=gpar(fill="red"))
grid.lines(c(.5,.5), c(.7,.2)) # vertical line for body
grid.lines(c(.5,.6), c(.6,.7)) # right arm
grid.lines(c(.5,.4), c(.6,.7)) # left arm
grid.lines(c(.5,.65), c(.2,0)) # right leg
grid.lines(c(.5,.35), c(.2,0)) # left leg
grid.lines(c(.5,.5), c(.7,.2)) # vertical line for body
grid.text(x=.5,y=-0.3,label ='Male',
gp =gpar(col='white',fontface=2,fontsize=32)) # vertical line for body
}
stickGirl <- function() {
grid.circle(x=.5, y=.8, r=.1, gp=gpar(fill="blue"))
grid.lines(c(.5,.5), c(.7,.2)) # vertical line for body
grid.lines(c(.5,.6), c(.6,.7)) # right arm
grid.lines(c(.5,.4), c(.6,.7)) # left arm
grid.lines(c(.5,.65), c(.2,0)) # right leg
grid.lines(c(.5,.35), c(.2,0)) # left leg
grid.lines(c(.35,.65), c(0,0)) # horizontal line for body
grid.text(x=.5,y=-0.3,label ='Female',
gp =gpar(col='white',fontface=2,fontsize=32)) # vertical line for body
}
xscale <- c(0, max(c(xx.pop$Freq,xy.pop$Freq)))* 5
levels <- nlevels(xy.pop$Var1)
barYscale<- xy.pop$Var1
vp <- plotViewport(c(5, 4, 4, 1),
yscale = range(0:levels)*1.05,
xscale =xscale)
pushViewport(vp)
grid.yaxis(at=c(1:levels))
pushViewport(viewport(width = unit(0.5, "npc"),just='right',
xscale =rev(xscale)))
grid.xaxis()
popViewport()
pushViewport(viewport(width = unit(0.5, "npc"),just='left',
xscale = xscale))
grid.xaxis()
popViewport()
grid.grill(gp=gpar(fill=NA,col='white',lwd=3),
h = unit(seq(0,levels), "native"))
grid.rect(gp=gpar(fill=rgb(0,0.2,1,0.5)),
width = unit(0.5, "npc"),just='right')
grid.rect(gp=gpar(fill=rgb(1,0.2,0.3,0.5)),
width = unit(0.5, "npc"),just=c('left'))
vv.xy <- xy.pop$Freq
vv.xx <- c(xx.pop$Freq,0)
grid.polygon(x = unit.c(unit(0.5,'npc')-unit(vv.xy,'native'),
unit(0.5,'npc')+unit(rev(vv.xx),'native')),
y = unit.c(unit(1:levels,'native'),
unit(rev(1:levels),'native')),
gp=gpar(fill=rgb(1,1,1,0.8),col='white'))
grid.grill(gp=gpar(fill=NA,col='white',lwd=3,alpha=0.8),
h = unit(seq(0,levels), "native"))
popViewport()
## some fun here
vp1 <- viewport(x=0.2, y=0.75, width=0.2, height=0.2,gp=gpar(lwd=2,col='white'),angle=30)
pushViewport(vp1)
stickBoy()
popViewport()
vp1 <- viewport(x=0.9, y=0.75, width=0.2, height=0.2,,gp=gpar(lwd=2,col='white'),angle=330)
pushViewport(vp1)
stickGirl()
popViewport()
