WGCNA模块与性状展示图

在RStudio中安装加载ggcor

devtools::install_github("shinepreventer/ggcor-hou")

github网址：https://github.com/shinepreventer/ggcor-hou

以下是github中给出的例子

library(dplyr)
#> Warning: package 'dplyr' was built under R version 3.6.2
data("varechem", package = "vegan")
data("varespec", package = "vegan")

mantel <- mantel_test(varespec, varechem,
                      spec.select = list(Spec01 = 1:7,
                                         Spec02 = 8:18,
                                         Spec03 = 19:37,
                                         Spec04 = 38:44)) %>% 
  mutate(rd = cut(r, breaks = c(-Inf, 0.2, 0.4, Inf),
                  labels = c("< 0.2", "0.2 - 0.4", ">= 0.4")),
         pd = cut(p.value, breaks = c(-Inf, 0.01, 0.05, Inf),
                  labels = c("< 0.01", "0.01 - 0.05", ">= 0.05")))

quickcor(varechem, type = "upper") +
  geom_square() +
  anno_link(aes(colour = pd, size = rd), data = mantel) +
  scale_size_manual(values = c(0.5, 1, 2)) +
  scale_colour_manual(values = c("#D95F02", "#1B9E77", "#A2A2A288")) +
  guides(size = guide_legend(title = "Mantel's r",
                             override.aes = list(colour = "grey35"), 
                             order = 2),
         colour = guide_legend(title = "Mantel's p", 
                               override.aes = list(size = 3), 
                               order = 1),
         fill = guide_colorbar(title = "Pearson's r", order = 3))

如果以WGCNA数据进行绘图就需要准备数据啦
首先准备模块的表达数据 MKSJ

MKSJ <- orderMEs(cbind(net$MEs))

其次准备表型与模块的相关性P值与r值矩阵，以及对P值与r值进行归类BXXG

第一列为表型，第二列为模块，第三列委相关性值，第四列为P值
注意：第一列必须为表型数据，1、2列数据不能颠倒

{
  BXXG <- matrix(NA,ncol = 6,nrow = 66) # 66为表型数2乘以模块数33
BXXG[1:33,2] <- row.names(moduleTraitCor)
BXXG[1:33,1] <- "IMF"
BXXG[34:66,2] <- row.names(moduleTraitCor)
BXXG[34:66,1] <- "tenderness"
colnames(BXXG) <- c("biaoxing","mokuai","r","p","rd","pd") 
for (i in 1:66) {
  BXXG[i,3] <- moduleTraitCor[BXXG[i,2],BXXG[i,1]]
  BXXG[i,4] <- moduleTraitPvalue[BXXG[i,2],BXXG[i,1]]
}

BXXG <- as.data.frame(BXXG)
BXXG[,3] <- as.numeric(BXXG[,3])
BXXG[,4] <- as.numeric(BXXG[,4])


for (i in 1:66) {
    {if(abs(BXXG[i,3])<0.2)
      BXXG[i,5] <- "<0.2"
    else if(abs(BXXG[i,3])>=0.2&&abs(BXXG[i,3]) < 0.5)
      BXXG[i,5] <- "0.2-0.5"
    else
      BXXG[i,5] <- ">=0.5"
    }
    {if(BXXG[i,4]>0.05)
      BXXG[i,6] <- ">0.05"
      else if(BXXG[i,4]<=0.01)
        BXXG[i,6] <- "<=0.01"
      else
        BXXG[i,6] <- "0.01-0.05"
    }
  }

}

# 转换为因子，目的是使右侧图注按一定顺序排序
BXXG[,5]<-factor(BXXG[,5],levels=c("<0.2","0.2-0.5",">=0.5"))
BXXG[,6]<-factor(BXXG[,6],levels=c("<=0.01","0.01-0.05",">0.05"))

绘图

quickcor(MKSJ, type = "upper") +
  geom_square() +
  anno_link(aes(colour = pd, size = rd), data = BXXG) +
  scale_size_manual(values = c(0.5, 1, 2)) +
  scale_colour_manual(values = c("#D95F02", "#1B9E77", "#A2A2A288")) +  ## "#D95F02", "#1B9E77", "#A2A2A288"
  guides(size = guide_legend(title = "Mantel's r",
                           override.aes = list(colour = "grey35"), 
                           order = 2),
       colour = guide_legend(title = "Mantel's p", 
                             override.aes = list(size = 3), 
                             order = 1),
       fill = guide_colorbar(title = "Pearson's r", order = 3))

如果想更改模块间的相关性热图颜色可以加如下命令

+ scale_fill_gradientn(colours =c("#0033FF", "#FFE400","#eb261a"))

代码精简版

MKSJ <- orderMEs(cbind(net$MEs))

cor <- moduleTraitCor
cor <- as.data.frame(cor)
cor %>% mutate(mokuai =rownames(cor)) -> cor
rownames(cor) = NULL
cor %>% 
  pivot_longer(-mokuai,names_to = "biaoxing",values_to ="r") -> cor

corp <- moduleTraitPvalue
corp <- as.data.frame(corp)
corp %>% mutate(mokuai =rownames(corp)) -> corp
rownames(corp) = NULL
corp %>% 
  pivot_longer(-mokuai,names_to = "biaoxing",values_to ="p") -> corp

cor %>%
  full_join(corp, by = c("biaoxing","mokuai")) ->BXXG 

BXXG %>%
  mutate(rd = case_when(abs(r) >= 0.5 ~ ">=0.5",
                          abs(r) >=0.2 ~ "0.2-0.5",
                          TRUE ~ "<0.2")) -> BXXG

BXXG %>%
  mutate(pd = case_when(p > 0.05 ~ ">0.05",
                        p >0.01 ~ "0.01-0.05",
                        TRUE ~ "<=0.01")) -> BXXG

BXXG %>%
  mutate(zf = case_when(r >0 ~ "+",
                        TRUE ~ "-")) -> BXXG
BXXG  <- as.data.frame(BXXG )
# 转换为因子，目的是使右侧图注按一定顺序排序
BXXG[,5]<-factor(BXXG[,5],levels=c("<0.2","0.2-0.5",">=0.5"))
BXXG[,6]<-factor(BXXG[,6],levels=c("<=0.01","0.01-0.05",">0.05"))
BXXG[,7]<-factor(BXXG[,7],levels=c("+","-"))

names(BXXG)
BXXG %>% select(biaoxing,mokuai,r,p,rd,pd,zf) -> BXXG

quickcor(MKSJ, type = "upper") + scale_fill_gradientn(colours =c("#0033FF", "#FFE400","#eb261a"))+
  geom_square() +
  anno_link(aes(color = pd, size = rd,linetype=zf), data = BXXG) +
  scale_size_manual(values = c(0.5, 1, 2)) +
  scale_linetype_manual(values=c("solid","twodash"))+
  scale_colour_manual(values = c("#D95F02", "#1B9E77", "#A2A2A288")) +  ## "#D95F02", "#1B9E77", "#A2A2A288"
  guides(size = guide_legend(title = "Mantel's |r|",
                             override.aes = list(colour = "grey35"), 
                             order = 2),
         colour = guide_legend(title = "Mantel's p", 
                               override.aes = list(size = 3), 
                               order = 1),
         fill = guide_colorbar(title = "Pearson's r", order = 3))