如何在组合的ggplots上添加线，从一个图上的点到另一个图上的点？

Question

我需要在ggplot中重现InDesign中生成的图，以实现可重现性。

在此特定示例中，我将两个图合并到一个合成图中（{patchwork}为此我使用了程序包）。

然后，我需要将连接一个图上关键点的线与底部图上的对应点重叠。

这两个图是从相同的数据生成的，具有相同的x轴值，但具有不同的y轴值。

我已经在Stack Overflow上看到了这些示例，但是这些示例处理的是跨构面的绘制线，在这里尝试跨单独的图绘制线时，这在这里不起作用：

• ggplot，跨构面绘制多条线
• ggplot，跨构面的点之间绘制线

我尝试了几种方法，到目前为止，我最接近的方法是：

1. 使用{grid}package 添加带有grobs的行
2. 使用将第二个图转换为gtable {gtable}，并将面板的剪辑设置为off，以便我可以将线向上延伸到该图的面板之外。
3. 再次将绘图合并为一张图像{patchwork}。

问题出在最后一步，因为x轴现在不再像添加线并将剪辑设置为off之前那样对齐（请参见代码示例）。

我也曾尝试用相结合的情节ggarrange，{cowplot}并{egg}与{patchwork}来自最接近的一次。

以下是我尝试创建的最佳最小reprex的尝试，但仍在捕捉我想要实现的细微差别。

library(ggplot2)
library(dplyr)
library(tidyr)
library(patchwork)
library(gtable)
library(grid)

# DATA
x <- 1:20
data <- data.frame(
  quantity = x,
  curve1 = 10 + 50*exp(-0.2 * x),
  curve2 = 5 + 50*exp(-0.5 * x),
  profit = c(seq(10, 100, by = 10),
             seq(120, -240, by = -40))
)

data_long <- data %>%
  gather(key = "variable", value = "value", -quantity)

# POINTS AND LINES
POINTS <- data.frame(
  label = c("B", "C"),
  quantity = c(5, 10),
  value = c(28.39397, 16.76676),
  profit = c(50, 100)
)

GROB <- linesGrob()

# Set maximum y-value to extend lines to outside of plot area
GROB_MAX <- 200

# BASE PLOTS
# Plot 1
p1 <- data_long %>%
  filter(variable != "profit") %>%
  ggplot(aes(x = quantity, y = value)) +
  geom_line(aes(color = variable)) +
  labs(x = "") +
  coord_cartesian(xlim = c(0, 20), ylim = c(0, 30), expand = FALSE) +
  theme(legend.justification = "top")
p1

# Plot 2
p2 <- data_long %>%
  filter(variable == "profit") %>%
  ggplot(aes(x = quantity, y = value)) +
  geom_line(color = "darkgreen") +
  coord_cartesian(xlim = c(0, 20), ylim = c(-100, 120), expand = FALSE) +
  theme(legend.position = "none")
p2

# PANEL A
panel_A <- p1 + p2 + plot_layout(ncol = 1)
panel_A

# PANEL B
# ATTEMPT - adding grobs to plot 1 that end at x-axis of p1
p1 <- p1 +
  annotation_custom(GROB,
                    xmin = 0,
                    xmax = POINTS$quantity[POINTS$label == "B"],
                    ymin = POINTS$value[POINTS$label == "B"],
                    ymax = POINTS$value[POINTS$label == "B"]) +
  annotation_custom(GROB,
                    xmin = POINTS$quantity[POINTS$label == "B"],
                    xmax = POINTS$quantity[POINTS$label == "B"],
                    ymin = 0,
                    ymax = POINTS$value[POINTS$label == "B"]) +
  geom_point(data = POINTS %>% filter(label == "B"), size = 1)

# ATTEMPT - adding grobs to plot 2 that extend up to meet plot 1
p2 <- p2 + annotation_custom(GROB,
                             xmin = POINTS$quantity[POINTS$label == "B"],
                             xmax = POINTS$quantity[POINTS$label == "B"],
                             ymin = POINTS$profit[POINTS$label == "B"],
                             ymax = GROB_MAX)

# Create gtable from ggplot
g2 <- ggplotGrob(p2)

# Turn clip off for panel so that line can extend above
g2$layout$clip[g2$layout$name == "panel"] <- "off"

panel_B <- p1 + g2 + plot_layout(ncol = 1)
panel_B
# Problems:
# 1. Note the shift in axes when turning the clip off so now they do not line up anymore.
# 2. Turning the clip off mean plot 2 extends below the axis. Tried experimenting with various clips.

可以预期的是，panel_B中的图仍应像在panel_A中一样显示，但是具有连接图之间的连接线。

我正在寻求帮助来解决上述问题，或者尝试其他方法。

作为参考，无需运行上面的代码-链接到图像，因为我无法发布它们。

面板A

面板B：目前的状况

面板B：我希望它看起来像什么！

Answer 1

我的解决方案是临时的，但似乎可行。我基于以下先前的答案将其左对齐两个图形边缘（ggplot）。

我将解决方案分为三个部分，分别解决您面临的一些问题。

满足您需求的解决方案是第三个！

初审

在这里，我使用与该答案相同的方法来使轴对齐。左对齐两个图形边缘（ggplot）。

# first trial 
# plots are aligned but line in bottom plot extends to the bottom
#
p1_1 <- p1 +
  annotation_custom(GROB,
                    xmin = 0,
                    xmax = POINTS$quantity[POINTS$label == "B"],
                    ymin = POINTS$value[POINTS$label == "B"],
                    ymax = POINTS$value[POINTS$label == "B"]) +
  annotation_custom(GROB,
                    xmin = POINTS$quantity[POINTS$label == "B"],
                    xmax = POINTS$quantity[POINTS$label == "B"],
                    ymin = 0,
                    ymax = POINTS$value[POINTS$label == "B"]) +
  geom_point(data = POINTS %>% filter(label == "B"), size = 1)

p2_1 <- p2 + annotation_custom(GROB,
                               xmin = POINTS$quantity[POINTS$label == "B"],
                               xmax = POINTS$quantity[POINTS$label == "B"],
                               ymin = POINTS$profit[POINTS$label == "B"],
                               ymax = GROB_MAX)

# Create gtable from ggplot
gA <- ggplotGrob(p1_1)
gB <- ggplotGrob(p2_1)

# Turn clip off for panel so that line can extend above
gB$layout$clip[gB$layout$name == "panel"] <- "off"

# get max width of left axis between both plots
maxWidth = grid::unit.pmax(gA$widths[2:5], gB$widths[2:5])

# set maxWidth to both plots (to align left axis)
gA$widths[2:5] <- as.list(maxWidth)
gB$widths[2:5] <- as.list(maxWidth)

# now apply all widths from plot A to plot B 
# (this is specific to your case because we know plot A is the one with the legend)
gB$widths <- gA$widths

grid.arrange(gA, gB, ncol=1)

二审

现在的问题是，底部图中的线超出了绘制区域。解决此问题的一种方法是将更coord_cartesian()改为scale_y_continuous()，scale_x_continuous()因为这将删除掉在绘图区域之外的数据。

# second trial 
# using scale_y_continuous and scale_x_continuous to remove data out of plot limits
# (this could resolve the problem of the bottom plot, but creates another problem)
#
p1_2 <- p1_1 

p2_2 <- data_long %>%
  filter(variable == "profit") %>%
  ggplot(aes(x = quantity, y = value)) +
  geom_line(color = "darkgreen") +
  scale_x_continuous(limits = c(0, 20), expand = c(0, 0)) +
  scale_y_continuous(limits=c(-100, 120), expand=c(0,0)) +
  theme(legend.position = "none") + 
  annotation_custom(GROB,
                    xmin = POINTS$quantity[POINTS$label == "B"],
                    xmax = POINTS$quantity[POINTS$label == "B"],
                    ymin = POINTS$profit[POINTS$label == "B"],
                    ymax = GROB_MAX)

# Create gtable from ggplot
gA <- ggplotGrob(p1_2)
gB <- ggplotGrob(p2_2)

# Turn clip off for panel so that line can extend above
gB$layout$clip[gB$layout$name == "panel"] <- "off"


# get max width of left axis between both plots
maxWidth = grid::unit.pmax(gA$widths[2:5], gB$widths[2:5])

# set maxWidth to both plots (to align left axis)
gA$widths[2:5] <- as.list(maxWidth)
gB$widths[2:5] <- as.list(maxWidth)

# now apply all widths from plot A to plot B 
# (this is specific to your case because we know plot A is the one with the legend)
gB$widths <- gA$widths

# but now the line does not go all the way to the bottom y axis
grid.arrange(gA, gB, ncol=1)

三审

现在的问题是，该线不会一直延伸到y轴的底部（因为已删除了y = -100以下的点）。我解决此问题的方法（非常特殊）是在y = -100处插入点并将其添加到数据帧中。

# third trial 
# modify the data set so value data stops at bottom of plot
# 
p1_3 <- p1_1 

# use approx() function to interpolate value of x when y value == -100
xvalue <- approx(x=data_long$value, y=data_long$quantity, xout=-100)$y

p2_3 <- data_long %>%
  filter(variable == "profit") %>%
  # add row with interpolated point!
  rbind(data.frame(quantity=xvalue, variable = "profit", value=-100)) %>%
  ggplot(aes(x = quantity, y = value)) +
  geom_line(color = "darkgreen") +
  scale_x_continuous(limits = c(0, 20), expand = c(0, 0)) +
  scale_y_continuous(limits=c(-100, 120), expand=c(0,0)) +
  theme(legend.position = "none") + 
  annotation_custom(GROB,
                    xmin = POINTS$quantity[POINTS$label == "B"],
                    xmax = POINTS$quantity[POINTS$label == "B"],
                    ymin = POINTS$profit[POINTS$label == "B"],
                    ymax = GROB_MAX)

# Create gtable from ggplot
gA <- ggplotGrob(p1_3)
gB <- ggplotGrob(p2_3)

# Turn clip off for panel so that line can extend above
gB$layout$clip[gB$layout$name == "panel"] <- "off"


# get max width of left axis between both plots
maxWidth = grid::unit.pmax(gA$widths[2:5], gB$widths[2:5])

# set maxWidth to both plots (to align left axis)
gA$widths[2:5] <- as.list(maxWidth)
gB$widths[2:5] <- as.list(maxWidth)

# now apply all widths from plot A to plot B 
# (this is specific to your case because we know plot A is the one with the legend)
gB$widths <- gA$widths

# Now line goes all the way to the bottom y axis
grid.arrange(gA, gB, ncol=1)