我有6个图,我想以两步的方式整齐地对齐(见图)。最好,我想添加漂亮的箭头。
有什么想法吗?
UPD。当我的问题开始收集负面反馈时,我想澄清一下,我已经检查了所有(部分)相关的问题,并没有发现如何在“画布”上自由定位ggplots。而且,我想不出用一种方法在之间绘制箭头。我不是要求现成的解决方案。请指出方法。
答案 0 :(得分:15)
这是尝试您想要的布局。它需要手动进行一些格式化,但您可以通过利用绘图布局中内置的坐标系来自动化大部分格式。此外,您可能会发现grid.curve
比grid.bezier
(我使用过的)更好,因为箭头曲线的形状完全符合您的要求。
我完全了解grid
是危险的,所以我对任何改进建议感兴趣。无论如何,这里... ...
加载我们需要的软件包,创建一些实用程序grid
对象,并创建一个布局图:
library(ggplot2)
library(gridExtra)
# Empty grob for spacing
#b = rectGrob(gp=gpar(fill="white", col="white"))
b = nullGrob() # per @baptiste's comment, use nullGrob() instead of rectGrob()
# grid.bezier with a few hard-coded settings
mygb = function(x,y) {
grid.bezier(x=x, y=y, gp=gpar(fill="black"),
arrow=arrow(type="closed", length=unit(2,"mm")))
}
# Create a plot to arrange
p = ggplot(mtcars, aes(wt, mpg)) +
geom_point()
创建主要情节安排。使用我们在上面创建的空grob b
来区分图:
grid.arrange(arrangeGrob(p, b, p, p, heights=c(0.3,0.1,0.3,0.3)),
b,
arrangeGrob(b, p, p, b, p, heights=c(0.07,0.3, 0.3, 0.03, 0.3)),
ncol=3, widths=c(0.45,0.1,0.45))
添加箭头:
# Switch to viewport for first set of arrows
vp = viewport(x = 0.5, y=.75, width=0.09, height=0.4)
pushViewport(vp)
#grid.rect(gp=gpar(fill="black", alpha=0.1)) # Use this to see where your viewport is located on the full graph layout
# Add top set of arrows
mygb(x=c(0,0.8,0.8,1), y=c(1,0.8,0.6,0.6))
mygb(x=c(0,0.6,0.6,1), y=c(1,0.4,0,0))
# Up to "main" viewport (the "full" canvas of the main layout)
popViewport()
# New viewport for lower set of arrows
vp = viewport(x = 0.6, y=0.38, width=0.15, height=0.3, just=c("right","top"))
pushViewport(vp)
#grid.rect(gp=gpar(fill="black", alpha=0.1)) # Use this to see where your viewport is located on the full graph layout
# Add bottom set of arrows
mygb(x=c(1,0.8,0.8,0), y=c(1,0.9,0.9,0.9))
mygb(x=c(1,0.7,0.4,0), y=c(1,0.8,0.4,0.4))
这是由此产生的情节:
答案 1 :(得分:3)
可能在ggplot
使用annotation_custom
这里是一种更方便的方法。首先,我们生成样本图。
require(ggplot2)
require(gridExtra)
require(bezier)
# generate sample plots
set.seed(17)
invisible(
sapply(paste0("gg", 1:6), function(ggname) {
assign(ggname, ggplotGrob(
ggplot(data.frame(x = rnorm(10), y = rnorm(10))) +
geom_path(aes(x,y), size = 1,
color = colors()[sample(1:length(colors()), 1)]) +
theme_bw()),
envir = as.environment(1)) })
)
之后我们可以在更大的ggplot
内绘制它们。
# necessary plot
ggplot(data.frame(a=1)) + xlim(1, 20) + ylim(1, 32) +
annotation_custom(gg1, xmin = 1, xmax = 9, ymin = 23, ymax = 31) +
annotation_custom(gg2, xmin = 11, xmax = 19, ymin = 21, ymax = 29) +
annotation_custom(gg3, xmin = 11, xmax = 19, ymin = 12, ymax = 20) +
annotation_custom(gg4, xmin = 1, xmax = 9, ymin = 10, ymax = 18) +
annotation_custom(gg5, xmin = 1, xmax = 9, ymin = 1, ymax = 9) +
annotation_custom(gg6, xmin = 11, xmax = 19, ymin = 1, ymax = 9) +
geom_path(data = as.data.frame(bezier(t = 0:100/100, p = list(x = c(9, 10, 10, 11), y = c(27, 27, 25, 25)))),
aes(x = V1, y = V2), size = 1, arrow = arrow(length = unit(.01, "npc"), type = "closed")) +
geom_path(data = as.data.frame(bezier(t = 0:100/100, p = list(x = c(9, 10, 10, 11), y = c(27, 27, 18, 18)))),
aes(x = V1, y = V2), size = 1, arrow = arrow(length = unit(.01, "npc"), type = "closed")) +
geom_path(data = as.data.frame(bezier(t = 0:100/100, p = list(x = c(15, 15, 12, 9), y = c(12, 11, 11, 11)))),
aes(x = V1, y = V2), size = 1, arrow = arrow(length = unit(.01, "npc"), type = "closed")) +
geom_path(data = as.data.frame(bezier(t = 0:100/100, p = list(x = c(15, 15, 12, 9), y = c(12, 11, 11, 9)))),
aes(x = V1, y = V2), size = 1, arrow = arrow(length = unit(.01, "npc"), type = "closed")) +
geom_path(data = as.data.frame(bezier(t = 0:100/100, p = list(x = c(15, 15, 12, 12), y = c(12, 10.5, 10.5, 9)))),
aes(x = V1, y = V2), size = 1, arrow = arrow(length = unit(.01, "npc"), type = "closed")) +
theme(rect = element_blank(),
line = element_blank(),
text = element_blank(),
plot.margin = unit(c(0,0,0,0), "mm"))
我们使用bezier
包中的bezier
函数生成geom_path
的坐标。也许应该寻找关于贝塞尔曲线及其控制点的一些额外信息,以使图之间的连接看起来更漂亮。现在得到的情节如下。
答案 2 :(得分:3)
非常感谢你的提示,特别是@ eipi10实际实现它们 - 答案很棒。
我找到了一个我希望分享的原生ggplot
解决方案。
UPD 当我输入这个答案时,@ inscaven以基本相同的想法发布了他的回答。 bezier
包可以更自由地创建整齐的弯曲箭头。
ggplot2::annotation_custom
简单的解决方案是使用ggplot
' annotation_custom
将6个地块放在"画布" ggplot。
第1步。加载所需的包并创建6平方ggplots的列表。我最初需要安排6张地图,因此,我会相应地触发theme
参数。
library(ggplot2)
library(ggthemes)
library(gridExtra)
library(dplyr)
p <- ggplot(mtcars, aes(mpg,wt))+
geom_point()+
theme_map()+
theme(aspect.ratio=1,
panel.border=element_rect(color = 'black',size=.5,fill = NA))+
scale_x_continuous(expand=c(0,0)) +
scale_y_continuous(expand=c(0,0)) +
labs(x = NULL, y = NULL)
plots <- list(p,p,p,p,p,p)
第2步。我为画布图创建了一个数据框。我敢肯定,有更好的方法。我们的想法是获得一张像A4纸一样的30x20画布。
df <- data.frame(x=factor(sample(1:21,1000,replace = T)),
y=factor(sample(1:31,1000,replace = T)))
第3步。绘制画布并将方形图放在上面。
canvas <- ggplot(df,aes(x=x,y=y))+
annotation_custom(ggplotGrob(plots[[1]]),
xmin = 1,xmax = 9,ymin = 23,ymax = 31)+
annotation_custom(ggplotGrob(plots[[2]]),
xmin = 13,xmax = 21,ymin = 21,ymax = 29)+
annotation_custom(ggplotGrob(plots[[3]]),
xmin = 13,xmax = 21,ymin = 12,ymax = 20)+
annotation_custom(ggplotGrob(plots[[4]]),
xmin = 1,xmax = 9,ymin = 10,ymax = 18)+
annotation_custom(ggplotGrob(plots[[5]]),
xmin = 1,xmax = 9,ymin = 1,ymax = 9)+
annotation_custom(ggplotGrob(plots[[6]]),
xmin = 13,xmax = 21,ymin = 1,ymax = 9)+
coord_fixed()+
scale_x_discrete(expand = c(0, 0)) +
scale_y_discrete(expand = c(0, 0)) +
theme_bw()
theme_map()+
theme(panel.border=element_rect(color = 'black',size=.5,fill = NA))+
labs(x = NULL, y = NULL)
第4步。现在我们需要添加箭头。首先,带箭头的数据框&#39;坐标是必需的。
df.arrows <- data.frame(id=1:5,
x=c(9,9,13,13,13),
y=c(23,23,12,12,12),
xend=c(13,13,9,9,13),
yend=c(22,19,11,8,8))
第5步。最后,绘制箭头。
gg <- canvas + geom_curve(data = df.arrows %>% filter(id==1),
aes(x=x,y=y,xend=xend,yend=yend),
curvature = 0.1,
arrow = arrow(type="closed",length = unit(0.25,"cm"))) +
geom_curve(data = df.arrows %>% filter(id==2),
aes(x=x,y=y,xend=xend,yend=yend),
curvature = -0.1,
arrow = arrow(type="closed",length = unit(0.25,"cm"))) +
geom_curve(data = df.arrows %>% filter(id==3),
aes(x=x,y=y,xend=xend,yend=yend),
curvature = -0.15,
arrow = arrow(type="closed",length = unit(0.25,"cm"))) +
geom_curve(data = df.arrows %>% filter(id==4),
aes(x=x,y=y,xend=xend,yend=yend),
curvature = 0,
arrow = arrow(type="closed",length = unit(0.25,"cm"))) +
geom_curve(data = df.arrows %>% filter(id==5),
aes(x=x,y=y,xend=xend,yend=yend),
curvature = 0.3,
arrow = arrow(type="closed",length = unit(0.25,"cm")))
ggsave('test.png',gg,width=8,height=12)