使用 ggplot 2 使用线条或线段将堆栈条形图与多个组连接起来

Question

我正在对一些患有某种疾病的患者进行一项研究，并在 3 个不同的时间点使用顺序量表评估功能状态。我想在这些时间点的堆叠条形图中连接多个组。

我查看了这些主题，但尚未使用这些建议使其发挥作用：

如何将线条放置在堆积条形图的边缘

有没有一种有效的方法可以使用 ggplot2 在堆积条形图中的不同元素之间绘制线条？

在堆积条形图中的不同元素之间绘制线条

请查看我最终希望该图如何从 R（在 PRISM 中生成）中看到三个时间点上这 6 个序数值中每一个的频率的图形表示（顶部组没有序数值为 3、5、6 的患者） ）：

使用 PRISM 的预期图形

数据：

library(tidyverse)

mrs <-tibble(
  Score = c(0,1,2,3,4,5,6),
  pMRS = c(17,  2,   1,  0,  1,  0,   0),
  dMRS = c(2,  3,   2,  6,  4,  2,  2),
  fMRS = c(4,  4,  5,  4,  1,  1,  2)

geom_line这是我到目前为止在使用或遇到问题之前尝试过的代码geom_segment（省略这些行，因为它只是扭曲了当前的数字）

mrs <- mrs %>% mutate(across(-Score,~paste(round(prop.table(.) * 100, 2)))) %>%
   pivot_longer(cols = c("pMRS", "dMRS", "fMRS"), names_to = "timepoint") %>% 
   mutate(Score=as.character(Score),
          value=as.numeric(value)) %>% 
   mutate(timepoint = factor(timepoint, 
                             levels= c("fMRS", 
                              "dMRS",
                              "pMRS"))) %>% 
   mutate(Score = factor(Score,
                         levels = c("6","5","4","3","2","1","0")))
mrs %>% ggplot(aes(y= timepoint, x= value, fill= Score))+
  geom_bar(color= "black", width = 0.6, stat= "identity") +
  scale_fill_manual(name= NULL,
                    breaks = c("6","5","4","3","2","1","0"), values=  c("#000000","#294e63", "#496a80","#7c98ac", "#b3c4d2","#d9e0e6","#ffffff"))+
  scale_y_discrete(breaks=c("pMRS",
                            "dMRS",
                            "fMRS"),
                   labels=c("Pre-mRS,  (N=21)",
                            "Discharge mRS,  (N=21)",
                            "Followup mRS,  (N=21)"))+
  theme_classic()

Answer 1

您实质上是在创建冲积图。您可以使用 ggalluvial 包。在所需的外观下方 - 我将其保持为水平方式，因为从左到右读取时间点更自然（至少在西方社会）。coord_flip但如果您确实愿意，可以简单地添加。

另外 - 请参阅下面的建议，我个人认为更引人注目的可视化。

检查以下来源以获取有关冲积图的更多信息

• https://corybrunson.github.io/2019/09/13/flow-taxonomy/
• https://matthewdharris.com/2017/11/11/a-brief-diversion-into-static-alluvial-sankey-diagrams-in-r/

library(tidyverse)
library(ggalluvial)

# I personally prefer to create a new object when you do data modifications
mrs_long <- 
  mrs %>% mutate(across(-Score,~paste(round(prop.table(.) * 100, 2)))) %>%
  pivot_longer(cols = c("pMRS", "dMRS", "fMRS"), names_to = "timepoint") %>% 
  mutate(Score=as.character(Score),
         value=as.numeric(value),
         ## I've reversed the level order
         timepoint = factor(timepoint, levels= rev(c("fMRS", "dMRS", "pMRS"))),
         Score = factor(Score, levels = 6:0))

ggplot(mrs_long,
       aes(y = value, x = timepoint)) +
  geom_flow(aes(alluvium = Score), alpha= .9, 
            lty = 2, fill = "white", color = "black",
            curve_type = "linear", 
            width = .5) +
  geom_col(aes(fill = Score), width = .5, color = "black") +
  scale_fill_manual(NULL, breaks = 6:0,
                    values=  c("#000000","#294e63", "#496a80","#7c98ac", "#b3c4d2","#d9e0e6","#ffffff"))+
  scale_y_continuous(expand = c(0,0)) +
  cowplot::theme_minimal_hgrid()
#> Warning: The `.dots` argument of `group_by()` is deprecated as of dplyr 1.0.0.
#> This warning is displayed once every 8 hours.
#> Call `lifecycle::last_lifecycle_warnings()` to see where this warning was generated.

可以说更引人注目——我发现通过充分利用“冲积层外观”可以更好地传达信息。例如，这可能如下所示：

library(tidyverse)
library(ggalluvial)

# I personally prefer to create a new object when you do data modifications
mrs_long <- 
  mrs %>% mutate(across(-Score,~paste(round(prop.table(.) * 100, 2)))) %>%
  pivot_longer(cols = c("pMRS", "dMRS", "fMRS"), names_to = "timepoint") %>% 
  mutate(Score=as.character(Score),
         value=as.numeric(value),
         ## I've reversed the level order
         timepoint = factor(timepoint, levels= rev(c("fMRS", "dMRS", "pMRS"))),
         Score = factor(Score, levels = 6:0))

ggplot(mrs_long,
       aes(y = value, x = timepoint)) +
  geom_flow(aes(alluvium = Score), alpha= .9, 
            lty = 2, fill = "white", color = "black",
            curve_type = "linear", 
            width = .5) +
  geom_col(aes(fill = Score), width = .5, color = "black") +
  scale_fill_manual(NULL, breaks = 6:0,
                    values=  c("#000000","#294e63", "#496a80","#7c98ac", "#b3c4d2","#d9e0e6","#ffffff"))+
  scale_y_continuous(expand = c(0,0)) +
  cowplot::theme_minimal_hgrid()
#> Warning: The `.dots` argument of `group_by()` is deprecated as of dplyr 1.0.0.
#> This warning is displayed once every 8 hours.
#> Call `lifecycle::last_lifecycle_warnings()` to see where this warning was generated.