使用 Purrr 过滤数据集并使用 ggplot 绘制一系列图形(在 RMarkdown 中,用于 Shiny)

Using Purrr to filter a dataset and plot a series of graphs using ggplot (in RMarkdown, for Shiny)

背景:我想制作一个 Shiny 应用程序,不使用 R 且未安装 R 的同事可以上传 .csv 文件,然后下载该应用程序生成的报告,使用他们的网页浏览器。该报告将是一个可编辑的 word 文件,其中将包括为提供的数据集中每个不同组绘制的图表(由特定列中的标识符表示)。

同事将上传一个或多个 .csv 文件,其中包含多个具有相同列标题的数据集。理想情况下,这些将使用 rbind 或类似的方法组合成一个数据帧。

然后 Shiny 应用程序将初始化 RMarkdown 报告,它将识别特定列中的所有不同标识符,我想在 purrr/map 命令中使用它来按每个标识符过滤数据集,并绘制每个在 ggplot 中的图表。每个图上方还应该有一个标题,每个图下方有一段文字,这也需要通过迭代函数产生。

我已将到目前为止的内容放在下面(并在此过程中尝试了各种其他排列和命令)。我设法得到类似下面的函数来只绘制图形,但想修改它以便三个函数(写 header、绘制图形、写句子)对列表中的每个项目在脚本移动到下一个项目,并且正在努力解决这个问题。我也无法让该函数与 ggplot 序列末尾的 annotate 和 xlim 命令一起使用,但如果它们也能工作,那将非常有帮助。

如有任何帮助或建议,我们将不胜感激。非常感谢。


  plot <- function(x) {
    report.data %>% 
      filter(identifier == .data[[.x]]) %>% 
      ggplot(aes(x = sample.no, y = result)) +
      geom_point(aes(colour = analyser)) +
      geom_hline(aes(yintercept = mean(result) + 2 * sd(result)), colour = "red", linetype = "dashed") +
      geom_hline(aes(yintercept = mean(result) - 2 * sd(result)), colour = "red", linetype = "dashed") +
      xlab("Sample number") +
      ylab("Result") +
      theme_classic() #+
      #annotate("text", x = max(sample.no) + 2, y = mean(result), size = 3.5) +
      #xlim(0, max(sample.no) + 2)
  }   
  
funs <- c(
  header, 
  plot, 
  text
)

args <- list(unique(report.data$identifier))
report.data %>% map_df(~funs %>% map(exec, .x, !!!args))

生成示例输入数据的代码:

library(dplyr)
set.seed(1234)

test1.level1.analyser1 <- data.frame(
  result = rnorm(25, mean = 2.5, sd = 0.2), 
  test = c("test1"), 
  level = c("level1"), 
  sample.no = c(1:25), 
  analyser = c("analyser1")
  )

test1.level1.analyser2 <- data.frame(
  result = rnorm(25, mean = 2.6, sd = 0.1), 
  test = c("test1"), 
  level = c("level1"), 
  sample.no = c(1:25), 
  analyser = c("analyser2")
  )

test1 <- rbind(test1.level1.analyser1, test1.level1.analyser2)

test2.level1.analyser1 <- data.frame(
  result = rnorm(25, mean = 10, sd = 2), 
  test = c("test2"), 
  level = c("level1"), 
  sample.no = c(1:25), 
  analyser = c("analyser1")
  )

test2.level1.analyser2 <- data.frame(
  result = rnorm(25, mean = 9.5, sd = 0.75), 
  test = c("test2"), 
  level = c("level1"), 
  sample.no = c(1:25), 
  analyser = c("analyser2"))

test2.level2.analyser1 <- data.frame(
  result = rnorm(25, mean = 30, sd = 1.8), 
  test = c("test2"), 
  level = c("level2"), 
  sample.no = c(1:25), 
  analyser = c("analyser1")
  )

test2.level2.analyser2 <- data.frame(
  result = rnorm(25, mean = 9.5, sd = 0.75), 
  test = c("test2"), 
  level = c("level2"), 
  sample.no = c(1:25), 
  analyser = c("analyser2"))
test2.level1 <- rbind(test2.level1.analyser1, test2.level1.analyser2)

test2 <- rbind(test2.level1.analyser1, test2.level1.analyser2, test2.level2.analyser1, test2.level2.analyser2)

input.data <- rbind(test1, test2) %>% mutate(identifier = paste(test, level, sep = " ")) 

是否可以将图表上方的各个标题和图表下方的句子直接集成到 ggplot 中?在那种情况下,我建议像这样修改绘图函数:

library(ggplot2)
library(dplyr)
library(purrr)

my_plot <- function(df) {
    ggplot(df, aes(x = sample.no, y = result)) +
    geom_point(aes(colour = analyser)) +
    geom_hline(aes(yintercept = mean(result) + 2 * sd(result)), colour = "red", linetype = "dashed") +
    geom_hline(aes(yintercept = mean(result) - 2 * sd(result)), colour = "red", linetype = "dashed") +
    theme_classic() +
    labs(
      # the title above the plot, based on information in the filtered df
      title = paste0("some title for identifier:  ", unique(df$identifier)),
      x = "Sample number",
      y = "Result",
      # the text below, based on data in the filtered data frame
      caption = paste0("A short sentence about the mean result (", round(mean(df$result), 2), ") below the plot.")
    ) +
    coord_cartesian(xlim = c(0, max(df$sample.no) + 2)) +    
    theme(
      # configure the caption / sentence below
      plot.caption=element_text(size=12, hjust = 0, margin = margin(t=20)),
      # add some buffer at bottom as spacing between plots
      plot.margin = margin(b=50)
    )
}

plot_list <- purrr::map(unique(input.data$identifier),
                           function(x) {
                             # filter data before passing it to the plot function
                             input.data %>% 
                               dplyr::filter(identifier == x) %>%
                               my_plot()
                           }
                       )

它会生成一个绘图列表,然后可以像这样打印在 Rmd 块中。

```{r}
purrr::map(plot_list, ~plot(.x))