如何在ggplot2中的图例旁边添加汇总统计信息？

Question

我有以下模拟数据

    library(fitdistrplus)
values <- sample(20:50, 100, replace = TRUE)
df <- data.frame(values)

我想创建一个直方图如下

create_histogram <- function(data_set, column_name, bins_number) {
  colname     <- as_label(enquo(column_name))
  
  # Calculate summary statistics
  summary_stats <- data.frame(
    mean = mean(data_set[[colname]]),
    max = max(data_set[[colname]]),
    min = min(data_set[[colname]])
  )
  
  ggplot(data_set, aes(x = {{ column_name }})) +
    geom_histogram(aes(y = after_stat(density)), bins = bins_number, fill = "lightblue", colour = "black") +
    stat_function(fun = dnorm , args = list(mean = mean(data_set[[colname]]), sd = sd(data_set[[colname]])),
                  mapping = aes(colour = "Normal")) +
    scale_colour_manual("Distribution", values = c("red")) +
    annotate("text", x = Inf, y = Inf, hjust = 1.1, vjust = 1.1,
             label = paste("Mean:", round(summary_stats$mean, 2), "\nMax:", round(summary_stats$max, 2), "\nMin:", round(summary_stats$min, 2)))
}

create_histogram(df, values, 15)

我的代码运行得很好。结果是这样的

我的问题：如果您注意的话，我目前正在图表的右上角显示汇总统计数据。如果可能的话，我喜欢做的就是在图例下方（图表之外）显示这些汇总统计数据（平均值、最大值、最小值），这样我的图表就不会被信息所束缚。在ggplot中可以实现这一点吗？

Answer 1

至少我可以带你走一段路。在您的函数中，您可以制作没有注释的 ggplot（我在下面将其称为

g

）。接下来，您可以通过调用

gb <- ggplot_build(g)

并从布局中拉出相关部分来获取 x 轴和 y 轴范围。然后，您可以通过转置汇总统计数据来制作

tableGrob()

。最后，您可以使用

annotation_custom()

将表格添加到图中。我不太擅长的是如何确保你得到“正确”的范围来粘贴桌子上的东西。这将取决于绘图窗口的大小。

library(tidyverse)
library(fitdistrplus)
values <- sample(20:50, 100, replace = TRUE)
df <- data.frame(values)

create_histogram <- function(data_set, column_name, bins_number) {
  require(gridExtra)
  colname     <- as_label(enquo(column_name))
  weibull_par <- fitdist(data_set[[colname]], "weibull")
  # Calculate summary statistics
  summary_stats <- data.frame(
    mean = mean(data_set[[colname]]),
    max = max(data_set[[colname]]),
    min = min(data_set[[colname]])
  )
  
  g <- ggplot(data_set, aes(x = values)) +
    geom_histogram(aes(y = after_stat(density)), bins = 15, fill = "lightblue", colour = "black") +
    stat_function(fun = dnorm , args = list(mean = mean(data_set[["values"]]), sd = sd(data_set[["values"]])),
                  mapping = aes(colour = "Normal")) +
    stat_function(fun = dweibull, args = list(shape = weibull_par$estimate[[1]], scale = weibull_par$estimate[[2]]),
                  mapping = aes(colour = "Weibull")) +
    scale_colour_manual("Distribution", values = c("red", "blue")) 
  gb <- ggplot_build(g)
  xrg <- gb$layout$panel_params[[1]]$x.range
  yrg <- gb$layout$panel_params[[1]]$y.range
  tgr <- tableGrob(t(summary_stats))
  g +
    annotation_custom(tgr, 
             xmin = xrg[2] , 
             xmax = xrg[2] + .2*diff(xrg), 
             ymin = yrg[1], ymax = yrg[1]+.02) 
}

create_histogram(df, values, 15)

^{创建于 2024-01-30，使用 reprex v2.0.2}