R ggplot - 无法弄清楚如何添加带有密度曲线的直方图

Question

我已经研究通用绘图函数有一段时间了，它几乎完成了我想要它向我展示的所有内容，但是我无法让它与密度曲线一起显示直方图。

我当前的代码：

library(dplyr)
library(ggplot2)
library(ggridges)
library(PupillometryR)
library(tidyr)
library(moments)

raincloud_summary <- function(dataframe, variable, grouping_variable = NULL) {
  text_vjust = 1
  add_legend <- !is.null(grouping_variable) && grouping_variable %in% names(dataframe)
  
  if (!add_legend) {
    dataframe$grouping <- "Overall"
    grouping_variable <- "grouping"
  }
  
  lower_limit <- quantile(dataframe[[variable]], probs = 0.0, na.rm = T)
  upper_limit <- quantile(dataframe[[variable]], probs = 1.0, na.rm = T)
  
  p <- ggplot(dataframe, aes_string(y = variable, fill = grouping_variable, x = grouping_variable)) +
    geom_flat_violin(kernel = "gaussian", bw = "nrd0", position = position_nudge(x = 0.15, y = 0), adjust = 1, trim = F) +
    stat_boxplot(geom ='errorbar', width = 0.1) +
    geom_boxplot(width = 0.15, outlier.shape = 1, stat = "boxplot", show.legend = F) +
    stat_summary(fun = mean, geom = "point", shape = 18, size = 3, color = "white", show.legend = F) +
    scale_y_continuous(limits = c(lower_limit, upper_limit)) +
    theme_minimal() +
    theme(text = element_text(size=11),
          plot.title = element_text(hjust = 0.5),
          axis.text.x = if(add_legend) element_text(hjust = -1) else element_blank(),
          legend.position = if (add_legend) "right" else "none") +
    labs(fill = if (add_legend) grouping_variable else NULL, x = NULL) +
    ggtitle(variable) +
    scale_fill_brewer(palette = "Pastel1", guide = if (add_legend) "legend" else "none",
                      limits = rev(levels(factor(dataframe[[grouping_variable]]))))
  
  p <- p + coord_flip() +
    theme(axis.text.x = element_text(angle = 0, vjust = 0.5),
          axis.text.y = element_text(angle = 0, hjust = 1))
  
  group_stats <- dataframe %>%
    group_by(!!sym(grouping_variable)) %>%
    summarise(
      `Min.` = min(!!sym(variable), na.rm = T),
      `Q1` = quantile(!!sym(variable), probs = 0.25, na.rm = T),
      `Median (Q2)` = median(!!sym(variable), na.rm = T),
      Mean = mean(!!sym(variable), na.rm = T),
      `Q3` = quantile(!!sym(variable), probs = 0.75, na.rm = T),
      `Max.` = max(!!sym(variable), na.rm = T),
      IQR = IQR(!!sym(variable), na.rm = T),
      SD = sd(!!sym(variable), na.rm = T),
      Variance = var(!!sym(variable), na.rm = T),
      Skewness = skewness(!!sym(variable), na.rm = T),
      Kurtosis = kurtosis(!!sym(variable), na.rm = T),
      Count = n(),
      .groups = "drop"
    ) %>%
    pivot_longer(-grouping_variable, names_to = "stat", values_to = "value") %>%
    mutate(value = round(value, 2))
  print(group_stats)
  group_levels <- levels(factor(dataframe[[grouping_variable]]))
  x_positions <- setNames(seq_along(group_levels)-0.05, group_levels)
  for (group in group_levels) {
    left_labels <- group_stats %>%
      filter(!!sym(grouping_variable) == group, stat %in% c("Min.", "Q1", "Median (Q2)", "Mean", "Q3", "Max.")) %>%
      mutate(label = paste(stat, ": ", value, sep="")) %>%
      pull(label) %>%
      paste(collapse = "\n")
    
    right_labels <- group_stats %>%
      filter(!!sym(grouping_variable) == group, stat %in% c("IQR", "SD", "Variance", "Skewness", "Kurtosis", "Count")) %>%
      mutate(label = paste(stat, ": ", value, sep="")) %>%
      pull(label) %>%
      paste(collapse = "\n")
    
    gap <- (upper_limit - lower_limit) / 5
    p <- p + annotate("text", x = x_positions[group] + 1, y = lower_limit, label = left_labels,
                      hjust = 0, vjust = text_vjust, size = 3, parse = F)
    p <- p + annotate("text", x = x_positions[group] + 1, y = lower_limit + gap, label = right_labels,
                      hjust = 0, vjust = text_vjust, size = 3, parse = F)
  }
  
  dataframe$grouping <- NULL
  print(p)
  return(group_stats)
}

使用示例：

data(iris)
raincloud_summary(iris, "Sepal.Width", "Species")

电流输出： 不带直方图的绘图

期望的直方图输出应该是这样的： 带密度曲线的基本直方图

非常感谢您的帮助！ 😊

Answer 1

我同意 GuedesBF 的观点——似乎没有理由让这件事变得如此复杂。对我来说，图中的统计注释会造成很多混乱。根据绘图大小和输出图像大小，文本也将变得很难格式化。如果统计数据对故事很重要，我会推荐另一种非常简单的方法来获取雨云图，并包含一个并排表格。

library(tidyverse)
library(ggrain)

data(iris)
iris %>%
    ggplot(aes(x = Species, y = Sepal.Width, fill = Species)) +
    geom_rain()

结果

^{创建于 2024-05-05，使用 reprex v2.1.0}