|
需要者詳情請(qǐng)聯(lián)系作者（非需要者勿擾，我很社恐）： 1、購(gòu)買(mǎi)打包合集（2025KS微信VIP付費(fèi)合集），價(jià)格感人，加入微信VIP群（答疑交流群，甚至有小伙伴覺(jué)得群比代碼更好），可以獲取建號(hào)以來(lái)所有內(nèi)容，群成員專(zhuān)享視頻教程，提前更新，其他更多福利！ 2、《KS科研分享與服務(wù)》公眾號(hào)有QQ群，進(jìn)入門(mén)檻是20元（完全是為了防止白嫖黨，請(qǐng)理解），請(qǐng)考慮清楚。群里有免費(fèi)推文的注釋代碼和示例數(shù)據(jù)（終身?yè)碛校?，沒(méi)有付費(fèi)內(nèi)容，群成員福利是購(gòu)買(mǎi)單個(gè)付費(fèi)內(nèi)容半價(jià)！ 前不久有小伙伴咨詢(xún)一個(gè)圖，希望能復(fù)現(xiàn)：這就很巧了，剛好是我要詳細(xì)解析circle作圖系列的時(shí)候，這不素材就來(lái)了嗎？上一期我們從環(huán)形熱圖入手，解析了circlize做環(huán)形圖的基本邏輯和一些參數(shù)（Circular Plot系列(一): 環(huán)形熱圖繪制）。circos.heatmap算是circlize中特定功能的一種函數(shù)，那么這一期我們學(xué)習(xí)的這個(gè)圖就覆蓋到更加廣泛的應(yīng)用plot，點(diǎn)線(xiàn)面以及文字設(shè)置。 圖片來(lái)源與一篇nature aging文章Figure1a，這篇文章的一個(gè)好處在于作者慷慨的提供了plot這個(gè)圖的完整代碼以及作圖數(shù)據(jù)（https://github.com/jaspershen-lab/ipop_aging）。我們直接在他的基礎(chǔ)稍微做些修改解析作圖，希望能夠得到啟發(fā)。這個(gè)圖展示的是臨床樣本信息，之所以用環(huán)形圖，是因?yàn)檫@個(gè)陣列有108人，如果按照傳統(tǒng)的plot，這個(gè)圖將會(huì)很長(zhǎng)，所以這時(shí)候circle plot的優(yōu)勢(shì)就體現(xiàn)了。這個(gè)圖不僅用環(huán)形圖展示了信息，創(chuàng)新的是在左側(cè)還做了統(tǒng)計(jì)，展示更加直觀(guān)，值得學(xué)習(xí)和借鑒。（reference: https:///10.1038/s43587-024-00692-2）首先我們復(fù)現(xiàn)左側(cè)的統(tǒng)計(jì)圖，這都是我們熟悉的ggplot作圖：#=====================================================================================setwd('D:\\KS項(xiàng)目\\公眾號(hào)文章\\circle系列繪圖\\2-復(fù)現(xiàn)Nature子刊環(huán)形圖展示臨床信息')data <- read.csv('na_clinic_data.csv', header = T, row.names = 1)data[data == ""] <- "NA"
library(circlize)library(ggplot2)
BMI和age的箱線(xiàn)散點(diǎn)圖：bmi <- data$BMI #獲取BMI數(shù)據(jù)
bmi_label <- data.frame("x" = rep('class',3), "y" = c(median(na.omit(bmi)), quantile(na.omit(bmi), 0.25), quantile(na.omit(bmi), 0.75)))
plot_bmi <- data$BMI %>% #提取BMI數(shù)據(jù)構(gòu)建數(shù)據(jù)框plot data.frame(class = "class", value = .) %>% ggplot(aes(x = class, y = value)) + geom_boxplot(outlier.shape = NA) + #箱線(xiàn)圖 geom_dotplot(binaxis = "y",color = "#FF0000", fill = "#FF0000",binwidth = 0.6, stackdir = "center") + #plot散點(diǎn) theme_bw() + labs(x = "", y = "", title = "BMI") + scale_x_discrete(expand = expansion(mult = c(0, 0))) + theme(panel.grid = element_blank(), axis.text = element_blank(), axis.ticks = element_blank(), plot.title = element_text(hjust = 0.5))+ geom_label(data = bmi_label, aes(x=x,y=y,label=y), label.size=NA, colour = "white",fill=alpha('grey80',0.8),size=4)
#Age 散點(diǎn)箱線(xiàn)圖---------------------------------------------------------------#age散點(diǎn)箱線(xiàn)圖和前面的bmi一樣的操作age <- data$Age #獲取age數(shù)據(jù)
age_label <- data.frame("x" = rep('class',3), "y" = c(median(na.omit(age)), quantile(na.omit(age), 0.25), quantile(na.omit(age), 0.75)))
plot_age <- data$Age %>% #提取數(shù)據(jù)構(gòu)建數(shù)據(jù)框plot data.frame(class = "class", value = .) %>% ggplot(aes(x = class, y = value)) + geom_boxplot(outlier.shape = NA) + #箱線(xiàn)圖 geom_dotplot(binaxis = "y",color = "#332288", fill = "#332288",binwidth = 0.6, stackdir = "center",dotsize = 2) + #plot散點(diǎn) theme_bw() + labs(x = "", y = "", title = "Age\n(year)") + scale_x_discrete(expand = expansion(mult = c(0, 0))) + theme(panel.grid = element_blank(), axis.text = element_blank(), axis.ticks = element_blank(), plot.title = element_text(hjust = 0.5))+ geom_label(data = age_label, aes(x=x,y=y,label=sprintf("%.1f", y)), label.size=NA, colour = "white",fill=alpha('grey80',0.8),size=4)
 sex <- data$Gender#獲取性別數(shù)據(jù)sex_label <- data.frame("x" = rep('class',2),#構(gòu)建比例數(shù)據(jù) "y" = c(prop.table(table(sex))[1] * 100, #計(jì)算占比 prop.table(table(sex))[2] * 100))sex_label$gender <- rownames(sex_label)#設(shè)置分組
plot_sex <- ggplot(sex_label, aes(x = x, y = y, fill = gender))+ geom_col(color='black')+ #堆疊圖 geom_text(aes(label = sprintf("%.1f", y)),angle=90, color='white',size=8,fontface='bold', position = position_stack(vjust = 0.5))+ scale_fill_manual(values = c("Female"='#F2300F',"Male"='#E1BD6D')) + theme_void()+ labs(x = "", y = "",title = 'Gender (%)') + scale_y_continuous(expand = expansion(mult = c(0, 0))) + theme(panel.grid = element_blank(), axis.text = element_blank(), axis.ticks = element_blank(), plot.title = element_text(hjust = 0.5,angle = 45,vjust = 0.5), plot.margin = margin(t=10,r=0,b=3,l=0,unit = "mm"))
#其余兩個(gè)如法炮制#Et <- data$Ethnicity#獲取性別數(shù)據(jù)Et_label <- data.frame("x" = rep('class',5),#構(gòu)建比例數(shù)據(jù) "y" = c(prop.table(table(Et))[1] * 100, #計(jì)算占比 prop.table(table(Et))[2] * 100, prop.table(table(Et))[3] * 100, prop.table(table(Et))[4] * 100, prop.table(table(Et))[5] * 100))Et_label$Et <- rownames(Et_label)#設(shè)置分組
plot_Et <- ggplot(Et_label, aes(x = x, y = y, fill = Et))+ geom_col(color='black')+ geom_text(aes(label = sprintf("%.1f", y)),angle=90, color='white',size=6,fontface='bold', position = position_stack(vjust = 0.5))+ scale_fill_manual(values = c("Asian"='#046C9A',"Black"='#ABDDDE', 'Caucasian'='#ECCBAE','Hispanics'='#D69C4E','NA'='grey60')) + theme_void()+ labs(x = "", y = "",title = 'Ethnicity (%)') + scale_y_continuous(expand = expansion(mult = c(0, 0))) + theme(panel.grid = element_blank(), axis.text = element_blank(), axis.ticks = element_blank(), plot.title = element_text(hjust = 0.5,angle = 45,vjust = 0.5), plot.margin = margin(t=10,r=0,b=3,l=0,unit = "mm"))
#IRIS <- data$IRISIRIS_label <- data.frame("x" = rep('class',3),#構(gòu)建比例數(shù)據(jù) "y" = c(prop.table(table(IRIS))[1] * 100, #計(jì)算占比 prop.table(table(IRIS))[2] * 100, prop.table(table(IRIS))[3] * 100))IRIS_label$IRIS <- rownames(IRIS_label)#設(shè)置分組
plot_IRIS <- ggplot(IRIS_label, aes(x = x, y = y, fill = IRIS))+ geom_col(color='black')+ geom_text(aes(label = sprintf("%.1f", y)),angle=90, color='white',size=8,fontface='bold', position = position_stack(vjust = 0.5))+ scale_fill_manual(values = c("IR"='#3B9AB2',"IS"='#F21A00','Unknown'='grey60')) + theme_void()+ labs(x = "", y = "",title = 'IRIS (%)') + scale_y_continuous(expand = expansion(mult = c(0, 0))) + theme(panel.grid = element_blank(), axis.text = element_blank(), axis.ticks = element_blank(), plot.title = element_text(hjust = 0.5,angle = 45,vjust = 0.5), plot.margin = margin(t=10,r=0,b=3,l=0,unit = "mm"))
#把后面三個(gè)平起來(lái)，便于collect legendlibrary(patchwork)bar_combine <- plot_sex+plot_Et+plot_IRIS+plot_layout(ncol = 3, widths = c(1,1,1),guides='collect')
 #plot circledf <- datadf$subject_id_random <- rownames(df)
#修飾數(shù)據(jù)，按照Age從小到大排列df <- data.frame(factors = df$subject_id_random,x = 1,y = 1,df,stringsAsFactors = TRUE) %>% dplyr::arrange(Age) %>% dplyr::mutate(factors = factor(factors, levels = factors))
#circle 布局circos.clear()circos.par("track.height" = 0.2, start.degree = 90, clock.wise = TRUE, gap.after = c(rep(0, nrow(df) - 1), 90), cell.padding = c(0, 0, 0, 0), circle.margin = c(0.1, 0.1, 0.1, 0.1))
#初始化Circos 圖circos.initialize(factors = df$factors, x = df$x, xlim = c(0.5, 1.5))
##plot最外圈第一層age--------------------------------------------------------------#原文中展示的圖顯示，這部分采取的是棒棒糖圖的展示方式#那么在circle中就需要plot line和point組合#需要使用circos.track添加軌道，繪制文本，點(diǎn)和線(xiàn)，分別使用circlize的circos.text，circos.lines，circos.point函數(shù)# range(df$Age, na.rm = TRUE)temp_value <- df$Age
circos.track( factors = df$factors, x = df$x, y = temp_value, ylim = c(20, 80), bg.border = "black" track.height = 0.2,
#前面內(nèi)容都是對(duì)軌道的
panel.fun = function(x, y) {
name = get.cell.meta.data("sector.index") i = get.cell.meta.data("sector.numeric.index") xlim = get.cell.meta.data("xlim") ylim = get.cell.meta.data("ylim")
circos.yaxis( side = "left", at = c(20,40,60,80), sector.index = get.all.sector.index()[1], labels.cex = 0.4, labels.niceFacing = FALSE)
circos.lines( x = mean(xlim, na.rm = TRUE), y = temp_value[i], pch = 16, cex = 8, type = "h", col = ggsci::pal_aaas()(n = 10)[4], lwd = 2)
#plot labels circos.text(#繪制最外層sample名 x = 1, y = 105, labels = name, facing = "clockwise", niceFacing = TRUE, cex = 0.5 # adj = aa )
circos.points(#繪制點(diǎn) x = mean(xlim), y = temp_value[i], pch = 16, cex = 0.8, col = ggsci::pal_aaas()(n = 10)[4] ) })
#如法炮制BMI，只不過(guò)不用再plot text--------------------------------------------------------------##BMIrange(df$BMI, na.rm = TRUE)temp_value <- df$BMI
circos.track( factors = df$factors, x = df$x, y = temp_value, ylim = c(15,45), bg.border = "black", # bg.col = NA, track.height = 0.2, panel.fun = function(x, y) { name = get.cell.meta.data("sector.index") i = get.cell.meta.data("sector.numeric.index") xlim = get.cell.meta.data("xlim") ylim = get.cell.meta.data("ylim")
circos.yaxis( side = "left", at = c(15,30,45), sector.index = get.all.sector.index()[1], labels.cex = 0.4, labels.niceFacing = FALSE)
circos.lines( x = mean(xlim, na.rm = TRUE), y = temp_value[i], pch = 16, cex = 8, type = "h", col = ggsci::pal_tron()(n = 10)[1], lwd = 2 )
circos.points( x = mean(xlim), y = temp_value[i], pch = 16, cex = 0.8, col = ggsci::pal_tron()(n = 10)[1] ) })
## sex，離散型數(shù)據(jù)--------------------------------------------------------------temp_sex <- df$Gendertemp_sex[is.na(temp_sex)] <- "grey"#設(shè)置顏色temp_sex[temp_sex == "Female"] <- '#F2300F'temp_sex[temp_sex == "Male"] <- '#E1BD6D'
#還是依舊，繼續(xù)添加，circos.track前面基礎(chǔ)設(shè)置基本都是一致的。circos.track( factors = df$factors, x = df$x, y = df$y, ylim = c(0, 1), bg.border = "black", track.height = 0.1,
panel.fun = function(x, y) {
name = get.cell.meta.data("sector.index") i = get.cell.meta.data("sector.numeric.index") xlim = get.cell.meta.data("xlim") ylim = get.cell.meta.data("ylim")
#繪制矩形，使用circos.rect circos.rect( xleft = xlim[1], ybottom = ylim[1], xright = xlim[2], ytop = ylim[2],# col = temp_sex[i], bg.border = "black" ) })
## Ethnicitytemp_ethnicity <- df$Ethnicitytemp_ethnicity[temp_ethnicity == "NA"] <- "grey"temp_ethnicity[temp_ethnicity == "Caucasian"] <- "#ECCBAE"temp_ethnicity[temp_ethnicity == "Asian"] <- '#046C9A'temp_ethnicity[temp_ethnicity == "Hispanics"] <- '#D69C4E'temp_ethnicity[temp_ethnicity == "Black"] <- '#ABDDDE'
circos.track( factors = df$factors, x = df$x, y = df$y, ylim = c(0, 1), bg.border = "black", track.height = 0.1,
panel.fun = function(x, y) { name = get.cell.meta.data("sector.index") i = get.cell.meta.data("sector.numeric.index") xlim = get.cell.meta.data("xlim") ylim = get.cell.meta.data("ylim")
circos.rect( xleft = xlim[1], ybottom = ylim[1], xright = xlim[2], ytop = ylim[2], col = temp_ethnicity[i], bg.border = "black" ) })
## IRIStemp_iris <- df$IRIS
temp_iris <- df$IRIStemp_iris[temp_iris == "IR"] <- '#3B9AB2'temp_iris[temp_iris == "Unknown"] <-'grey60'temp_iris[temp_iris == "IS"] <-'#F21A00'
circos.track( factors = df$factors, x = df$x, y = df$y, ylim = c(0, 1), bg.border = "black", track.height = 0.1,
panel.fun = function(x, y) { name = get.cell.meta.data("sector.index") i = get.cell.meta.data("sector.numeric.index") xlim = get.cell.meta.data("xlim") ylim = get.cell.meta.data("ylim")
circos.rect( xleft = xlim[1], ybottom = ylim[1], xright = xlim[2], ytop = ylim[2], col = temp_iris[i], bg.border = "black" ) })
#最后就是組合圖了，AI拼圖即可，實(shí)在沒(méi)有必要用代碼調(diào)整。
 最后，AI手動(dòng)調(diào)整拼圖即可！覺(jué)得我們分享有些用的，點(diǎn)個(gè)贊再走唄！
|
