R 以不同的间距对齐多个绘图，并在它们之间添加箭头

我有6个图，我想以两步方式整齐地对齐（见图）。最好，我想添加漂亮的箭头

有什么想法吗

---

UPD。当我的问题开始收集负面反馈时，我想澄清一下，我已经检查了SO的所有（部分）相关问题，没有发现关于如何在“画布”上自由定位ggplots的指示。此外，我想不出一种在情节之间画箭头的方法。我不是要现成的解决方案。请指路

---

这里尝试一下您想要的布局。它需要手动设置一些格式，但通过利用内置于打印布局中的坐标系，您可能可以实现大部分格式的自动化。此外，您可能会发现

grid.curve

比

grid.bezier

（我用过）更适合按您想要的方式塑造箭头曲线

我对

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))

下面是结果图：

---

可能使用

ggplot

和

annotation\u 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_路径

生成坐标。也许人们应该寻找一些关于贝塞尔曲线及其控制点的附加信息，以使曲线图之间的连接看起来更漂亮。现在，结果图如下所示。

---

非常感谢您的提示，尤其是@eipi10的实际实现——答案非常好。 我找到了一个本机

ggplot

解决方案，希望与大家分享

UPD当我输入这个答案时，@inscaven用基本相同的想法发布了他的答案。bezier软件包为创建整洁的曲线箭头提供了更多自由

---

ggplot2:：注释\自定义
简单的解决方案是使用
ggplot
的
annotation\u custom
将6个图定位在“画布”ggplot上

剧本
步骤1。加载所需的包并创建6个方形GGPLOT的列表。我最初需要安排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)

使用gridExtra的
网格。排列
/
排列Grob
以排列绘图，然后使用网格函数绘制箭头。查看
cowplot
包的代码。它排列绘图，然后用标签对其进行注释。它使用
网格。像罗兰建议的那样排列
。这可能是一个很好的起点。我认为他在这张素描上表现得相当出色。我知道这不符合理想职位的要求，但我认为他表现出了良好的努力和研究，而且我认为这些要求有些限制。如果这是一次性任务，我会用Inkscape来完成。@Mike查看
cowplot
源代码的想法看起来很有希望。谢谢！嗨，巴蒂斯特。我希望你能来告诉我怎么做才对。谢谢还有其他建议吗？@eipi10谢谢你的鼓舞人心的脚本。@eipi10不太好，我个人使用Illustrator做这样的注释，因为我）R/grid中的箭头看起来不太好看；ii）摆弄硬编码坐标比手工绘制要花更多的时间；iii）对于一次性注释，再现性不是一个真正的问题。当然，在某些情况下，完全脚本化的解决方案是有用的。您在我键入和格式化我的答案时发布了您的答案（几乎相同））我非常喜欢您生成示例图和创建箭头的方式。谢谢！
df <- data.frame(x=factor(sample(1:21,1000,replace = T)),
                 y=factor(sample(1:31,1000,replace = T)))

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)

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))

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)