在用ggplot2画图的过程中我们经常会用一些basic plot 功能，用grid实现会很方便，但是ggplot2和grid好像有不太兼容，如何才能做到大一统，为你我所用呢？

针对这种情况，Paul Murrel大神开发了R包gggrid，将grid的常用功能融合到了ggplot2中。

知识点

npc : Normalised Parent Coordinates, 规范化的父区域坐标，gird中的默认单位。

核心图：

核心函数：

• grid_panel()
• grid_group()

1. R包下载及安装

Google或Bing搜素gggrid it's g-g-great! Accessing grid from ggplot2，便可以发现gggrid的简介，翻到底部，找到这个：

再转到github的，下载tar.gz文件

本地安装

install.packages("./gggrid-0.1-0.tar.gz",repos = NULL,type = "source")

2.示例1

添加一个长方形到ggplot2绘图中

library(gggrid)
grad <- radialGradient(c("transparent", "black"), r2=.6)
ggplot(mtcars) +
  geom_point(aes(disp, mpg)) +
  grid_panel(rectGrob(gp=gpar(fill=grad)))

不知道为啥，我的画出来没有那种径向的感觉。

3.示例2:精确定位的label

首先生成一个textGrob对象

label <- textGrob("Label",
                  x=unit(1, "npc") - unit(5, "mm"),
                  y=unit(1, "npc") - unit(5, "mm"),
                  just=c("right", "top"))

先简单的画一画

grid.rect()
grid.draw(label)

他就这么静静的出现在你的figure里。接下来，将label添加到你的figure中，有两种方式：

# 方式一
ggplot(mtcars) +
  geom_point(aes(disp, mpg)) +
  annotation_custom(label)

# 方式二
ggplot(mtcars, aes(disp, mpg)) +
    geom_point() +
    grid_panel(label)

来个复杂点的操作：

bg <- rectGrob(gp=gpar(fill="firebrick3")) #背景色
lab <- textGrob("mtcars",gp=gpar(col="white")) #字体颜色
vp <- viewport(x=1,y=1,width = .2,height = unit(1.5,"lines"),
               just=c("right","top")) #展示区域大小
banner <- gTree(children = gList(bg,lab),vp=vp)
ggplot(mtcars,aes(disp,mpg))+
  geom_point()+
  grid_panel(banner)

需要注意的是，及时我们只提供一个空的长方形（宽边框），默认情况下，它仍然是和窗口完美匹配的。

rect <- rectGrob(gp=gpar(fill=NA,lwd=7))
ggplot(mtcars,aes(disp,mpg))+
  geom_point()+
  grid_panel(rect)

还可以直接根据x,y轴的最大和最小值设置边框

rectFun <- function(data,coords){
  left=min(coords$x)
  bottom=min(coords$y)
  width=diff(range(coords$x))
  height=diff(range(coords$y))
  rectGrob(left,bottom,width,height,
           just=c("left","bottom"),
           gp=gpar(fill=NA,lwd=1))
}
ggplot(mtcars,aes(disp,mpg))+
  geom_point()+
  grid_panel(rectFun)

注意：grid_panel()和grid_group()都有debug参数，可以用来监测传递给grob功能的值。

debugHead <- function(data,coords){
  print(head(data))
  print(head(coords))
}
ggplot(mtcars,aes(disp,mpg))+
  geom_point()+
  grid_panel(debug=debugHead)

3.示例3：边际地毯图

rug <- function(data,coords){
  segmentsGrob(unit(1,"npc"),
               coords$y,
               unit(1,"npc")-unit(2,"mm"),
               coords$y,
               gp=gpar(lwd=2,col="firebrick3"))
}
ggplot(mtcars,aes(disp,mpg))+
  geom_point()+
  grid_panel(rug)

分面

mtcars$manual <- ifelse(mtcars$am==0,"FALSE","TRUE")
mtcars$manual <- factor(mtcars$manual,levels= c("FALSE","TRUE"))
ggplot(mtcars,aes(disp,mpg))+
  geom_point()+
  facet_wrap("manual")+
  grid_panel(rug)

当然，还可以用panel_group()展示不同分组的信息

rugGroup <- function(data,coords){
  segmentsGrob(unit(1,"npc"),
               coords$y,
               unit(1,"npc")-unit(2,"mm"),
               coords$y,
               gp=gpar(lwd=2,col=adjustcolor(data$colour,alpha=.5)))
}
ggplot(mtcars,aes(disp,mpg,color=manual))+
  geom_point()+
  grid_group(rugGroup)

同样的，也可以应用debug功能，展示不同的数值

ggplot(mtcars,aes(disp,mpg,color=manual))+
  geom_point()+
  grid_panel(stat = "smooth",debug = debugHead)

示例4：回归方程

addLabel <- function(data,coords){
  label=expression(y==alpha+beta*x+epsilon) #输入的公式
  xpos=which(coords$x>.5)[1]
  dx=convertWidth(unit(diff(coords$x[1:2]),"npc"),"in",valueOnly = T)
  dy=convertHeight(unit(diff(coords$y[1:2]),"npc"),"in",valueOnly = T)
  angle = 180*atan2(dy,dx)/pi
  textGrob(label,
           x=unit(coords$x[xpos],"npc"),
           y=unit(coords$y[xpos],"npc")+unit(3,"mm"),
           rot = angle,
           gp=gpar(col=2))
}
ggplot(mtcars,aes(disp,mpg))+
  geom_point()+
  geom_smooth(method = "lm",colour=2)+
  grid_panel(addLabel,stat="smooth",method="lm")

示例5：post-hoc修改

marker <- function(data,coords){
  nullGrob(coords$x[which.max(coords$y)],
           max(coords$y),
           name = "mark")
}
g <- ggplot(mtcars,aes(disp,mpg))+
  geom_point()+
  facet_wrap("manual")+
  grid_panel(marker)+
  coord_cartesian(clip = "off")

grid.newpage()
pushViewport(viewport(y=0,
                      height = unit(1,"npc")-unit(2,"lines"),
             just="bottom",
             name="ggplot"))
plot(g,newpage = F)
upViewport()             
grid.force()
markers <- grid.grep("mark",global = T,viewports = T)
text <- textGrob("most.efficient",
                 x=unit(1,"lines"),
                 y=unit(1,"npc")-unit(1,"lines"),
                 just = c("left","top"))
grid.draw(text)
drawLine <- function(x){
  depth=downViewport(attr(x,"vpPath"))
  m=grid.get(x)
  loc=deviceLoc(m$x,m$y)
  upViewport(depth)
  grid.curve(grobX(text,0),grobY(text,0),
             loc$x,loc$y,
             square=F,curvature=-.5,angle=45,ncp=4,
             arrow=arrow(length = unit(3,"mm"),angle=20,type="closed"),
             gp=gpar(col="firebrick3",fill="firebrick3"))
}
lapply(markers, drawLine)

不禁由衷发出感叹，grid包真强大！gggrid更强大！
参考链接：
gggrid的github主页（还是不放链接了，要不然又要被锁定。有兴趣自行查阅原文吧）