使用ggplot2，geofacet我想用矩形勾勒出一些面的轮廓。我想我可以在使用软件包将图像保存为 .png 或 .jpg 后将其绘制到磁盘上magick，但我更喜欢采用更编程的方法，仅使用ggplot2（如果有任何变化，矩形仍然处于良好的位置）。
下面是来自该软件包插图的一些代码。
library("ggplot2")
library("geofacet")
ggplot(aus_pop, aes(age_group, pop / 1e6, fill = age_group)) +
geom_col() +
facet_geo(~ code, grid = "aus_grid1") +
coord_flip() +
labs(
title = "Australian Population Breakdown",
caption = "Data Source: ABS Labour Force Survey, 12 month average",
y = "Population [Millions]") +
theme_bw()
期望的结果如下（但更漂亮）：
欢迎提出任何建议！剧情区外有良好团体背景的版本也可以接受。
3
最佳答案
2
您可以使用库grid和来做到这一点gtable。
首先，绘制图表并将其转换为 gtable。然后使用gtable_show_layout()以可视化方式显示网格并获取行/列号：
library("ggplot2")
library("geofacet")
library("gtable")
library("grid")
# Make the plot
plt <- ggplot(aus_pop, aes(age_group, pop / 1e6, fill = age_group)) +
geom_col() +
facet_geo(~ code, grid = "aus_grid1") +
coord_flip() +
labs(
title = "Australian Population Breakdown",
caption = "Data Source: ABS Labour Force Survey, 12 month average",
y = "Population [Millions]") +
theme_bw()
# Turn it into a gtable
gtab <- get_geofacet_grob(plt) # Normally you'd use ggplotGrob(plt), but geofacet is different
# See the gtable layout visually
gtable_show_layout(gtab)
接下来，为 TAS 制作紫色矩形：
purplerect <- polygonGrob(x=c(0,0,1,1), y=c(0,1,1,0),name='purplerect',gp=gpar(fill='purple',alpha=0.25))
grid.draw(gtable_add_grob(gtab,purplerect,t=28,l=15,b=30,r=16))
但是您可能希望它稍微超出绘图区域作为背景或边框，因此您可以将坐标移出 (0,1) 范围并clip='off'使用gtable_add_grob()：
purplerect <- polygonGrob(x=c(-0.02,-0.02,1.02,1.02), y=c(-0.02,1.02,1.02,-0.02),name='purplerect',gp=gpar(fill='purple',alpha=0.25))
grid.draw(gtable_add_grob(gtab,purplerect,t=28,l=15,b=30,r=16,clip='off'))
仍然使用 TAS 进行演示，您也可以将其设为轮廓而不是阴影区域。我仍然将 alpha（不透明度）保持在 0.5，因此当它与绘图轴刻度之类的东西重叠时，您仍然可以看到它下面的内容：
purplerect <- polygonGrob(x=c(-0.02,-0.02,1.02,1.02), y=c(-0.02,1.02,1.02,-0.02),name='purplerect',gp=gpar(fill=NA,col='purple',alpha=0.5,lwd=3))
grid.draw(gtable_add_grob(gtab,purplerect,t=28,l=15,b=30,r=16,clip='off'))
以下是整个剧情的实现：
purplerect <- polygonGrob(x=c(-0.02,-0.02,1.02,1.02), y=c(-0.02,1.02,1.02,-0.02),name='purplerect',gp=gpar(fill=NA,col='purple',alpha=0.5,lwd=5))
bluerect <- polygonGrob(x=c(-0.01,-0.01,1.01,1.01), y=c(-0.02,1.02,1.02,-0.02),name='bluerect',gp=gpar(fill=NA,col='blue',alpha=0.5,lwd=5))
orangerect <- polygonGrob(x=c(-0.02,-0.02,1.02,1.02), y=c(-0.01,1.01,1.01,-0.01),name='orangerect',gp=gpar(fill=NA,col='orange',alpha=0.5,lwd=5))
greenshape <- polygonGrob(x=c(0.5,0.5,1.01,1.01,-0.01,-0.01,0.5),y=c(0.5,1.01,1.01,-0.01,-0.01,0.5,0.5),name='greenshape',gp=gpar(fill=NA,col='green3',alpha=0.5,lwd=5))
step1 <- gtable_add_grob(gtab,purplerect,t=28,l=15,b=30,r=16,clip='off')
step2 <- gtable_add_grob(step1,bluerect,t=18,b=21,l=14,r=21,clip='off')
step3 <- gtable_add_grob(step2,orangerect,t=6,b=15,l=14,r=15,clip='off')
step4 <- gtable_add_grob(step3,greenshape,t=6,b=15,l=7,r=11,clip='off')
grid.draw(step4)
您还可以将 alpha 设置为 0.25 以获得更大的透明度并填充形状（我还更改了其中的蓝色阴影以防止它在半透明时看起来是紫色）：
purplerect <- polygonGrob(x=c(-0.02,-0.02,1.02,1.02), y=c(-0.02,1.02,1.02,-0.02),name='purplerect',gp=gpar(fill=NA,col='purple',alpha=0.5,lwd=5))
bluerect <- polygonGrob(x=c(-0.01,-0.01,1.01,1.01), y=c(-0.02,1.02,1.02,-0.02),name='bluerect',gp=gpar(fill=NA,col='blue',alpha=0.5,lwd=5))
orangerect <- polygonGrob(x=c(-0.02,-0.02,1.02,1.02), y=c(-0.01,1.01,1.01,-0.01),name='orangerect',gp=gpar(fill=NA,col='orange',alpha=0.5,lwd=5))
greenshape <- polygonGrob(x=c(0.5,0.5,1.01,1.01,-0.01,-0.01,0.5),y=c(0.5,1.01,1.01,-0.01,-0.01,0.5,0.5),name='greenshape',gp=gpar(fill=NA,col='green3',alpha=0.5,lwd=5))
step1 <- gtable_add_grob(gtab,purplerect,t=28,l=15,b=30,r=16,clip='off')
step2 <- gtable_add_grob(step1,bluerect,t=18,b=21,l=14,r=21,clip='off')
step3 <- gtable_add_grob(step2,orangerect,t=6,b=15,l=14,r=15,clip='off')
step4 <- gtable_add_grob(step3,greenshape,t=6,b=15,l=7,r=11,clip='off')
grid.draw(step4)
最后，您还可以使用参数来控制绘制的顺序。以下输出z显示背景的 z=0 和面板的 z=1：gtable_add_grob()head(gtab$layout)
t l b r z clip name
133 1 1 37 25 0 on background
2 15 7 15 7 1 on panel-2-1
6 10 11 10 11 1 on panel-2-2
7 15 11 15 11 1 on panel-3-2
因此，如果我们用 z=0.5 绘制形状，它们将在背景之后、面板之前绘制，面板最终将位于它们之上。这意味着我们可以通过填充这些网格方块来遮蔽面板之外的绘图区域（因为它们是透明的/没有背景）：
purplerect <- polygonGrob(x=c(0,0,1,1), y=c(0,1,1,0),name='purplerect',gp=gpar(fill='purple',col=NA,alpha=0.25))
bluerect <- polygonGrob(x=c(0,0,1,1), y=c(0,1,1,0),name='bluerect',gp=gpar(fill='deepskyblue2',col=NA,alpha=0.25))
halfblue <- polygonGrob(x=c(0.5,0.5,1,1), y=c(0,1,1,0),name='halfblue',gp=gpar(fill='deepskyblue2',col=NA,alpha=0.25))
orangerect <- polygonGrob(x=c(0,0,1,1), y=c(0,1,1,0),name='orangerect',gp=gpar(fill='orange',col=NA,alpha=0.25))
greenrect <- polygonGrob(x=c(0,0,1,1), y=c(0,1,1,0),name='greenrect',gp=gpar(fill='green3',col=NA,alpha=0.25))
# For ones with y-axes, make additional rectangles that will only fill the right half of those squares
halfpurple <- polygonGrob(x=c(0.5,0.5,1,1), y=c(0,1,1,0),name='halfpurple',gp=gpar(fill='purple',col=NA,alpha=0.25))
halfblue <- polygonGrob(x=c(0.5,0.5,1,1), y=c(0,1,1,0),name='halfblue',gp=gpar(fill='deepskyblue2',col=NA,alpha=0.25))
halfgreen <- polygonGrob(x=c(0.5,0.5,1,1), y=c(0,1,1,0),name='halfgreen',gp=gpar(fill='green3',col=NA,alpha=0.25))
# Add a row between the title and the top of the plots, since the title has a white background that would cover the top of the green/orange rectangles
step0 <- gtable_add_rows(gtab,unit(5.5,'pt'),pos=3)
# Shade different squares of the grid
step1 <- gtable_add_grob(step0,purplerect,t=28,b=32,l=12,r=17,z=0.5)
step2 <- gtable_add_grob(step1,halfpurple,t=28,b=32,l=11,r=11,z=0.5)
step3 <- gtable_add_grob(step2,bluerect,t=17,b=24,l=12,r=22,z=0.5)
step4 <- gtable_add_grob(step3,halfblue,t=17,b=24,l=10,r=11,z=0.5)
step5 <- gtable_add_grob(step4,orangerect,t=4,b=19,l=12,r=17,z=0.5)
step6 <- gtable_add_grob(step5,greenrect,t=4,b=18,l=8,r=13,z=0.5)
step7 <- gtable_add_grob(step6,halfgreen,t=4,b=12,l=7,r=7,z=0.5)
step8 <- gtable_add_grob(step7,greenrect,t=13,b=18,l=6,r=7,z=0.5)
grid.draw(step8)
最后要注意的是，dev.off()在开始绘制每个新图之前，请确保您正在使用。否则，它只会继续将图绘制在彼此之上。您可能看不到它，因为背景是不透明的，但是如果您正在排除故障并制作大量测试版本，绘制图的速度会越来越慢。
1
-
太棒了！非常感谢！
–
|
使用 {grid} 的方法：
- 生成样本图
p：
library("ggplot2")
library("geofacet")
library(grid)
p <- ggplot(aus_pop, aes(age_group, pop / 1e6, fill = age_group)) +
geom_col() +
facet_geo(~ code, grid = "aus_grid1") +
coord_flip() +
labs(
title = "Australian Population Breakdown",
caption = "Data Source: ABS Labour Force Survey, 12 month average",
y = "Population [Millions]") +
theme_bw()
- 此函数采用
grob的组件p，扫描哪些stripgrobs 包含所需状态的标签，从 的表格表示 (gtable)中提取这些行p，以及 的整体布局中的列和行索引p。整体布局用于 ( )在所需状态面板占据的行/列范围周围pushViewport放置一个角度：grid.rect
draw_frame <- \(x, states, ...){
gpars <- list(...)
the_grobs <- ggplotGrob(x)
widths <- the_grobs$widths
heights <- the_grobs$heights
## adopt column/row-layout from p:
vp_top <- viewport(layout = grid.layout(
nrow = length(heights),
ncol = length(widths),
heights = heights,
widths = widths
))
pushViewport(vp_top)
## find rows defining the strips (labelling) in the gtable representation of p:
z <- Map(states, f = \(label) {
Map(the_grobs$grobs, f = \(g) length(rapply(g, f = \(x) grep(label, x))) > 0) |> unlist() |> which()
}) |> unlist()
strip_defs <- the_grobs$layout[z,]
## set viewport (drawing area) to the row- and column range occupied
## by the desired states:
pushViewport(viewport(layout.pos.col = range(strip_defs$l) + c(0, 0), # l for left
layout.pos.row = range(strip_defs$t) + c(0, 1) # t for top
))
## draw surrounding rectangle:
grid.rect(gp = gpar(z = 0, lwd = 3, col = gpars$col, fill = fill_alpha('white', 0)))
upViewport() ## zoom out to total plot area again
}
例子：
p
draw_frame(p, states = c('QLD', 'NSW'), col = 'orange')
draw_frame(p, states = c('VIC', 'ACT'), col = 'blue')
draw_frame(p, states = c('TAS'), col = 'violet')
draw_frame(p, states = c('NT', 'WA', 'SA'), col = 'green')
非矩形范围（参见 NT-WA-SA）仍存在问题，使用背景颜色可能可以更好地解决该问题。
1
-
谢谢 I_O 你指引了方向！
–
|
age_group（已经可以通过位置辨别），并且与状态组的预期颜色编码相冲突，为什么不单独或面板背景（通过geom_rect(aes(xmin = -Inf, xmax = Inf, ymin = -Inf, ymax=Inf, fill = state_group))在下方添加geom_col？–
–
–
|