使用ggplot2將帶有多個組的堆疊條形圖與線或段連接起來

我正在對一些患有某種疾病的患者進行研究，并在 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_lineor遇到問題之前嘗試過的代碼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()

uj5u.com熱心網友回復：

我認為沒有一種簡單的方法可以做到這一點，您必須自己（半）手動添加這些行。我在下面提出的建議來自這個答案，但適用于您的情況。geom_area()從本質上講，它利用了像條形圖一樣可堆疊的事實。缺點是您必須手動輸入條形開始和結束位置的坐標，并且您必須為每對堆疊的條形進行此操作。

library(tidyverse)

# mrs <- tibble(...) %>% mutate(...) # omitted for brevity, same as question

mrs %>% ggplot(aes(x= value, y= timepoint, fill= Score)) 
  geom_bar(color= "black", width = 0.6, stat= "identity")  
  geom_area(
    # Last two stacked bars
    data = ~ subset(.x, timepoint %in% c("pMRS", "dMRS")),
    # These exact values depend on the 'width' of the bars
    aes(y = c("pMRS" = 2.7, "dMRS" = 2.3)[as.character(timepoint)]),
    position = "stack", outline.type = "both", 
    # Alpha set to 0 to hide the fill colour
    alpha = 0, colour = "black",
    orientation = "y"
  )  
  geom_area(
    # First two stacked bars
    data = ~ subset(.x, timepoint %in% c("dMRS", "fMRS")),
    aes(y = c("dMRS" = 1.7, "fMRS" = 1.3)[as.character(timepoint)]),
    position = "stack", outline.type = "both", alpha = 0, colour = "black",
    orientation = "y"
  )  
  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()

可以說，為線條制作單獨的 data.frame 更直接，但也有點混亂。

uj5u.com熱心網友回復：

您實際上是在創建一個沖積圖。您可以使用 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.

可以說更引人注目——我發現通過充分利用“沖積層外觀”可以更好地傳達資訊。例如，這可能如下所示：

ggplot(mrs_long,
       aes(y = value, x = timepoint, fill = Score))  
  geom_alluvium(aes(alluvium = Score), alpha= .9, 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()

標籤：

上一篇：在圖例中分離geom_point和geom_line

下一篇：使用position_dodge2居中stat_summary誤差條