用ggplot2和grid画出最适合的线结束的箭头

Question

我正在尝试用箭头注释最适合散点图的 ggplot2 线。

这复制了 Paul Murrell 的书《R Graphics》（第三版）中的示例，尽管该示例修改了网格显示列表上的 grobs，而我想通过操作 ggplot2 生成的 grobs 来完成此操作。 原始示例的代码在这里（图 7.16）。

我想在绘图区域中写下“最佳拟合线”，并从中绘制一个箭头，以实际的最佳拟合线结束。

我几乎已经让它工作了，但找不到放置箭头末端的正确方法，因为它指向置信区间功能区的底部而不是线本身。

到目前为止的代码：

library(ggplot2)
library(grid)

p <- ggplot(mtcars, aes(x = disp, y = mpg)) +
  geom_point() +
  geom_smooth(method = lm, se = TRUE)

gg <- ggplotGrob(p)

# Retrieve the panel grob
panel_grob <- gg[["grobs"]][gg$layout$name == "panel"][[1]]

child_nms <- names(panel_grob[["children"]])

# Which child of the "panel" grob contains "smooth" in its name?
smooth_idx <- which(grepl("smooth", child_nms))
smooth_grob <- panel_grob$children[smooth_idx][[1]]

# Which child of the "smooth" grob contains "line" in its name?
line_idx <- which(grepl("line", names(smooth_grob$children)))
polyline_grob <- smooth_grob$children[line_idx][[1]]

# Create the line with arrow
line_grob <- segmentsGrob(0.7, 0.8,
                          grobX(polyline_grob, 45),
                          grobY(polyline_grob, 45),
                          arrow = arrow(angle = 10, type = "closed"),
                          gp = gpar(fill = "black"))

# Create the text for annotation
txt_grob <- textGrob("line of best fit", 0.71, 0.81, just = c("left", "bottom"))

# Add arrow line and text annotation to the grob tree
gg_annotated <- grid::grobTree(
  gg,
  grid::grobTree(line_grob),
  grid::grobTree(txt_grob),
  vp = grid::viewport(x = unit(0.5, "npc"),
                      y = unit(0.5, "npc"),
                      width = unit(1, "npc"),
                      height = unit(1, "npc")
  )
)

# Render the plot
grid.draw(gg_annotated)

结果：

如果我通过反复试验调整segmentsGrob的y1值，例如通过将 grobY 行更改为：

grobY(polyline_grob, 45) + unit(0.045, "npc")

，它会生成我想要的图形：

但是，这是 y 坐标的任意移动。

也许我检索到了错误的 grob 以在调用 snippetGrob 时使用。我尝试过在 grobTree 中的其他 grobs 上制作箭头末端，但我无法让它工作。我怎样才能让箭头结束在最佳拟合线上？

Answer 1

虽然我很欣赏您的努力，但恕我直言，实现您想要的结果的更简单方法是手动估计拟合线，然后使用两个

annotate

添加线段和标签：

library(ggplot2)

mod <- lm(mpg ~ disp, mtcars)

ggplot(mtcars, aes(x = disp, y = mpg)) +
  geom_point() +
  geom_smooth(method = lm, se = TRUE) +
  annotate(
    geom = "segment",
    xend = 250, yend = predict(mod, data.frame(disp = 250)),
    x = 300, y = 25,
    arrow = arrow(angle = 10, type = "closed")
  ) +
  annotate(
    geom = "label",
    x = 300,
    y = 25,
    fill = NA,
    label.size = 0,
    label = "line of best fit",
    hjust = 0,
    vjust = 0
  )
#> `geom_smooth()` using formula = 'y ~ x'