桑基图绘制(sankey diagram)

R常用的方法有:
ggalluvial
sankeyNetwork

主要是文件准备比较麻烦,代码如下

sankey_make<-function(exp_deg_dir,trans_deg_dir,prefix,FC,p_value){
suppressMessages(library(tidyverse))

exp_deg<-read.csv(exp_deg_dir)
exp_deg$"Gene_id"<-unlist(lapply(as.character(exp_deg[,1]), FUN = function(x) {return(strsplit(x, split = ".",fixed = T)[[1]][1])}))

trans_deg<-read.csv(trans_deg_dir)
trans_deg$"Gene_id"<-unlist(lapply(as.character(trans_deg[,1]), FUN = function(x) {return(strsplit(x, split = "_",fixed = T)[[1]][2])}))
trans_deg$"Gene_id"<-unlist(lapply(as.character(trans_deg[,"Gene_id"]), FUN = function(x) {return(strsplit(x, split = ".",fixed = T)[[1]][1])}))

total_list=intersect(exp_deg$Gene_id,trans_deg$Gene_id)
#gene expression 
exp_deg_sig_up<-exp_deg %>% filter(pvalue<p_value & log2FoldChange>FC)
exp_deg_sig_up_list<-as.character(exp_deg_sig_up$Gene_id)
exp_deg_sig_up_list<-intersect(exp_deg_sig_up_list,total_list)

exp_deg_sig_down<-exp_deg %>% filter(pvalue<p_value & log2FoldChange<(-FC))
exp_deg_sig_down_list<-as.character(exp_deg_sig_down$Gene_id)
exp_deg_sig_down_list<-intersect(exp_deg_sig_down_list,total_list)

exp_nochange_list<-setdiff(total_list,c(exp_deg_sig_up_list,exp_deg_sig_down_list))

#transcripts
get_list<-function(a,b){b[is.element(b,a)]}

trans_deg_sig_up<-trans_deg %>% filter(pvalue<p_value & log2FoldChange>FC)
trans_deg_sig_up_list<-as.character(trans_deg_sig_up$Gene_id)
trans_deg_sig_up_list<-get_list(a=total_list,b=trans_deg_sig_up_list)


trans_deg_sig_down<-trans_deg %>% filter(pvalue<p_value & log2FoldChange<(-FC))
trans_deg_sig_down_list<-as.character(trans_deg_sig_down$Gene_id)
trans_deg_sig_down_list<-get_list(a=total_list,b=trans_deg_sig_down_list)

trans_nochange<-trans_deg %>% filter(pvalue>p_value | abs(log2FoldChange)<FC)
trans_nochange_list_rt<-as.character(trans_nochange$Gene_id)
trans_nochange_list<-get_list(a=total_list,b=trans_nochange_list_rt)
#caculate number
#first intersection
total_number<-length(intersect(exp_deg$Gene_id,trans_deg$Gene_id))
gene_up_number=length(exp_deg_sig_up_list)
gene_down_number=length(exp_deg_sig_down_list)
gene_nochange_number=length(exp_nochange_list)

##second intersection
# up_vs_up_number<-length(na.omit(intersect(exp_deg_sig_up_list,trans_deg_sig_up_list)))
# up_vs_down_number<-length(na.omit(intersect(exp_deg_sig_up_list,trans_deg_sig_down_list)))
# up_vs_no_number<-length(na.omit(intersect(exp_deg_sig_up_list,trans_nochange_list)))
# up_vs_up_number+up_vs_down_number+up_vs_no_number
# 
# down_vs_up_number<-length(na.omit(intersect(exp_deg_sig_down_list,trans_deg_sig_up_list)))
# down_vs_down_number<-length(na.omit(intersect(exp_deg_sig_down_list,trans_deg_sig_down_list)))
# down_vs_no_number<-length(na.omit(intersect(exp_deg_sig_down_list,trans_nochange_list)))
# down_vs_up_number+down_vs_down_number+down_vs_no_number
# 
# no_vs_up_number<-length(na.omit(intersect(exp_nochange_list,trans_deg_sig_up_list)))
# no_vs_down_number<-length(na.omit(intersect(exp_nochange_list,trans_deg_sig_down_list)))
# no_vs_no_number<-length(na.omit(intersect(exp_nochange_list,trans_nochange_list)))
# no_vs_up_number+no_vs_down_number+no_vs_no_number
# up_vs_up_number+up_vs_down_number+up_vs_no_number+down_vs_up_number+down_vs_down_number+down_vs_no_number+no_vs_up_number+no_vs_down_number+no_vs_no_number

cat_number<-function(a,b){length(b[is.element(b,a)])}
up_vs_up_number<-cat_number(a=exp_deg_sig_up_list,b=trans_deg_sig_up_list)
up_vs_down_number<-cat_number(a=exp_deg_sig_up_list,b=trans_deg_sig_down_list)
up_vs_no_number<-cat_number(a=exp_deg_sig_up_list,b=trans_nochange_list)

down_vs_up_number<-cat_number(a=exp_deg_sig_down_list,b=trans_deg_sig_down_list)
down_vs_down_number<-cat_number(a=exp_deg_sig_down_list,b=trans_deg_sig_down_list)
down_vs_no_number<-cat_number(a=exp_deg_sig_down_list,b=trans_nochange_list)

no_vs_up_number<-cat_number(a=exp_nochange_list,b=trans_deg_sig_down_list)
no_vs_down_number<-cat_number(a=exp_nochange_list,b=trans_deg_sig_down_list)
no_vs_no_number<-cat_number(a=exp_nochange_list,b=trans_nochange_list)

up_vs_up_number+up_vs_down_number+up_vs_no_number+down_vs_up_number+down_vs_down_number+down_vs_no_number+no_vs_up_number+no_vs_down_number+no_vs_no_number


value=c(gene_up_number,gene_down_number,gene_nochange_number,
        up_vs_up_number,up_vs_down_number,up_vs_no_number,
        down_vs_up_number,down_vs_down_number,down_vs_no_number,
        no_vs_up_number,no_vs_down_number,no_vs_no_number
        )

source<-c(rep(prefix,3),
          rep("Gene Up-regulated",3),
          rep("Gene Down-regulated",3),
          rep("Gene Not Changed",3)
          )

target<-c("Gene Up-regulated","Gene Down-regulated","Gene Not Changed",
          rep(c("Transcript Up-regulated","Transcript Down-regulated","Transcript Not Changed"),3))

data<-data.frame(source,target,value)
return(data)
}

FC=0.5
p_value=0.05
human_exp_deg_dir="~/AllGenes_DESeq2.csv"
human_trans_deg_dir="~/diffExp/human_transcript_degs.csv"

human_sankey<-sankey_make(exp_deg_dir=human_exp_deg_dir,trans_deg_dir=human_trans_deg_dir,prefix="Human",FC=FC,p_value=p_value)

mouse_exp_deg_dir="~/AllGenes_DESeq2.csv"
mouse_trans_deg_dir="~/diffExp/mouse_transcript_degs.csv"

mouse_sankey<-sankey_make(exp_deg_dir=mouse_exp_deg_dir,trans_deg_dir=mouse_trans_deg_dir,prefix="Mouse",FC=FC,p_value=p_value)

snakey_df<-rbind(human_sankey,mouse_sankey)
snakey_df$"Species"<-c(rep("Human",nrow(human_sankey)),
                       rep("Mouse",nrow(mouse_sankey))
                       )
write.csv(snakey_df,"~/snakey.csv",row.names = F)
###
rm(list = ls())
library(tidyverse)
library(viridis)
library(patchwork)
library(networkD3)
library(RColorBrewer)
snakey_df<-read.csv("~/Snakey/snakey.csv")
# is_alluvia_form(as.data.frame(snakey_df), axes = 1:3, silent = TRUE)
# snakey_df$target <- paste(snakey_df$target, " ", sep="")
set.seed(2020)
nodes <- data.frame(name=c(as.character(snakey_df$source), as.character(snakey_df$target)) %>% unique())
snakey_df$IDsource=match(snakey_df$source, nodes$name)-1 
snakey_df$IDtarget=match(snakey_df$target, nodes$name)-1

sankeyNetwork(Links = snakey_df, Nodes = nodes,
              Source = "IDsource", Target = "IDtarget",
              Value = "value", NodeID = "name",
              sinksRight=F,nodeWidth=20, fontSize=14, nodePadding=20,
              LinkGroup = 'Species')

准备文件2

cat_number<-function(a,b){length(b[is.element(b,a)])}
tissues<-as.character(unique(data$fed_tissues))

out_tab<-data.frame()
for (i in tissues){
  source=paste0(i,"_Fed")
  fed_rt=data %>% filter(fed_tissues==i)
  fed_rt_gene_list<-as.character(fed_rt$gene_id)
  for (j in tissues){
  target= paste0(j,"_Fasting")
  fasting_rt<-data %>% filter(fasting_tissues==j)
  fasting_rt_gene_list<-as.character(fasting_rt$gene_id)
  value<-cat_number(a=fed_rt_gene_list,b=fasting_rt_gene_list)
  out_tab<-rbind(out_tab,cbind(source,target,value))
  }
}
out_tab<-out_tab[out_tab$value!=0,]

tatal_out_tab<-data.frame()
source<-"Total_Genes"
for (j in tissues){
  target= paste0(j,"_Fed")
  fed_rt<-data %>% filter(fed_tissues==j)
  fed_rt_gene_list<-as.character(fed_rt$gene_id)
  value<-cat_number(a=fed_rt_gene_list,b=fed_rt_gene_list)
  tatal_out_tab<-rbind(tatal_out_tab,cbind(source,target,value))
}

rt<-rbind(tatal_out_tab,out_tab)

图形格式
数据格式
最后编辑于
?著作权归作者所有,转载或内容合作请联系作者
  • 序言:七十年代末,一起剥皮案震惊了整个滨河市,随后出现的几起案子,更是在滨河造成了极大的恐慌,老刑警刘岩,带你破解...
    沈念sama阅读 214,128评论 6 493
  • 序言:滨河连续发生了三起死亡事件,死亡现场离奇诡异,居然都是意外死亡,警方通过查阅死者的电脑和手机,发现死者居然都...
    沈念sama阅读 91,316评论 3 388
  • 文/潘晓璐 我一进店门,熙熙楼的掌柜王于贵愁眉苦脸地迎上来,“玉大人,你说我怎么就摊上这事。” “怎么了?”我有些...
    开封第一讲书人阅读 159,737评论 0 349
  • 文/不坏的土叔 我叫张陵,是天一观的道长。 经常有香客问我,道长,这世上最难降的妖魔是什么? 我笑而不...
    开封第一讲书人阅读 57,283评论 1 287
  • 正文 为了忘掉前任,我火速办了婚礼,结果婚礼上,老公的妹妹穿的比我还像新娘。我一直安慰自己,他们只是感情好,可当我...
    茶点故事阅读 66,384评论 6 386
  • 文/花漫 我一把揭开白布。 她就那样静静地躺着,像睡着了一般。 火红的嫁衣衬着肌肤如雪。 梳的纹丝不乱的头发上,一...
    开封第一讲书人阅读 50,458评论 1 292
  • 那天,我揣着相机与录音,去河边找鬼。 笑死,一个胖子当着我的面吹牛,可吹牛的内容都是我干的。 我是一名探鬼主播,决...
    沈念sama阅读 39,467评论 3 412
  • 文/苍兰香墨 我猛地睁开眼,长吁一口气:“原来是场噩梦啊……” “哼!你这毒妇竟也来了?” 一声冷哼从身侧响起,我...
    开封第一讲书人阅读 38,251评论 0 269
  • 序言:老挝万荣一对情侣失踪,失踪者是张志新(化名)和其女友刘颖,没想到半个月后,有当地人在树林里发现了一具尸体,经...
    沈念sama阅读 44,688评论 1 306
  • 正文 独居荒郊野岭守林人离奇死亡,尸身上长有42处带血的脓包…… 初始之章·张勋 以下内容为张勋视角 年9月15日...
    茶点故事阅读 36,980评论 2 328
  • 正文 我和宋清朗相恋三年,在试婚纱的时候发现自己被绿了。 大学时的朋友给我发了我未婚夫和他白月光在一起吃饭的照片。...
    茶点故事阅读 39,155评论 1 342
  • 序言:一个原本活蹦乱跳的男人离奇死亡,死状恐怖,灵堂内的尸体忽然破棺而出,到底是诈尸还是另有隐情,我是刑警宁泽,带...
    沈念sama阅读 34,818评论 4 337
  • 正文 年R本政府宣布,位于F岛的核电站,受9级特大地震影响,放射性物质发生泄漏。R本人自食恶果不足惜,却给世界环境...
    茶点故事阅读 40,492评论 3 322
  • 文/蒙蒙 一、第九天 我趴在偏房一处隐蔽的房顶上张望。 院中可真热闹,春花似锦、人声如沸。这庄子的主人今日做“春日...
    开封第一讲书人阅读 31,142评论 0 21
  • 文/苍兰香墨 我抬头看了看天上的太阳。三九已至,却和暖如春,着一层夹袄步出监牢的瞬间,已是汗流浃背。 一阵脚步声响...
    开封第一讲书人阅读 32,382评论 1 267
  • 我被黑心中介骗来泰国打工, 没想到刚下飞机就差点儿被人妖公主榨干…… 1. 我叫王不留,地道东北人。 一个月前我还...
    沈念sama阅读 47,020评论 2 365
  • 正文 我出身青楼,却偏偏与公主长得像,于是被迫代替她去往敌国和亲。 传闻我的和亲对象是个残疾皇子,可洞房花烛夜当晚...
    茶点故事阅读 44,044评论 2 352