R 上 ggplot2 的样本大小的辅助 x 轴标签

我正在尝试使用 R 中的 ggplot2 复制我在 Excel 中制作的以下图表：

我能够使用 geom_line() 成功创建线条，使用 geom_text() /一些手动调整创建标签，以及 y 轴。在下面找到我的代码：

library(readxl)
library(ggplot2)

somedata <- read_excel("somedata.xlsx")
somedata[,c(3:6)] <- somedata[,c(3:6)] * 100
somedata[,6] <- somedata[,6] + 25 

somegraph <- ggplot(data = somedata, aes(x = date))
somegraph + 
  geom_point(aes(y = eligible_main), shape = 15, size = 4) + 
  geom_line(aes(y = eligible_main)) + 
  geom_line(aes(y = eligible_center), size = 2) + 
  geom_line(aes(y = eligible_upper), linetype = 2) + 
  geom_line(aes(y = eligible_lower), linetype = 2) + 
  scale_y_continuous(limits = c(0, 100), breaks = seq(0, 100, 10), labels = paste0(seq(0, 100, 10), "%")) + 
  labs(title = "Title", x = "Time", y = "Percentage") + theme_classic() + 
  theme(plot.title = element_text(hjust = 0.5), axis.text.x = element_text(angle = 90, hjust = 1))

作为参考，这里是我创建的一些假数据，其格式与我正在绘制的数据类似。您可以将其粘贴到 R 中并在控制台中运行上面的代码：http://s000.tinyupload.com/?file_id=43876540434394267818

但我发现很难在 x 轴上以相同方向创建样本大小的辅助标签。 ggplot2 或其他包是否有一个简单的解决方案？另外，我可以在图表上添加注释线以在完成后指出问题吗？

非常感谢！

我有一个可能有帮助的解决方案。我无法获取您共享的数据，我创建了自己的虚拟数据集，如下所示：

set.seed(12345)
library(lubridate)

df <- data.frame(
  dates=as.Date('2020-03-01')+days(0:9),
  y_vals=rnorm(10, 50,7),
  n=100
)

一、基本剧情：

library(scales)
library(ggrepel)    
p.basic <- ggplot(df, aes(dates, y_vals)) +
        geom_line() +
        geom_point(size=2.5, shape=15) +
        geom_text_repel(
            aes(label=paste0(round(y_vals, 1), '%')),
            size=3, direction='y', force=7) +
        ylim(0,100) +
        scale_x_date(breaks=date_breaks('day'), labels=date_format('%b %d')) +
        theme_bw()

请注意，我的代码与您的代码有点不同。文本标签通过ggrepel包裹。我还使用了一些函数scales修复和设置日期轴的格式（另请注意lubridate是用于在上面的虚拟数据集中创建日期的包）。否则，相当标准ggplot那里的东西。

对于轴外的文本，最好的方法是通过自定义注释，您必须在其中设置 grob。这里的做法如下：

• “向下”移动轴以便为额外文本留出空间。我们通过在轴标题顶部设置边距来实现这一点。

• 关闭剪辑通过coord_cartesian(clip='off')。这是为了通过允许在绘图区域之外绘制事物来查看绘图之外的注释所必需的。

• 循环遍历以下值df$n，创建一个单独的annotation_custom通过以下方式将对象添加到绘图中for loop.

这是代码：

p <- p.basic +
    theme(axis.title.x = element_text(margin=margin(50,0,0,0))) +
    coord_cartesian(clip='off')

for (i in 1:length(df$n)) {
  p <- p + annotation_custom(
    textGrob(
      label=paste0('n=',df$n[i]), rot=90, gp=gpar(fontsize=9)),
      xmin=df$dates[i], xmax=df$dates[i], ymin=-25, ymax=-15
    )
}
p

高级选项带来更多乐趣

还有两件事需要添加：注释（例如特定点+文本的标注），以及轴标签内容之间的绘图下方的线条。

对于轴下方的线：你可以加breaks=通过相当容易地连接到其他轴scale_...和breaks=范围;然而，对于日期轴来说，它......很复杂。这就是为什么我们将使用与上面相同的方法为轴下方的文本添加线条。这里的想法是将轴分解为sub.div下面代码中的段，它基于 x 轴上有多少个离散值。我可以内联执行几次......但首先创建变量很有趣：

sub.div <- 1/length(df$n)

然后，我使用它通过沿步骤单独注释线条来创建线条sub.div*i用一个for再次循环：

for (i in 1:(length(df$n)-1)) {
  p <- p + annotation_custom(
    linesGrob(
      x=unit(c(sub.div*i,sub.div*i), 'npc'),
      y=unit(c(0,-0.2), 'npc')   # length of the line below axis
    )
  )
}

我意识到这里的两端没有线条，但您可能会看到通过修改上面的方法来添加它是多么容易。

注释（带箭头，为什么不呢？）：有很多方法可以进行注释。其中一些内容已涵盖在此处使用annotate()功能。以及这里。您可以使用annotate()如果你愿意的话，但在这个例子中，我将使用geom_label对于文本标签和geom_curve制作一些弯曲的箭头。

您可以手动传递个人aes()通过调用每个注释的两个函数来获取值。例如，geom_text(aes(x=as.Date('2020-03-01'), y=55,...，但是如果数据集中有一些注释，建议根据数据帧本身内的信息设置注释。我将首先在这里执行此操作，我们将标记其中两点：

df$notes <- c('','','','Wow!','','','OMG!!!','','','')

您可以使用以下值df$notes来指示哪些点被标记，并利用x and y同一数据集中的值。

然后，您只需将两个几何图形添加到您的绘图中，并根据您的需要进行修改以适应您自己的审美。

p <- p + geom_curve(
    data=df[which(df$notes!=''),],
    mapping=aes(x=dates+0.5, xend=dates, y=y_vals+20, yend=y_vals+2),
    color='red', curvature = 0.5,
    arrow=arrow(length=unit(5,'pt'))
  ) +
  geom_label(
    data=df[which(df$notes!=''),],
    aes(y=y_vals+20, label=notes),
    size=4, color='red', hjust=0
  )

最后一件事：水平线我之前在您的代码中注意到但忘记指出的最后一件事是，要制作水平线，只需使用geom_hline。这容易多了。另外，您可以通过两次调用来完成此操作geom_hline非常容易（如果您愿意将数据帧传递给函数，甚至只需一次调用）：

p <- p + geom_hline(yintercept = 50, size=2, color='gray30') +
  geom_hline(yintercept = c(25,75), linetype=2, color='gray30')

请注意，建议添加这两个geom_hline calls before geom_line or geom_point在原来的p.basic阴谋所以他们落后于一切。