如何置换 data.frame 列表并在 ggplot2 中创建其带注释的堆栈条图？

Question

我有需要首先排列的 data.frame 列表，并为每个 data.frame 创建带注释的堆栈条图。我已经在 SO 中搜索了相关的帖子，并知道了如何去做。但是，我给出了如何按预期进行此操作的方法，但是如果 data.frame 相当大，我的代码会很慢，而不需要获取堆栈条图。所以我一直在阅读 ggplot2' 小插图以获得解决方案。我坚持以所需的方式排列 data.frame 列表。如何置换 data.frame 列表并创建其带注释的堆栈条图？谁能告诉我如何轻松有效地做到这一点？如何操作 data.frame 列表并获得带注释的堆积条形图（观察次数，标签）？提前致谢

可重现的data.frame：

confirmedDF <- list(
  bar = data.frame(begin=seq(2, by=11, len=25), end=seq(8, by=11, len=25), score=sample(54,25)),
  cat = data.frame(begin=seq(5, by=8, len=35), end=seq(9, by=8, len=35), score=sample(45,35)),
  foo = data.frame(begin=seq(8, by=13, len=25), end=seq(17, by=13, len=25), score=sample(49,25))
)

discardedDF <- list(
  bar = data.frame(begin=seq(3, by=12, len=40), end=seq(8, by=12, len=40), score=sample(72,40)),
  cat = data.frame(begin=seq(9, by=15, len=50), end=seq(17, by=15, len=50), score=sample(60,50)),
  foo = data.frame(begin=seq(21, by=19, len=30), end=seq(32, by=19, len=30), score=sample(42,30))
)

然后是我的 data.frame 输入列表：

library(tidyverse)
library(magrittr)

names(confirmedDF) <- paste("confirmed", names(confirmedDF), sep = ".")
names(discardedDF) <- paste("discarded", names(discardedDF), sep = ".")
merged <- do.call(rbind, c(confirmedDF, discardedDF))
merged %<>% rownames_to_column(var = "cn")
merged %<>% separate(cn, c("list", "letters", "seq"), sep = "\\.")
merged %<>% mutate(stringency = ifelse(score >= 12, "Stringent", "Weak"))

res <- merged %>% split(list(.$letters, .$stringency, .$list))

我尝试获取每个单独的堆栈条图，简单代码如下：

library(dplyr)
library(ggplot2)

lapply(res, function(ele_) {
  plot_data <- ele_ %>%
    group_by(sample, stringency, list) %>%
    tally %>%
    group_by(sample, stringency) %>%
    mutate(percentage = n / sum(n), cumsum = cumsum(percentage))

  ggplot(data = plot_data, aes(x = sample,  y= n ,fill = stringency)) + 
    geom_bar(position = "dodge",stat = "identity")
})

我不明白使用 lapply 来获取每个条形图非常缓慢且效率低下。上面的琐碎代码没有给出我想要的条形图。如何优化代码？如何置换 data.frame 列表并获取其带注释的条形图？

如何实现我想要的输出堆栈条图？有什么想法吗？

Answer 1

你可以试试这个：

res %>% 
  bind_rows %>% 
  group_by(stringency, list, sample) %>% 
  tally %>% 
  ungroup %>% 
  setNames(c("var", "val", "sample", "n")) %>% 
  {bind_rows(., setNames(., c("val", "var", "sample", "n")))} %>% 
  ggplot(aes(x=var, y=n, fill=val)) + 
  geom_col() + 
  geom_text(aes(label=n), position=position_stack(vjust = 0.5)) + 
  facet_wrap(~sample)