我想完美地对齐这些情节:
这是R代码:
library(tidyverse)
library(gridExtra)
groupes <- tribble(~type, ~group, ~prof, ~var,
1,1,1,12,
1,1,2,-24,
1,2,1,-11,
1,2,2,7,
2,1,1,10,
2,1,2,5,
2,2,1,-25,
2,2,2,2,
2,3,1,10,
2,3,2,3,
3,1,1,10,
3,1,2,-5,
3,2,1,25,
3,2,2,2,
3,3,1,-10,
3,3,2,3,
3,4,1,25,
3,4,2,-18)
hlay <- rbind(c(1,2,3),
c(1,2,3),
c(NA,2,3),
c(NA,NA,3))
p1 <- groupes %>% filter(type==1) %>% ggplot(aes(prof,var)) + geom_col() + facet_wrap(~group,ncol=1) +
coord_cartesian(ylim=c(-25,25)) +
labs(title="type 1",x="",y="")
p2 <- groupes %>% filter(type==2) %>% ggplot(aes(prof,var)) + geom_col() + facet_wrap(~group,ncol=1) +
coord_cartesian(ylim=c(-25,25)) +
labs(title="type 2",x="",y="")
p3 <- groupes %>% filter(type==3) %>% ggplot(aes(prof,var)) + geom_col() + facet_wrap(~group,ncol=1) +
coord_cartesian(ylim=c(-25,25)) +
labs(title="type 3",x="",y="")
grid.arrange(p1,p2,p3, layout_matrix=hlay)
我可以通过将heights=c(1.3,1,1,1)
添加到grid.arrange
来成功实现更好的对齐,但这不是一个完美的解决方案。另一个解决方案是不考虑标签占用的空间,但我不知道该怎么做。
答案 0 :(得分:12)
justify <- function(x, hjust="center", vjust="center"){
w <- sum(x$widths)
h <- sum(x$heights)
xj <- switch(hjust,
center = 0.5,
left = 0.5*w,
right=unit(1,"npc") - 0.5*w)
yj <- switch(vjust,
center = 0.5,
bottom = 0.5*h,
top=unit(1,"npc") - 0.5*h)
x$vp <- viewport(x=xj, y=yj)
return(x)
}
library(grid)
gl <- lapply(list(p1,p2,p3),egg::set_panel_size, height=unit(1,"in"))
gl <- lapply(gl, justify, vjust="top")
gridExtra::grid.arrange(grobs=gl, nrow=1)
答案 1 :(得分:0)
感谢@ user9471246,我设法创建了一个有效的解决方案。 @ user9471246解决了主要问题,然后出现了一个次要问题:“面板条”的高度随着字符高度的变化而变化(例如,如果面板标题是“aaa”面板条带将比面板标题“Égo”短,因为面板条是彼此独立绘制的。我的解决方案是摆脱面板条并将面板标题移动到绘图中。
library(tidyverse)
library(gridExtra)
library(grid)
# it also requires the "egg" package
groupes <- tribble(~type, ~group, ~prof, ~var,
1,"Aa",1,12,
1,"Aa",2,-24,
1,"Bb",1,-11,
1,"Bb",2,7,
1,"Cc",1,12,
1,"Cc",2,-5,
2,"Ég",1,10,
2,"Ég",2,5,
2,"Yg",1,-25,
2,"Yg",2,2,
2,"Ab",1,10,
2,"Ab",2,3,
2,"Cc",1,8,
2,"Cc",2,25,
3,"Dd",1,10,
3,"Dd",2,-5,
3,"Ee",1,25,
3,"Ee",2,2,
3,"Ff",1,-10,
3,"Ff",2,3,
3,"Ii",1,25,
3,"Ii",2,-18,
3,"Ll",1,20,
3,"Ll",2,-20)
dat_text <- groupes %>% distinct(type, group)
p1 <- groupes %>% filter(type==1) %>% ggplot(aes(prof,var)) + geom_col() + facet_wrap(~group,ncol=1) +
coord_cartesian(ylim=c(-25,25)) +
geom_text(data=filter(dat_text,type==1), aes(x = Inf, y = Inf, label=group), hjust = 1, vjust = 1.05) +
labs(title="type 1",x="",y="") +
theme(strip.text.x = element_blank())
p2 <- groupes %>% filter(type==2) %>% ggplot(aes(prof,var)) + geom_col() + facet_wrap(~group,ncol=1) +
coord_cartesian(ylim=c(-25,25)) +
geom_text(data=filter(dat_text,type==2), aes(x = Inf, y = Inf, label=group), hjust = 1, vjust = 1.05) +
labs(title="type 2",x="",y="") +
theme(strip.text.x = element_blank())
p3 <- groupes %>% filter(type==3) %>% ggplot(aes(prof,var)) + geom_col() + facet_wrap(~group,ncol=1) +
coord_cartesian(ylim=c(-25,25)) +
geom_text(data=filter(dat_text,type==3), aes(x = Inf, y = Inf, label=group), hjust = 1, vjust = 1.05) +
labs(title="type 3",x="",y="") +
theme(strip.text.x = element_blank())
justify <- function(x, hjust="center", vjust="center"){
w <- sum(x$widths)
h <- sum(x$heights)
xj <- switch(hjust,
center = 0.5,
left = 0.5*w,
right=unit(1,"npc") - 0.5*w)
yj <- switch(vjust,
center = 0.5,
bottom = 0.5*h,
top=unit(1,"npc") - 0.5*h)
x$vp <- viewport(x=xj, y=yj)
return(x)
}
gl <- lapply(list(p1,p2,p3),egg::set_panel_size, height=unit(1.95,"in"), width=unit(2.15,"in"))
gl <- lapply(gl, justify, vjust="top")
gridExtra::grid.arrange(grobs=gl, nrow=1)