如何在组合的ggplot中添加线条,连接一个图中的点与另一个图中的点?

9
我需要在ggplot中复制InDesign生成的图表以进行再现性。
在这个特定的例子中,我有两个图表被合并成一个复合图表(我使用了{patchwork}包)。
然后,我需要在一个图表上连接关键点的线条与底部图表上对应的点。
这两个图表是从相同的数据生成的,具有相同的x轴值,但具有不同的y轴值。
我在Stack Overflow上看到了这些示例,但这些示例处理跨越facet绘制线条,这在我尝试跨越单独的图表绘制线条时不起作用: 我尝试了几种方法,目前最接近的方法是:
  1. 使用{grid}包添加带有grobs的行
  2. 使用{gtable}将第二个图形转换为gtable,并将面板的剪辑设置为关闭,以便我可以将线条向上延伸超出绘图的面板。
  3. 使用{patchwork}再次将图形组合成单个图像。

问题出现在最后一步,因为在添加线条并将剪辑设置为关闭之前,x轴不再对齐(请参见代码示例)。

我还尝试了使用ggarrange, {cowplot}, {egg}{patchwork}将图形组合起来,{patchwork}是最接近的。

以下是我尝试创建的最佳minimal 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 中一样显示,但是连接线应该链接到图之间的点。

我正在寻求解决上述问题的帮助,或者尝试其他替代方法。

作为参考,不运行上面的代码 - 链接到图片,因为我不能发布它们。

Panel A

enter image description here

面板B:当前的外观

enter image description here

面板B:我想要它看起来像什么!

enter image description here

2个回答

5
我的解决方案有点临时抱佛脚的感觉,但似乎是有效的。我基于以下先前的回答Left align two graph edges (ggplot)
我将解决方案分为三个部分,以单独解决您遇到的一些问题。
符合您要求的解决方案是第三个!
第一次尝试
在这里,我使用与此答案相同的方法来使轴对齐Left align two graph edges (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)

enter image description here

第二次试验

现在的问题是底部图中的线条延伸超出了绘图区域。解决这个问题的一种方法是将 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)

enter image description here

第三次尝试

现在的问题是,线条没有延伸到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)

enter image description here


感谢@kikoralston的回复和帮助 - 它在我的数据上运行得非常好!这真的很有趣,深入了解ggplot的内部工作原理。 - Megan Beckett
出于好奇,为什么注释行中间有一个空隙? - Cole
实际上,我之前没有注意到这一点。当我在R Studio中看到图形时,小间隙并没有出现。但是,当我将图形保存为png格式时,如果使用较低的分辨率(这些图像就是这种情况),间隙就会出现。底部线段延伸到y=200(GROB_MAX变量)。我认为,根据分辨率,y=200可能不足以达到顶部图形的“高度”。 - kikoralston
还有一点笔误我已经修复了。我把 gB$layout$clip[g2$layout$name == "panel"] <- "off" 改成了 gB$layout$clip[gB$layout$name == "panel"] <- "off" - kikoralston
@Cole,是的,要试错一下才能确定底部线条延伸到顶部线条的高度。它不是一个连续的线条,而是由两个线条组成,从每个图表上的相关点开始延伸到达另一个图表。 - Megan Beckett

2
这里使用facet_grid来强制使x轴匹配。最初的回答。
grobbing_lines <- tribble(
  ~facet,   ~x, ~xend,       ~y,    ~yend,
  'profit',  5,     5,       50,      Inf,
  # 'curve',   5,     5,     -Inf, 28.39397
  'curve',   -Inf,     5, 28.39397, 28.39397
)

grobbing_points <- tribble(
  ~facet,   ~x,        ~y,    
  'curve',   5,  28.39397 
)

data_long_facet <- data_long%>%
  mutate(facet = if_else(variable == 'profit', 'profit', 'curve'))

p <- ggplot(data_long_facet, aes(x = quantity, y = value)) +
  geom_line(aes(color = variable))+
  facet_grid(rows = vars(facet), scales = 'free_y')+
  geom_segment(data = grobbing_lines, aes(x = x, xend = xend, y = y, yend = yend),inherit.aes = F)+
  geom_point(data = grobbing_points, aes(x = x, y = y), size = 3, inherit.aes = F)

pb <- ggplot_build(p)
pg <- ggplot_gtable(pb)

#formulas to determine points in x and y locations
data2npc <- function(x, panel = 1L, axis = "x") {
  range <- pb$layout$panel_params[[panel]][[paste0(axis,".range")]]
  scales::rescale(c(range, x), c(0,1))[-c(1,2)]
}

data_y_2npc <- function(y, panel, axis = 'y') {
  range <- pb$layout$panel_params[[panel]][[paste0(axis,".range")]]
  scales::rescale(c(range, y), c(0,1))[-c(1,2)]
}


# add the new grob
pg <- gtable_add_grob(pg,
                      segmentsGrob(x0 = data2npc(5),
                                   x1 = data2npc(5),
                                   y0=data_y_2npc(50, panel = 2)/2,
                                   y1 = data_y_2npc(28.39397, panel = 1L)+ 0.25) ,
                      t = 7, b = 9, l = 5)

#print to page
grid.newpage()
grid.draw(pg)

传说和比例尺与你想要的输出不符。"最初的回答"。

在此输入图片描述


网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接