eip*_*i10 16 r ggplot2 grob gtable
在具有多个构面变量的图中,ggplot2重复"外部"变量的构面标签,而不是在"内部"变量的所有级别上具有单个跨越构面条带.我有一直在使用,以覆盖与使用单个跨越小面条重复外端面标签一些代码gtable_add_grob从gtable包.
不幸的是,由于facet strip的grob结构发生了变化,此代码不再适用于ggplot2 2.2.0.具体来说,在ggplot2的早期版本中,facet标签的每一行都有自己的一组grob.但是,在版本2.2.0中,看起来每个facet标签的垂直堆栈都是单个grob.这打破了我的代码,我不知道如何解决它.
这是一个具体的例子,取自几个月前我回答的SO问题:
# Data
df = structure(list(location = structure(c(1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,
2L, 2L), .Label = c("SF", "SS"), class = "factor"), species = structure(c(1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,
2L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("AGR", "LKA"), class = "factor"),
position = structure(c(1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L,
2L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L,
1L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L,
2L), .Label = c("top", "bottom"), class = "factor"), density = c(0.41,
0.41, 0.43, 0.33, 0.35, 0.43, 0.34, 0.46, 0.32, 0.32, 0.4,
0.4, 0.45, 0.34, 0.39, 0.39, 0.31, 0.38, 0.48, 0.3, 0.42,
0.34, 0.35, 0.4, 0.38, 0.42, 0.36, 0.34, 0.46, 0.38, 0.36,
0.39, 0.38, 0.39, 0.39, 0.39, 0.36, 0.39, 0.51, 0.38)), .Names = c("location",
"species", "position", "density"), row.names = c(NA, -40L), class = "data.frame")
# Begin with a regular ggplot with three facet levels
p=ggplot(df, aes("", density)) +
geom_boxplot(width=0.7, position=position_dodge(0.7)) +
theme_bw() +
facet_grid(. ~ species + location + position) +
theme(panel.margin=unit(0,"lines"),
strip.background=element_rect(color="grey30", fill="grey90"),
panel.border=element_rect(color="grey90"),
axis.ticks.x=element_blank()) +
labs(x="")
Run Code Online (Sandbox Code Playgroud)
我们从一个有三个层面的情节开始.
现在我们将覆盖带有跨越条带的顶部两个小平面条带,这样我们就不会有重复的条带标签:
pg = ggplotGrob(p)
# Add spanning strip labels for species
pos = c(4,11)
for (i in 1:2) {
pg <- gtable_add_grob(pg,
list(rectGrob(gp=gpar(col="grey50", fill="grey90")),
textGrob(unique(densityAGRLKA$species)[i],
gp=gpar(cex=0.8))), t=3,l=pos[i],b=3,r=pos[i]+7,
name=c("a","b"))
}
# Add spanning strip labels for location
pos=c(4,7,11,15)
for (i in 1:4) {
pg = gtable_add_grob(pg,
list(rectGrob(gp = gpar(col="grey50", fill="grey90")),
textGrob(rep(unique(densityAGRLKA$location),2)[i],
gp=gpar(cex=0.8))), t=4,l=pos[i],b=4,r=pos[i]+3,
name = c("c","d"))
}
grid.draw(pg)
Run Code Online (Sandbox Code Playgroud)
这是ggplot2 2.1.0的情节:
但是,如果我使用ggplot2 2.2.0尝试相同的代码,我会返回原始图表,不会更改条带标签.看一下原始情节的grob结构,可以看出p为什么会这样.我已经粘贴在这个问题底部的grob表中.为了节省空间,我只包括与小平面条相关的行.
查看该cells列,请注意,在2.1.0版本的图中,每行中的前两个数字为3,4或5,表示grob相对于图中其他grob的垂直位置.在上面的代码中,t和l参数gtable_add_grob设置为3或4的值,因为这些是我想用跨越条覆盖的小平面条行.
现在看一下cells2.2.0版本图中的列:注意前两个数字总是6.还要注意,在2.1.0版本中,facet条仅包含8个grobs而不是24个.在版本2.2.0中,似乎每个堆栈的三个构面标签现在是单个grob而不是三个单独的grob.所以,即使我改变t和b论据gtable_add_grob6,所有三个小条覆盖.这是一个例子:
pg = ggplotGrob(p)
# Add spanning strip labels for species
pos = c(4,11)
for (i in 1:2) {
pg <- gtable_add_grob(pg,
list(rectGrob(gp=gpar(col="grey50", fill="grey90")),
textGrob(unique(densityAGRLKA$species)[i],
gp=gpar(cex=0.8))), t=6,l=pos[i],b=6,r=pos[i]+7,
name=c("a","b"))
}
Run Code Online (Sandbox Code Playgroud)
所以,在那个非常冗长的介绍之后,这里是我的问题:如何使用ggplot2版本2.2.0创建跨越小平面条带,看起来像我使用gtable_add_grobggplot2版本2.1.0 创建的那些?我希望有一个简单的调整,但如果它需要大手术,那么,这也没关系.
ggplot 2.1.0
pg
Run Code Online (Sandbox Code Playgroud)
Run Code Online (Sandbox Code Playgroud)TableGrob (9 x 19) "layout": 45 grobs z cells name grob 2 1 ( 3- 3, 4- 4) strip-top absoluteGrob[strip.absoluteGrob.147] 3 2 ( 4- 4, 4- 4) strip-top absoluteGrob[strip.absoluteGrob.195] 4 3 ( 5- 5, 4- 4) strip-top absoluteGrob[strip.absoluteGrob.243] 5 4 ( 3- 3, 6- 6) strip-top absoluteGrob[strip.absoluteGrob.153] 6 5 ( 4- 4, 6- 6) strip-top absoluteGrob[strip.absoluteGrob.201] 7 6 ( 5- 5, 6- 6) strip-top absoluteGrob[strip.absoluteGrob.249] 8 7 ( 3- 3, 8- 8) strip-top absoluteGrob[strip.absoluteGrob.159] 9 8 ( 4- 4, 8- 8) strip-top absoluteGrob[strip.absoluteGrob.207] 10 9 ( 5- 5, 8- 8) strip-top absoluteGrob[strip.absoluteGrob.255] 11 10 ( 3- 3,10-10) strip-top absoluteGrob[strip.absoluteGrob.165] 12 11 ( 4- 4,10-10) strip-top absoluteGrob[strip.absoluteGrob.213] 13 12 ( 5- 5,10-10) strip-top absoluteGrob[strip.absoluteGrob.261] 14 13 ( 3- 3,12-12) strip-top absoluteGrob[strip.absoluteGrob.171] 15 14 ( 4- 4,12-12) strip-top absoluteGrob[strip.absoluteGrob.219] 16 15 ( 5- 5,12-12) strip-top absoluteGrob[strip.absoluteGrob.267] 17 16 ( 3- 3,14-14) strip-top absoluteGrob[strip.absoluteGrob.177] 18 17 ( 4- 4,14-14) strip-top absoluteGrob[strip.absoluteGrob.225] 19 18 ( 5- 5,14-14) strip-top absoluteGrob[strip.absoluteGrob.273] 20 19 ( 3- 3,16-16) strip-top absoluteGrob[strip.absoluteGrob.183] 21 20 ( 4- 4,16-16) strip-top absoluteGrob[strip.absoluteGrob.231] 22 21 ( 5- 5,16-16) strip-top absoluteGrob[strip.absoluteGrob.279] 23 22 ( 3- 3,18-18) strip-top absoluteGrob[strip.absoluteGrob.189] 24 23 ( 4- 4,18-18) strip-top absoluteGrob[strip.absoluteGrob.237] 25 24 ( 5- 5,18-18) strip-top absoluteGrob[strip.absoluteGrob.285]
ggplot2 2.2.0
pg
Run Code Online (Sandbox Code Playgroud)
Run Code Online (Sandbox Code Playgroud)TableGrob (11 x 21) "layout": 42 grobs z cells name grob 28 2 ( 6- 6, 4- 4) strip-t-1 gtable[strip] 29 2 ( 6- 6, 6- 6) strip-t-2 gtable[strip] 30 2 ( 6- 6, 8- 8) strip-t-3 gtable[strip] 31 2 ( 6- 6,10-10) strip-t-4 gtable[strip] 32 2 ( 6- 6,12-12) strip-t-5 gtable[strip] 33 2 ( 6- 6,14-14) strip-t-6 gtable[strip] 34 2 ( 6- 6,16-16) strip-t-7 gtable[strip] 35 2 ( 6- 6,18-18) strip-t-8 gtable[strip]
San*_*att 13
实际上,ggplot2 v2.2.0逐列构造复杂的条带,每列都是一个grob.这可以通过提取一个条带然后检查其结构来检查.使用你的情节:
library(ggplot2)
library(gtable)
library(grid)
# Your data
df = structure(list(location = structure(c(1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,
2L, 2L), .Label = c("SF", "SS"), class = "factor"), species = structure(c(1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,
2L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("AGR", "LKA"), class = "factor"),
position = structure(c(1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L,
2L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L,
1L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L,
2L), .Label = c("top", "bottom"), class = "factor"), density = c(0.41,
0.41, 0.43, 0.33, 0.35, 0.43, 0.34, 0.46, 0.32, 0.32, 0.4,
0.4, 0.45, 0.34, 0.39, 0.39, 0.31, 0.38, 0.48, 0.3, 0.42,
0.34, 0.35, 0.4, 0.38, 0.42, 0.36, 0.34, 0.46, 0.38, 0.36,
0.39, 0.38, 0.39, 0.39, 0.39, 0.36, 0.39, 0.51, 0.38)), .Names = c("location",
"species", "position", "density"), row.names = c(NA, -40L), class = "data.frame")
# Your ggplot with three facet levels
p=ggplot(df, aes("", density)) +
geom_boxplot(width=0.7, position=position_dodge(0.7)) +
theme_bw() +
facet_grid(. ~ species + location + position) +
theme(panel.spacing=unit(0,"lines"),
strip.background=element_rect(color="grey30", fill="grey90"),
panel.border=element_rect(color="grey90"),
axis.ticks.x=element_blank()) +
labs(x="")
# Get the ggplot grob
pg = ggplotGrob(p)
# Get the left most strip
index = which(pg$layout$name == "strip-t-1")
strip1 = pg$grobs[[index]]
# Draw the strip
grid.newpage()
grid.draw(strip1)
# Examine its layout
strip1$layout
gtable_show_layout(strip1)
Run Code Online (Sandbox Code Playgroud)
获得外部条带标签"跨越"内部标签的一种粗略方法是从头开始构造条带:
# Get the strips, as a list, from the original plot
strip = list()
for(i in 1:8) {
index = which(pg$layout$name == paste0("strip-t-",i))
strip[[i]] = pg$grobs[[index]]
}
# Construct gtable to contain the new strip
newStrip = gtable(widths = unit(rep(1, 8), "null"), heights = strip[[1]]$heights)
## Populate the gtable
# Top row
for(i in 1:2) {
newStrip = gtable_add_grob(newStrip, strip[[4*i-3]][1],
t = 1, l = 4*i-3, r = 4*i)
}
# Middle row
for(i in 1:4){
newStrip = gtable_add_grob(newStrip, strip[[2*i-1]][2],
t = 2, l = 2*i-1, r = 2*i)
}
# Bottom row
for(i in 1:8) {
newStrip = gtable_add_grob(newStrip, strip[[i]][3],
t = 3, l = i)
}
# Put the strip into the plot
# (It could be better to remove the original strip.
# In this case, with a coloured background, it doesn't matter)
pgNew = gtable_add_grob(pg, newStrip, t = 7, l = 5, r = 19)
# Draw the plot
grid.newpage()
grid.draw(pgNew)
Run Code Online (Sandbox Code Playgroud)
或者使用vectorised gtable_add_grob(参见评论):
pg = ggplotGrob(p)
# Get a list of strips from the original plot
strip = lapply(grep("strip-t", pg$layout$name), function(x) {pg$grobs[[x]]})
# Construct gtable to contain the new strip
newStrip = gtable(widths = unit(rep(1, 8), "null"), heights = strip[[1]]$heights)
## Populate the gtable
# Top row
cols = seq(1, by = 4, length.out = 2)
newStrip = gtable_add_grob(newStrip, lapply(strip[cols], `[`, 1), t = 1, l = cols, r = cols + 3)
# Middle row
cols = seq(1, by = 2, length.out = 4)
newStrip = gtable_add_grob(newStrip, lapply(strip[cols], `[`, 2), t = 2, l = cols, r = cols + 1)
# Bottom row
newStrip = gtable_add_grob(newStrip, lapply(strip, `[`, 3), t = 3, l = 1:8)
# Put the strip into the plot
pgNew = gtable_add_grob(pg, newStrip, t = 7, l = 5, r = 19)
# Draw the plot
grid.newpage()
grid.draw(pgNew)
Run Code Online (Sandbox Code Playgroud)
编辑允许不同宽度的面板(即scales = "free_x",, space = "free_x").
此尝试采用原始ggplot,提取一些信息,然后构造包含重叠条带的新grob.功能不漂亮,但它的工作原理......到目前为止.它需要plyr安装.
library(ggplot2)
library(grid)
library(gtable)
df = structure(list(location = structure(c(1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,
2L, 2L), .Label = c("SF", "SS"), class = "factor"), species = structure(c(1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,
2L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("AGR", "LKA"), class = "factor"),
position = structure(c(1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L,
2L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L,
1L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L,
2L), .Label = c("top", "bottom"), class = "factor"), density = c(0.41,
0.41, 0.43, 0.33, 0.35, 0.43, 0.34, 0.46, 0.32, 0.32, 0.4,
0.4, 0.45, 0.34, 0.39, 0.39, 0.31, 0.38, 0.48, 0.3, 0.42,
0.34, 0.35, 0.4, 0.38, 0.42, 0.36, 0.34, 0.46, 0.38, 0.36,
0.39, 0.38, 0.39, 0.39, 0.39, 0.36, 0.39, 0.51, 0.38)), .Names = c("location",
"species", "position", "density"), row.names = c(NA, -40L), class = "data.frame")
# Begin with a regular ggplot with three facet levels
p=ggplot(df, aes("", density)) +
geom_boxplot(width=0.7, position=position_dodge(0.7)) +
theme_bw() +
facet_grid(. ~ species + location + position) +
theme(panel.spacing=unit(0,"lines"),
strip.background=element_rect(color="grey30", fill="grey90"),
panel.border=element_rect(color="grey90"),
axis.ticks.x=element_blank()) +
labs(x="")
## The function to get overlapping strip labels
OverlappingStripLabels = function(plot) {
# Get the ggplot grob
g = ggplotGrob(plot)
### Collect some information about the strips from the plot
# Get a list of strips
strip = lapply(grep("strip-t", g$layout$name), function(x) {g$grobs[[x]]})
# Number of strips
NumberOfStrips = sum(grepl(pattern = "strip-t", g$layout$name))
# Number of rows
NumberOfRows = length(strip[[1]])
# Panel spacing and it's unit
plot_theme <- function(p) {
plyr::defaults(p$theme, theme_get())
}
PanelSpacing = plot_theme(plot)$panel.spacing
unit = attr(PanelSpacing, "unit")
# Map the boundaries of the new strips
Nlabel = vector("list", NumberOfRows)
map = vector("list", NumberOfRows)
for(i in 1:NumberOfRows) {
for(j in 1:NumberOfStrips) {
Nlabel[[i]][j] = getGrob(grid.force(strip[[j]][i]), gPath("GRID.text"), grep = TRUE)$label
}
map[[i]][1] = TRUE
for(j in 2:NumberOfStrips) {
map[[i]][j] = Nlabel[[i]][j] != Nlabel[[i]][j-1]
}
}
## Construct gtable to contain the new strip
# Set the widths of the strips, based on widths of the panels and PanelSpacing
panel = subset(g$layout, grepl("panel", g$layout$name), l, drop = TRUE)
StripWidth = list()
for(i in seq_along(panel)) StripWidth[[i]] = unit.c(g$width[panel[i]], PanelSpacing)
newStrip = gtable(widths = unit.c(unit(unlist(StripWidth), c("null", unit)))[-2*NumberOfStrips],
heights = strip[[1]]$heights)
## Populate the gtable
seqLeft = list()
for(i in 1:NumberOfRows) {
Left = which(map[[i]] == TRUE)
seqLeft[[i]] = if((i-1) < 1) 2*Left - 1 else sort(unique(c(seqLeft[[i-1]], 2*Left - 1)))
seqRight = c(seqLeft[[i]][-1] -2, (2*NumberOfStrips-1))
newStrip = gtable_add_grob(newStrip, lapply(strip[(seqLeft[[i]]+1)/2], `[`, i), t = i, l = seqLeft[[i]], r = seqRight)
}
## Put the strip into the plot
# Get the locations of the original strips
pos = subset(g$layout, grepl("strip-t", g$layout$name), t:r)
## Use these to position the new strip
pgNew = gtable_add_grob(g, newStrip, t = unique(pos$t), l = min(pos$l), r = max(pos$r))
return(pgNew)
}
## Draw the plot
grid.newpage()
grid.draw(OverlappingStripLabels(p))
Run Code Online (Sandbox Code Playgroud)
打破这个功能可能不会太困难,但我在数据上尝试过,行的排序并不是那么均匀.
p1 = ggplot(mtcars, aes("", hp)) +
geom_boxplot(width=0.7, position=position_dodge(0.7)) +
theme_bw() +
facet_grid(. ~ vs + am + carb, labeller = label_both) +
theme(panel.spacing=unit(0.2,"lines"),
strip.background=element_rect(color="grey30", fill="grey90"),
panel.border=element_rect(color="grey90"),
axis.ticks.x=element_blank()) +
labs(x="")
grid.draw(OverlappingStripLabels(p1))
p2 = ggplot(mtcars, aes("", hp)) +
geom_boxplot(width=0.7, position=position_dodge(0.7)) +
theme_bw() +
facet_grid(. ~ vs + carb + am, labeller = label_both) +
theme(panel.spacing=unit(0.2,"lines"),
strip.background=element_rect(color="grey30", fill="grey90"),
panel.border=element_rect(color="grey90"),
axis.ticks.x=element_blank()) +
labs(x="")
grid.draw(OverlappingStripLabels(p2))
df = structure(list(id = 1:19,
category1 = c("X", "X", "X", "X", "X", "X", "X", "X", "X", "Y", "Y", "Y", "Y", "Y", "Y", "Y", "Y", "Y", "Y"),
category2 = c(21L, 21L, 21L, 22L, 22L, 22L, 22L, 22L, 22L, 23L, 23L, 23L, 24L, 24L, 24L, 25L, 25L, 26L, 26L),
category3 = c("C1", "C2", "C3", "D1", "D2", "D3", "D5", "D6", "D7", "E1", "E2", "E3", "F1", "F2", "F3", "G1", "G2", "H1", "H2"),
freq = c(4L, 7L, 4L, 28L, 20L, 0L, 1L, 4L, 1L, 17L, 33L, 31L, 20L, 20L, 21L, 15L, 18L, 12L, 13L)),
.Names = c("id", "category1", "category2", "category3", "freq"), class = "data.frame", row.names = c(NA, -19L))
p3 = ggplot(df, aes(category3, freq)) +
geom_bar(stat = "identity") +
facet_grid(. ~ category1 + category2, scale = "free_x", space = "free_x")
grid.draw(OverlappingStripLabels(p3))
Run Code Online (Sandbox Code Playgroud)
| 归档时间: |
|
| 查看次数: |
1428 次 |
| 最近记录: |