1引言
当你熟练使用 grid 的基础函数绘制一些简单的图形以后,也许你可能需要创建一些稍微高级一些的复杂图形方便像 grid.(rect/point) 类似的来调用。最简单的方式就是将这些 grid.rect/rectGrob 等函数打包成一个函数来使用就好。目前我就是这样干的,确实直接方便快捷,但是如果你想让别人使用你的函数,并且能够像 grid 那样的操作来修改你函数的输出时,更严谨的来说,你需要构建一个 grob 对象,并且拥有一些相关的属性。后面我们可以使用 grid.edit 等函数对其中的元素进行修改。我们看看如何自己重新构建一个 grob 对象。
参考链接:
Writing grid Extensions
- https://www.stat.auckland.ac.nz/~paul/Reports/CustomGrobs/custom-grob.html)
2简单函数包装
我们使用 grid.roundrect, grid.text 两个函数,打包起来绘制一个带有边框的文字:
library(grid)
textbox <- function(label) {
grid.roundrect(width=1.5*stringWidth(label),
height=1.5*stringHeight(label),
name="box")
grid.text(label, name="text")
}
grid.newpage()
textbox("test")
该图形含有两个 grobs,但是这两个 grobs 并没有任何联系:
grid.ls(fullNames=TRUE)
# roundrect[box]
# text[text]比如我们修改标签,可以看到文字超出了边框的范围:
grid.edit("text", label="hello world")
这时候我们可以构建一个 gTree 来包含它们:
textbox <- function(label) {
rr <- roundrectGrob(
width=1.5*stringWidth(label),
height=1.5*stringHeight(label),
name="box")
tg <- textGrob(label, name="text")
grid.draw(gTree(children=gList(rr,tg),
name="tb"))
}
grid.newpage()
textbox("test")
这时候我们查看元素组成时,可以看到有一个 gTree 包含了两个 grob:
grid.ls(fullNames=TRUE)
# gTree[tb]
# roundrect[box]
# text[text]但是当我们修改文字时,边框依然不变:
grid.edit("tb::text", label="hello world")
3drawDetails 方法
我们可以延迟画图的行为,在图形生成之前就计算好边框的大小,我们首先构建一个 grob 对象:
textbox <- function(label,
name=NULL, gp=NULL, vp=NULL) {
grid.draw(grob(label=label,
name=name, gp=gp, vp=vp,
cl="textbox"))
}然后我们为 textbox 这个 grob 类定义 drawDetails 方法,来说明如果绘制图形:
drawDetails.textbox <- function(x, ...) {
grid.roundrect(
width=1.5*stringWidth(x$label),
height=1.5*stringHeight(x$label),
name="box")
grid.text(x$label, name="text")
}画图:grid.newpage()
textbox("test", name="tb")
现在只含有一个 textbox, 其中包含的 grob 不再可见:grid.ls(fullNames=TRUE)
# textbox[tb]
这时候修改标签,边框也变大了:grid.edit("tb", label="hello world")
修改元素:grid.edit("tb", gp=gpar(col="grey"))
你可以看到,标签和文本的颜色都改变了。
4makeContent 方法
makeContent 是另外一种开发自定义 grob 的办法,与 drawDetails 不同的是, 它是调用 grid 的函数来生成 grob,而不是直接画出来,下面我们举例说明:
构建 grob 还是一样的代码:
textbox <- function(label,
name=NULL, gp=NULL, vp=NULL) {
grid.draw(gTree(label=label,
name=name, gp=gp, vp=vp,
cl="textboxtree"))
}添加 makeContent 方法:
makeContent.textboxtree <- function(x) {
t <- textGrob(x$label,
name="text")
rr <- roundrectGrob(width=1.5*grobWidth(t),
height=1.5*grobHeight(t),
name="box")
setChildren(x, gList(rr,t))
}
grid.newpage()
textbox("test", name="tbt")
查看元素组成:
grid.ls(fullNames=TRUE)
# textboxtree[tbt]修改标签:
grid.edit("tbt", label="hello world")
grid.force 可以展示所有包含的 grobs:
grid.force()
grid.ls(fullNames=TRUE)
# forcedgrob[tbt]
# forcedgrob[box]
# text[text]5makeContext 方法
makeContext 可以在绘图时产生一个或多个视图 viewport,grid 会自动负责 push 视图并之后进行清理。
textbox <- function(label,
name=NULL, gp=NULL, vp=NULL) {
grid.draw(gTree(label=label,
name=name, gp=gp, vp=vp,
cl="textboxtree"))
}
makeContext.textboxtree <- function(x) {
tbvp <-
viewport(width=1.5*stringWidth(x$label),
height=1.5*stringHeight(x$label))
if (is.null(x$vp))
x$vp <- tbvp
else
x$vp <- vpStack(x$vp, tbvp)
x
}
makeContent.textboxtree <- function(x) {
t <- textGrob(x$label, name="text")
rr <- roundrectGrob(name="box")
setChildren(x, gList(rr,t))
}这里我们使用 makeContext 方法来给图形添加一个 viewport 视图,大小和边框一样大。所以我们后面makeContent 方法绘制矩形边框时就不需要再指定大小了。
grid.newpage()
textbox("test", name="tbt")
6实战
前面为了弥补 grid 默认 grid.xaxis/grid.yaxis 的不足,我自己重新写了这两个函数 听说你要手搓一个 grid.xaxis2/grid.yaxis2? ,所用的方法也就是简单函数包装一下, 这次我们使用学到的知识,对其重新构建一个 grob 对象,我们举例拿 grid.xaxis2 举例。
原函数:
grid.xaxis2 <- function(at = NULL,
breaks = 5,
labels = NULL,
tick.len = 0.5,
label.space = 0.5,
side = c("bottom","top"),
rot = 0,
label.size = 12){
# labels and ticks
if(is.null(at) || is.null(labels)){
at <- grid.pretty(current.viewport()$xscale,n = 5)
labels <- as.character(at)
}else{
at <- at
labels <- as.character(labels)
}
# axis position
side <- match.arg(side,c("bottom","top"))
if(side == "bottom"){
tck.y0 = unit(0, "npc")
tck.y1 = unit(-tick.len, "lines")
text.y = unit(-tick.len - label.space,"lines")
}else{
tck.y0 = unit(1, "npc")
tck.y1 = unit(1, "npc") + unit(tick.len, "lines")
text.y = unit(abs(tick.len) + abs(label.space),"lines") + unit(1, "npc")
}
grid.segments(x0 = 0,x1 = 1,y0 = 0,y1 = 0)
grid.segments(x0 = unit(at, "native"),
x1 = unit(at, "native"),
y0 = tck.y0,
y1 = tck.y1)
grid.text(label = labels,
x = unit(at, "native"),
y = text.y,
rot = rot,
gp = gpar(fontsize = label.size))
}构建 grob 对象
grid.xaxis2 <- function(at = NULL,
breaks = 5,
labels = NULL,
tick.len = 0.5,
label.space = 0.5,
side = c("bottom","top"),
rot = 0,
ticks.gp = NULL,
text.gp = NULL,
hjust = NULL,
vjust = NULL,
name = NULL, gp = NULL, vp = NULL) {
gTree(at = NULL,
breaks = 5,
labels = NULL,
tick.len = 0.5,
label.space = 0.5,
side = c("bottom","top"),
rot = 0,
ticks.gp = NULL,
text.gp = NULL,
hjust = NULL,
vjust = NULL,
name = name, gp = gp, vp = vp,
cl = "xaxis2")
}添加 makeContent.xaxis2 方法
具体如何绘制坐标轴:
makeContent.xaxis2 <- function(x) {
# labels and ticks
if(is.null(x$at) || is.null(x$labels)){
if(is.null(x$vp)){
at <- grid.pretty(current.viewport()$xscale,n = x$breaks)
}else{
at <- grid.pretty(x$vp$xscale,n = x$breaks)
}
labels <- as.character(at)
}else{
at <- x$at
labels <- as.character(x$labels)
}
# axis position
side <- match.arg(x$side,c("bottom","top"))
if(side == "bottom"){
tck.y0 = unit(0, "npc")
tck.y1 = unit(-x$tick.len, "lines")
text.y = unit(-x$tick.len - x$label.space,"lines")
}else{
tck.y0 = unit(1, "npc")
tck.y1 = unit(1, "npc") + unit(x$tick.len, "lines")
text.y = unit(abs(x$tick.len) + abs(x$label.space),"lines") + unit(1, "npc")
}
seg.main <- segmentsGrob(x0 = 0,x1 = 1,y0 = 0,y1 = 0,name = "main")
ticks <- segmentsGrob(x0 = unit(at, "native"),x1 = unit(at, "native"),
y0 = tck.y0,y1 = tck.y1,
gp = x$ticks.gp,name = "ticks")
text <- textGrob(label = labels,
x = unit(at, "native"),y = text.y,
rot = x$rot,
hjust = x$hjust,vjust = x$vjust,
gp = x$text.gp,name = "labels")
setChildren(x, gList(seg.main,ticks,text))
}测试
既然已经构建好了,我们下面来测试工作效果如何:
grid.newpage()
pushViewport(viewport(width = 0.5,height = 0.5,xscale = c(0,10)))
grid.rect()
grid.draw(grid.xaxis2())
grid.newpage()
grid.draw(grid.xaxis2(vp = viewport(xscale = c(0,10),width = 0.5,height = 0.5)))
查看组成:
grid.ls()
# GRID.xaxis2.8850
grid.force()
grid.ls()
# GRID.xaxis2.8823
# main
# ticks
# labels编辑元素:
grid.edit("main", gp = gpar(lwd = 5,col = "red"))
grid.edit("ticks", gp = gpar(col = "blue"))
grid.edit("labels", gp = gpar(fontface = "bold.italic",rot = 45))
7结尾
路漫漫其修远兮,吾将上下而求索。
欢迎加入生信交流群。加我微信我也拉你进 微信群聊 老俊俊生信交流群 (微信交流群需收取 20 元入群费用,一旦交费,拒不退还!(防止骗子和便于管理)) 。QQ 群可免费加入, 记得进群按格式修改备注哦。
声明：文中观点不代表本站立场。本文传送门：https://eyangzhen.com/359563.html
