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$layoutand grid.draw。

在 ggplot2 生成的图下方显示文本

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

Answer 1

更新

使用的原始解决方案annotation_custom，但一个问题annotation_custom是它在所有面板中绘制注释。但是，通过简单的修改，annotation_custom可以只在一个面板中绘制（取自 Baptiste's answer 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)

原始解决方案

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

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)

Answer 2

更新 opts已被弃用；改为使用theme。

这是另一个解决方案。它解决了annotation_custom()在两个面板中绘制 grobs 的问题。它绘制了两个图表：第一个是您的条形图；第二个仅包含注释。grid.arrange()然后从gridExtra包装中将两者放在一起。但是，您的折线问题仍然存在。

在两个图中仍然存在使 y 轴比例相同的问题。但只要小心，就可以做到。在包含注释的图中，请注意可能对 y 轴刻度产生影响的元素如何未被删除（通过theme_blank()，而是隐藏（使用colour = NA）。

library(ggplot2)
library(gridExtra)
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))

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

p1 <- p1 + ylim(0, 100)

# The empty plot to contain the annotations
p2 = ggplot(data.frame(x = c(1,2), y = c(0,100), z = c(1,1)), aes(x,y)) + theme_bw() + facet_wrap(~ z) +
   theme(axis.title.y = element_blank(),
        axis.title.x = element_text(colour = NA),
        axis.text.y = element_blank(),
        axis.text.x = element_text(colour = NA),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        axis.ticks = element_line(colour = NA),
        panel.border = element_rect(colour = NA),
        strip.background = element_rect(colour = NA, fill = NA),
        strip.text.x = element_text(colour = NA), 
        plot.margin = unit(c(1,0,2,0), "lines"))


# The annotations
Text1 = textGrob("Text 1")
Text2 = textGrob("Text 2")
Text4 = textGrob("Text 4")

p2 = p2 + annotation_custom(grob = Text1,  xmin = 1.4, xmax = 1.4, ymin = 85, ymax = 100) +
        annotation_custom(grob = linesGrob(), xmin = 1, xmax = 1.1, ymin = 100, ymax = 100) +
        annotation_custom(grob = linesGrob(), xmin = 1, xmax = 1.1, ymin = 85, ymax = 85) +
        annotation_custom(grob = linesGrob(), xmin = 1.1, xmax = 1.1, ymin = 85, ymax = 100)

p2 = p2 + annotation_custom(grob = Text2,  xmin = 1.4, xmax = 1.4, ymin = 20, ymax = 80) +
        annotation_custom(grob = linesGrob(), xmin = 1, xmax = 1.1, ymin = 80, ymax = 80) +
        annotation_custom(grob = linesGrob(), xmin = 1, xmax = 1.1, ymin = 20, ymax = 20) +
        annotation_custom(grob = linesGrob(), xmin = 1.1, xmax = 1.1, ymin = 20, ymax = 80)

p2 = p2 + annotation_custom(grob = Text4,  xmin = 1.4, xmax = 1.4, ymin = 0, ymax = 15) +
        annotation_custom(grob = linesGrob(), xmin = 1, xmax = 1.1, ymin = 15, ymax = 15) +
        annotation_custom(grob = linesGrob(), xmin = 1, xmax = 1.1, ymin = 0, ymax = 0) +
        annotation_custom(grob = linesGrob(), xmin = 1.1, xmax = 1.1, ymin = 0, ymax = 15)

# Putting the two plots together
plot = arrangeGrob(p1, p2, ncol = 2, widths = unit(c(10, 2), c("null", "null")))
grid.draw(plot)

Answer 3

我使用此链接中的代码添加了行/文本： Using grconvertX/grconvertY in ggplot2。这种方法使用 grid.text 和 grid.lines 而不是 grobs。我不确定哪种方法更好。

我认为 grid.lines 可以合并到 grid.polyline 语句中，也可以通过循环完成。x 和 y 位置可以设置为一个变量，而不是在每一行中硬编码。

唯一可能的复杂情况是将比例传递到视口。但是，只要在 GGPLOT 和视口中使用相同的比例，此代码就可以工作。请注意，视口使用绘图的整个高度作为 0 到 100。

library (ggplot2)
library(grid)
library(gridBase)

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

current.vpTree()
downViewport('panel-4-6')
pushViewport(dataViewport( yscale=c(0,100), clip='off',xscale=c(0,1)))

grid.text(x=1.21,  y = 90, default.units='native' ,label="Text 1")
grid.text(x=1.21,  y = 55, default.units='native' ,label="Text 2")
grid.text(x=1.21,  y = 10, default.units='native' ,label="Text 3")

grid.lines(x=c(1.02,1.12), y = c(95,95), default.units='native' )
grid.lines(x=c(1.02,1.12), y = c(85, 85), default.units='native' )
grid.lines(x=c(1.12,1.12), y = c(85, 95), default.units='native' )

grid.lines(x=c(1.02,1.12), y = c(80, 80), default.units='native' )
grid.lines(x=c(1.02,1.12), y = c(20, 20), default.units='native' )
grid.lines(x=c(1.12,1.12), y = c(80, 20), default.units='native' )

grid.lines(x=c(1.02,1.12), y = c(5, 5), default.units='native' )
grid.lines(x=c(1.02,1.12), y = c(15, 15), default.units='native' )
grid.lines(x=c(1.12,1.12), y = c(5, 15), default.units='native' )

对任何格式问题表示歉意 - 我只是粘贴了我的代码并使用代码按钮缩进它。