【原】復(fù)現(xiàn)Nature圖表：ggplot2-臨床資料泳道圖/時(shí)間軸圖

TS的美夢 2025-04-14

展開全文

需要者詳情請聯(lián)系作者（非需要者勿擾，我很社恐）：

精彩內(nèi)容

1、購買打包合集（2025KS微信VIP付費(fèi)合集），價(jià)格感人，加入微信VIP群（答疑交流群，甚至有小伙伴覺得群比代碼更好），可以獲取建號以來所有內(nèi)容，群成員專享視頻教程，提前更新，其他更多福利！

2、《KS科研分享與服務(wù)》公眾號有QQ群，進(jìn)入門檻是20元（完全是為了防止白嫖黨，請理解），請考慮清楚。群里有免費(fèi)推文的注釋代碼和示例數(shù)據(jù)（終身擁有），沒有付費(fèi)內(nèi)容，群成員福利是購買單個(gè)付費(fèi)內(nèi)容半價(jià)！

很抱歉，很久前小伙伴提出的一個(gè)圖，最近又被發(fā)掘了，是兩篇Nature文章的圖，文章標(biāo)題再圖片里面！

原文圖片：

（reference：https://www./articles/s41586-023-05776-4#Sec17）

這圖看著很復(fù)雜，主要是因?yàn)槿思襫ature文章樣本量大，資料齊全，所以看起來很喔噻，至于圖并不陌生。左邊文章是華夫圖+泳道圖，右邊文章是熱圖+泳道圖。我們之前都演示過的（①復(fù)現(xiàn)NC文章華夫圖(方塊圖)-華麗展示實(shí)驗(yàn)樣本構(gòu)成，②復(fù)現(xiàn)《nature communications》圖表（三）：畫樣本時(shí)間軸圖（堆疊柱狀圖），③復(fù)現(xiàn)《Cell》圖表：雙側(cè)柱狀圖及坐標(biāo)軸設(shè)置|ComplexHeatmap圖例設(shè)置），這里組合一下就可以了。接下來具體看看演示。數(shù)據(jù)來源于第一篇Nature文章！數(shù)據(jù)經(jīng)過我的魔改！

首先plot左側(cè)華夫圖：

setwd('D:\\KS項(xiàng)目\\公眾號文章\\復(fù)現(xiàn)Nature-臨床資料圖')

library(tidyr)library(ggplot2)library(waffle)

#讀入數(shù)據(jù)data <- read.csv('clinic_data.csv', header = T)table(data$Adjuvant_status)
#為了演示作圖，這里就只節(jié)選了Feamle的數(shù)據(jù)data <- subset(data, Gender=='Female')
#--------------------------------------------------------------------------------#plot-華夫圖，plot兩個(gè)信息
unique(data$Histology)# [1] "Squamous cell carcinoma"             "Invasive adenocarcinoma"            # [3] "Adenosquamous carcinoma"             "Adenocarcinoma;Adenocarcinoma"      # [5] "Large Cell Neuroendocrine Carcinoma"
unique(data$TNM_stage_v7_path)# [1] "I"   "II"  "III"

#設(shè)置顏色，每個(gè)因子對應(yīng)的顏色col_group <- setNames(c("#B5C8E8",                                 "#4475C7",                                 "#1A3564",                                 "#F2B900",                                 "#FFE79A",                                 "#CD9AFF",                                 "#00B1F0",                                 "#79B84C"),                                 c("I",                                   "II",                                   "III",                                   "Squamous cell carcinoma",                                   "Invasive adenocarcinoma",                                   "Adenosquamous carcinoma",                                   "Adenocarcinoma;Adenocarcinoma",                                   "Large Cell Neuroendocrine Carcinoma"))#設(shè)定對應(yīng)顏色

data_waff <- data[,c("PublicationID","Histology","TNM_stage_v7_path")] %>%  pivot_longer(    cols = -PublicationID,             names_to = "group",         values_to = "variable"             ) 
data_waff$PublicationID <- as.factor(data_waff$PublicationID)data_waff$PublicationID <- factor(data_waff$PublicationID, levels = rev(data$PublicationID))

#ggplot結(jié)合waffle作圖ggplot(data_waff, aes(x = group, y = PublicationID, fill = variable)) +   geom_waffle()+#  theme(panel.background = element_blank(),        axis.title = element_blank(),        axis.ticks = element_blank(),        axis.line = element_line(colour = 'black',size = 1),#        legend.title = element_blank(),        legend.position = "none",#        axis.text.x = element_text(color = 'black',angle = 90, size = 10,hjust = 1, vjust = 0.5),        axis.text.y = element_text(color = 'black',size = 10))+  scale_x_discrete(expand = c(0, 0))+  coord_equal()+  scale_fill_manual("",values = col_group)

plot右側(cè)時(shí)間軸圖：關(guān)于時(shí)間軸的做法，也有專門的包：https://cran./web/packages/swimplot/vignettes/Introduction.to.swimplot.html，但是我覺得語法上也就是和ggplot2類似，所以不再介紹，感興趣自行查看，這里我們還是使用ggplot2簡單演示。就是添加點(diǎn)線而已！

data$PublicationID <- factor(data$PublicationID, levels = rev(data$PublicationID))
p2 = ggplot()+  geom_segment(data, mapping=aes(x = 0,xend = max(Time_DFS_from_surgery)+500, y = PublicationID, yend = PublicationID),stat = "identity", linetype = "dotted")+#plot貫穿的虛線  geom_point(data = data,aes(x = Time_DFS_from_surgery,y= PublicationID),size = 2,color = "#68AF78", stroke = 1.2, shape = 24)+#plot點(diǎn)，shape可以設(shè)置不同的形狀  geom_segment(data, mapping=aes(x = et1,xend = et2, y = PublicationID, yend = PublicationID),stat = "identity",color = "#8DD2DE", size = 1)+#plot連線  geom_point(data = data,aes(x = Size_mm,y= PublicationID),size = 2,color = 'black', shape = 19)+  geom_point(data = data,aes(x = medic,y= PublicationID),stroke = 1,color = 'black', shape = 1)+  geom_point(data = data,aes(x = OS,y= PublicationID),size = 2,color = "#F97B72", shape = 17)+  theme(panel.background = element_blank(),        axis.title = element_blank(),        axis.ticks.y = element_blank(),        legend.title = element_blank(),        legend.position = "none",        axis.text.y = element_blank())

組合在一起即可：

#拼圖
library(patchwork)
pp=p1+p2+plot_layout(ncol = 2, widths  = c(1, 12),guides = 'collect')pp & theme(plot.margin = margin(1,2,2,2),            legend.position = "top",            legend.direction = 'horizontal',            # legend.justification=c(0,1),            legend.key.width=unit(0.5,"cm"),            legend.key.height = unit(0.3, "cm"),            legend.title.position = 'top')