r - 如何在ggplot2中绘制绘图区域之外的线？

Question

我用ggplot2创建了这个图:

外部线条需要与 Y 比例相对应(即 Text1 线条的 Y 位置应为 100 和 85)。我可以做到这一点的唯一方法是在图的右侧绘制一个与条形图具有相同比例的空白图，然后使用注释函数来绘制线条。另一种方法是简单地“手动”用 grid.lines 绘制线条。 ，但是 grid.lines 的坐标将不对应于绘图的 Y 比例。

是否可以使用不同的方法来绘制这些线？我认为必须用 grid.lines 来完成。我如何将条形图的 Y 坐标传递给 grid.lines ？

下面是用于创建该图的最少代码:

library (ggplot2)
test= data.frame(
  group=c(rep(1,6), rep(2,6)),
  subgroup=c( 1,1,1,2,2,2,1,1,1,2,2,2),
  category=c( rep(1:3, 4)),
  count=c( 10,80,10,5,90,5,  10,80,10,5,90,5   )
  )

qplot(subgroup, 
      count, 
      data=test, 
      geom="bar", 
      stat="identity",
      fill =category,  
      facets =  .~ group,  width=0.9)+
      opts(legend.position="none",
           plot.margin = unit(c(0,9,2,0), "lines"))

如何在条形右侧绘制线条？

我最近问了一个关于在 ggplot2 中绘制绘图区域之外的文本的问题，解决方案是使用 gt$layout和grid.draw 。

Displaying text below the plot generated by ggplot2

这里可以使用类似的方法吗？据我了解，annotation_custom 仅适用于文本，不适用于其他图形元素。谢谢

Answer 1

更新

最初的解决方案使用annotation_custom，但是annotation_custom的一个问题是它会在所有面板中绘制注释。然而，通过简单的修改，annotation_custom 可以只在一个面板中绘制(摘自 Baptiste 的回答 here )

annotation_custom2 <- 
function (grob, xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = Inf, data) 
{
  layer(data = data, stat = StatIdentity, position = PositionIdentity, 
        geom = ggplot2:::GeomCustomAnn,
        inherit.aes = TRUE, params = list(grob = grob, 
                                          xmin = xmin, xmax = xmax, 
                                          ymin = ymin, ymax = ymax))
}

library(ggplot2)
library(grid)

 #Some data
test = data.frame(
  group=c(rep(1,6), rep(2,6)),
  subgroup=c( 1,1,1,2,2,2,1,1,1,2,2,2),
  category=c( rep(1:3, 4)),
  count=c( 10,80,10,5,90,5,  10,80,10,5,90,5   )
  )

# base plot
p <- ggplot(test) +
   geom_bar(aes(subgroup, count, fill = category), stat = "identity") +
   facet_grid(. ~ group) +
  theme(legend.position = "none",  
        plot.margin = unit(c(1,5,1,1), "lines"))

# Create the text Grobs
Text1 = textGrob("Text 1")
Text2 = textGrob("Text 2")
Text4 = textGrob("Text 4")

## Add the annotations
# Which panel to attach the annotations
data = data.frame(group=2)

# Text 1
p1 = p + annotation_custom2(Text1,  xmin = 3., xmax = 3., ymin = 85, ymax = 100, data = data) +
    annotation_custom2(linesGrob(), xmin = 2.6, xmax = 2.75, ymin = 100, ymax = 100, data = data) +
    annotation_custom2(linesGrob(), xmin = 2.6, xmax = 2.75, ymin = 85, ymax = 85, data = data) +
    annotation_custom2(linesGrob(), xmin = 2.75, xmax = 2.75, ymin = 85, ymax = 100, data = data)

# Text 2
p1 = p1 + annotation_custom2(Text2,  xmin = 3, xmax = 3, ymin = 20, ymax = 80, data = data) +
    annotation_custom2(linesGrob(), xmin = 2.6, xmax = 2.75, ymin = 80, ymax = 80, data = data) +
    annotation_custom2(linesGrob(), xmin = 2.6, xmax = 2.75, ymin = 20, ymax = 20, data = data) +
    annotation_custom2(linesGrob(), xmin = 2.75, xmax = 2.75, ymin = 20, ymax = 80, data = data)

# Text 4
p1 = p1 + annotation_custom2(Text4,  xmin = 3, xmax = 3, ymin = 0, ymax = 15, data = data) +
    annotation_custom2(linesGrob(), xmin = 2.6, xmax = 2.75, ymin = 15, ymax = 15, data = data) +
    annotation_custom2(linesGrob(), xmin = 2.6, xmax = 2.75, ymin = 0, ymax = 0, data = data) +
    annotation_custom2(linesGrob(), xmin = 2.75, xmax = 2.75, ymin = 0, ymax = 15, data = data)


# Code to override clipping
gt <- ggplotGrob(p1)
gt$layout[grepl("panel", gt$layout$name), ]$clip <- "off"

# Draw the plot
grid.newpage()
grid.draw(gt)

原始解决方案

我认为几乎任何使用grid()创建的Grob都可以在annotation_custom()中使用。可能有更简洁的方法可以做到这一点，但这里有一种使用 grid、annotation_custom 和 @baptiste 的代码 from here 的方法。覆盖剪辑(如之前的帖子中所示)。

library (ggplot2)
library(grid)

test= data.frame(
  group=c(rep(1,6), rep(2,6)),
  subgroup=c( 1,1,1,2,2,2,1,1,1,2,2,2),
  category=c( rep(1:3, 4)),
  count=c( 10,80,10,5,90,5,  10,80,10,5,90,5   )
  )

## EDIT:  Updated qplot() command
p <- qplot(subgroup, count, 
  data = test, geom = "bar",  stat = "identity",
  fill = category,  
  facets = .~ group,  width = 0.9)+
  theme(legend.position="none",  plot.margin = unit(c(0,9,2,0), "lines"))



# Create the text Grobs
Text1 = textGrob("Text 1")
Text2 = textGrob("Text 2")
Text4 = textGrob("Text 4")

# Draw the plot
# Text 1
p1 = p + annotation_custom(grob = Text1,  xmin = 3., xmax = 3., ymin = 85, ymax = 100) +
    annotation_custom(grob = linesGrob(), xmin = 2.6, xmax = 2.75, ymin = 100, ymax = 100) +
    annotation_custom(grob = linesGrob(), xmin = 2.6, xmax = 2.75, ymin = 85, ymax = 85) +
    annotation_custom(grob = linesGrob(), xmin = 2.75, xmax = 2.75, ymin = 85, ymax = 100)

# Text 2
p1 = p1 + annotation_custom(grob = Text2,  xmin = 3, xmax = 3, ymin = 20, ymax = 80) +
    annotation_custom(grob = linesGrob(), xmin = 2.6, xmax = 2.75, ymin = 80, ymax = 80) +
    annotation_custom(grob = linesGrob(), xmin = 2.6, xmax = 2.75, ymin = 20, ymax = 20) +
    annotation_custom(grob = linesGrob(), xmin = 2.75, xmax = 2.75, ymin = 20, ymax = 80)

# Text 4
p1 = p1 + annotation_custom(grob = Text4,  xmin = 3, xmax = 3, ymin = 0, ymax = 15) +
    annotation_custom(grob = linesGrob(), xmin = 2.6, xmax = 2.75, ymin = 15, ymax = 15) +
    annotation_custom(grob = linesGrob(), xmin = 2.6, xmax = 2.75, ymin = 0, ymax = 0) +
    annotation_custom(grob = linesGrob(), xmin = 2.75, xmax = 2.75, ymin = 0, ymax = 15)

p1

# Code to override clipping
gt <- ggplot_gtable(ggplot_build(p1))
gt$layout$clip[gt$layout$name=="panel"] <- "off"
grid.draw(gt)