[16eabd]: / 6-Figure scripts / Fig S4.R

Download this file

147 lines (103 with data), 6.4 kB

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