美文网首页科研信息学
桑基图绘制(sankey diagram)

桑基图绘制(sankey diagram)

作者: 落寞的橙子 | 来源:发表于2020-07-26 02:15 被阅读0次

    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')
    
    图形格式 数据格式

    相关文章

      网友评论

        本文标题:桑基图绘制(sankey diagram)

        本文链接:https://www.haomeiwen.com/subject/dyeblktx.html