Diff of /6-Figure scripts/Fig S4.R [000000] .. [16eabd]

Switch to unified view

a b/6-Figure scripts/Fig S4.R
1
library(data.table)
2
library(dplyr)
3
library(reshape2)
4
library(ggplot2)
5
library(ggdendro)
6
library(readxl)
7
library(ggpubr)
8
9
excel_sheets("Fig S4 Source Data.xlsx")
10
11
# Figure S4 ---------------------------------
12
CorrDf_metab.metag_neu <- read_excel("Fig S4 Source Data.xlsx", sheet = "MetaG-MetaB Full")
13
CorrDf_metab.trans_neu <- read_excel("Fig S4 Source Data.xlsx", sheet = "Trans-MetaB")
14
CorrDf_spupro.trans_neu <- read_excel("Fig S4 Source Data.xlsx", sheet = "Trans-Sputpro")
15
CorrDf_serpro.trans_neu <- read_excel("Fig S4 Source Data.xlsx", sheet = "Trans-Serpro")
16
17
keyStr_df <- cbind.data.frame(dfnameStr = c("metag","metab","trans","serpro","spupro"),
18
                              colStr = c("MetaG","MetaB","Trans","Cyto","Cyto"),
19
                              stringsAsFactors=F)
20
21
# nodes and types
22
nodeXs <- c("metab","serpro","spupro")  #do not change the sequences of elements in nodeXs 
23
nodeYs <- c("metag","trans")  #do not change the sequences of elements in nodeYs 
24
ENtypes <- c("neu")
25
26
for(enType in ENtypes){
27
  #  enType = ENtypes[2]
28
  
29
  for(nodex in nodeXs){
30
    # nodex = nodeXs[1]
31
    
32
    for(nodey in nodeYs){
33
      # nodey = nodeYs[2]
34
      
35
      
36
      corrDfName <- paste("CorrDf_",nodex,".",nodey,"_",enType,sep = "")
37
      if(!exists(corrDfName)) next
38
      
39
      CorrDf <- eval(parse(text = corrDfName))
40
      
41
      NodeXCol <- which(sapply(CorrDf, function(x) all(grepl(keyStr_df$colStr[which(keyStr_df$dfnameStr == nodex)], x) )) )
42
      colnames(CorrDf)[NodeXCol] <- "NodeX"
43
      
44
      NodeYCol <- which(sapply(CorrDf, function(x) all(grepl(keyStr_df$colStr[which(keyStr_df$dfnameStr == nodey)], x) )) )
45
      colnames(CorrDf)[NodeYCol] <- "NodeY"
46
      
47
      
48
      # organize the orders of nodex and nodey
49
      dat_r.w <- CorrDf %>% reshape2::dcast(NodeY ~ NodeX, value.var = "Correlation")
50
      rownames(dat_r.w) <- dat_r.w$NodeY; dat_r.w <- dat_r.w[-1]
51
      
52
      if(T){
53
        df <- t(dat_r.w) 
54
        x <- as.matrix(scale(df))
55
        dd.col <- as.dendrogram(hclust(dist(x)))
56
        col.ord <- order.dendrogram(dd.col)
57
        
58
        dd.row <- as.dendrogram(hclust(dist(t(x))))
59
        row.ord <- order.dendrogram(dd.row)
60
        
61
        xx <- scale(df)[col.ord, row.ord] 
62
        xx_names <- attr(xx, "dimnames") 
63
        #df <- as.data.frame(xx)
64
        ddata_x <- dendro_data(dd.row) 
65
        ddata_y <- dendro_data(dd.col) 
66
      } 
67
      if(!exists(paste("order_",nodey,sep = ""))) assign(paste("order_",nodey,sep = ""), xx_names[[2]],envir = .GlobalEnv)
68
      if(!exists(paste("order_",nodex,sep = ""))) assign(paste("order_",nodex,sep = ""), xx_names[[1]],envir = .GlobalEnv)
69
      
70
      
71
      order_nodex <- eval(parse(text = paste("order_",nodex,sep = "")))
72
      order_nodey <- eval(parse(text = paste("order_",nodey,sep = "")))
73
      
74
      if(!all(unique(CorrDf$NodeX) %in% order_nodex) ) {print(paste("not all nodes of ", nodex," were in predefined order so stop",sep = ""));break}
75
      if(!all(unique(CorrDf$NodeY) %in% order_nodey) ) {print(paste("not all nodes of ", nodey," were in predefined order so stop",sep = ""));break}
76
      
77
      
78
      CorrDf$NodeX <- factor(CorrDf$NodeX, levels = order_nodex)
79
      CorrDf$NodeY <- factor(CorrDf$NodeY, levels = order_nodey)
80
      
81
      CorrDf$ColorType <- sapply(c(1:nrow(CorrDf)), 
82
                                 function(i) {
83
                                   if(CorrDf$Linked[i] == "Y") return("Y") else if(CorrDf$`P-value`[i] >= 0.05) return("N_ns") else if(CorrDf$Correlation[i]>0) return("N_sig_posCorr") else return("N_sig_negCorr")
84
                                 })
85
      
86
      CorrDf$absCorr <- abs(CorrDf$Correlation)
87
      
88
      
89
      CorrDf <- CorrDf %>% filter( NodeX %in% order_nodex) %>% filter(NodeY %in% order_nodey)
90
      CorrDf$NodeX <- factor(CorrDf$NodeX, levels = order_nodex)
91
      CorrDf$NodeY <- factor(CorrDf$NodeY, levels = order_nodey)
92
      
93
      
94
      p <- ggplot(data = CorrDf, aes(x=NodeX,y=NodeY))+
95
        geom_tile(aes(fill=ColorType, alpha=absCorr),color="white") +
96
        theme(axis.text.x = element_text(angle = 90))+
97
        #scale_fill_manual(values=c("white","#e2e2e2","#cc0202"))+
98
        scale_fill_manual(values = c("white","#c1c1ff","#ffb6b6","#cc0202")) +
99
        #scale_alpha(limits = c(0.0,1.0), range = c(0,0.6))+
100
        theme(  panel.grid.major = element_blank(),
101
                panel.grid.minor = element_blank(),
102
                panel.background = element_blank())
103
      # axis.title.x = element_text(colour=NA),
104
      # axis.title.y = element_blank())
105
      
106
      assign(paste("HeatP_",nodex,".",nodey,"_",enType,sep = ""), p, envir = .GlobalEnv)
107
      
108
    }
109
    
110
    
111
  }
112
  
113
  
114
  assign(paste("order_metab_",enType,sep = ""), order_metab, envir = .GlobalEnv)
115
  assign(paste("order_metag_",enType,sep = ""), order_metag, envir = .GlobalEnv)
116
  assign(paste("order_trans_",enType,sep = ""), order_trans, envir = .GlobalEnv)
117
  assign(paste("order_serpro_",enType,sep = ""), order_serpro, envir = .GlobalEnv)
118
  assign(paste("order_spupro_",enType,sep = ""), order_spupro, envir = .GlobalEnv)
119
  
120
  remove(order_metab,order_metag,order_trans, order_serpro, order_spupro)
121
}
122
123
124
125
126
# Fig S4. NEU integrated plot
127
ggarrange(ggarrange(HeatP_metab.trans_neu + 
128
                      theme(legend.position = "none", axis.text.x = element_blank(),axis.text.y = element_blank()) +
129
                      xlab("MetaB") + ylab("Trans"), 
130
                    HeatP_spupro.trans_neu + 
131
                      theme(legend.position = "none", axis.text.x = element_blank(),axis.text.y = element_blank()) +
132
                      xlab("Sputum") + ylab("Trans"),
133
                    HeatP_serpro.trans_neu + 
134
                      theme(legend.position = "none", axis.text.x  = element_blank(),axis.text.y = element_blank()) +
135
                      xlab("Serum") + ylab("Trans"),
136
                    nrow = 1, widths = c(0.55,0.3,0.15)),
137
          ggarrange(HeatP_metab.metag_neu + 
138
                      theme(legend.position = "none", axis.text.x = element_blank(),axis.text.y = element_blank()) +
139
                      xlab("MetaB") + ylab("MetaG"), 
140
                    ggplot() + geom_text(aes(x=0,y=0),label="NEU") + theme_dendro(), 
141
                    nrow = 1, widths = c(0.55,0.45)),
142
          nrow = 2,heights = c(0.6,0.4))
143
144
145
146