R语言 热力图,相关系数图, 美化,以及各种调参。

#correlation of texture
setwd("C:/Users/jack/Desktop/mission/correlation/texture")
library(readxl)
T2WI <- read_excel("Crosswise_Texture features and histological features.xlsx", 
                   sheet = "T2WI")
SWI <- read_excel("Crosswise_Texture features and histological features.xlsx", 
                   sheet = "SWI")
T2star <- read_excel("Crosswise_Texture features and histological features.xlsx", 
                   sheet = "T2star")

score <- read_excel("Crosswise_Texture features and histological features.xlsx", 
                                                                   sheet = "score")

##1、比较五组间差异(非参数方差分析),将有差异的纹理特征筛选出来#Kurskal-Wallis检验是Wilcoxon方法(其实是Mann-Whitney检验)用于多个样本。当对两个样本进行比较的时候,Kurskal-Wallis检验与Mann-Whitney检验是等价的。
#T2WI
T2WI_selected<-c()
T2WI_feature<-T2WI[,-c(1,2)]
for (feature in names(T2WI_feature)){
  result_temp <- kruskal.test(T2WI[[feature]]~T2WI$Group)
  if (result_temp$p.value<0.05) {
    T2WI_selected<-c(T2WI_selected,feature)
  }
}
#SWI
SWI_selected<-c()
SWI_feature<-SWI[,-c(1,2)]
for (feature in names(SWI_feature)){
  result_temp <- kruskal.test(SWI[[feature]]~SWI$Group)
  if (result_temp$p.value<0.05) {
    SWI_selected<-c(SWI_selected,feature)
  }
}
#T2star
T2star_selected<-c()
T2star_feature<-T2WI[,-c(1,2)]
for (feature in names(T2star_feature)){
  result_temp <- kruskal.test(T2star[[feature]]~T2star$Group)
  if (result_temp$p.value<0.05) {
    T2star_selected<-c(T2star_selected,feature)
  }
}


##2、筛选出的纹理特征相互之间进行Pearson相关性分析,建立相关性矩阵,根据r值进行分组,将高度相关的纹理特征分为1组
res <- cor(T2star[T2star_selected])
library(Hmisc)
library(corrplot)
plot1<-corrplot(res, order = "hclust", tl.col = "black", tl.srt = 45,addrect = 5)
heatmap(res)


res <- cor(SWI[SWI_selected])
library(Hmisc)
library(corrplot)
plot2<-corrplot(res, order = "hclust", tl.col = "black", tl.srt = 45,addrect = 5)
heatmap(res)


res <- cor(T2WI[T2WI_selected])
library(Hmisc)
library(corrplot)
plot3<-corrplot(res, order = "hclust", tl.col = "black", tl.srt = 45,addrect = 5)
heatmap(res)


##分别计算T2WI、SWI、T2star各纹理特征与病理总评分Total Score的相关性,在之前分组的纹理特征各组中筛选出跟病理总评分高度相关的特征(r绝对值>0.6)
#T2star
group1_T2star<-names(plot1[,1])[1:15]
group2_T2star<-names(plot1[,1])[16:24]
group3_T2star<-names(plot1[,1])[25:36]
group4_T2star<-names(plot1[,1])[37]
group5_T2star<-names(plot1[,1])[38]


index1<-which.max(abs(cor(T2star[group1_T2star],score$病理总分)))
group1_T2star_selected<-group1_T2star[index1]
#"S(0,3)DifVarnc"

index2<-which.max(abs(cor(T2star[group2_T2star],score$病理总分)))
group2_T2star_selected<-group2_T2star[index2]
#"Perc.99%"

index3<-which.max(abs(cor(T2star[group3_T2star],score$病理总分)))
group3_T2star_selected<-group3_T2star[index3]
#"S(4,-4)Correlat"

index4<-which.max(abs(cor(T2star[group4_T2star],score$病理总分)))
group4_T2star_selected<-group4_T2star[index4]
#"S(5,-5)InvDfMom"

index5<-which.max(abs(cor(T2star[group5_T2star],score$病理总分)))
group5_T2star_selected<-group5_T2star[index5]
#'Horzl_LngREmph'

#SWI
group1_SWI<-names(plot2[,1])[1:26]
group2_SWI<-names(plot2[,1])[27:46]
group3_SWI<-names(plot2[,1])[47:62]
group4_SWI<-names(plot2[,1])[63:72]
group5_SWI<-names(plot2[,1])[73:83]

index1<-which.max(abs(cor(SWI[group1_SWI],score$病理总分)))
group1_SWI_selected<-group1_SWI[index1]
#"S(3,-3)Contrast"
index2<-which.max(abs(cor(SWI[group2_SWI],score$病理总分)))
group2_SWI_selected<-group2_SWI[index2]
#"S(4,4)DifEntrp"
index3<-which.max(abs(cor(SWI[group3_SWI],score$病理总分)))
group3_SWI_selected<-group3_SWI[index3]
# "S(4,-4)Correlat"
index4<-which.max(abs(cor(SWI[group4_SWI],score$病理总分)))
group4_SWI_selected<-group4_SWI[index4]
#"Teta1"
index5<-which.max(abs(cor(SWI[group5_SWI],score$病理总分)))
group5_SWI_selected<-group5_SWI[index5]
#"S(1,-1)SumAverg"

#T2WI
group1_T2WI<-names(plot3[,1])[1:23]
group2_T2WI<-names(plot3[,1])[24:53]
group3_T2WI<-names(plot3[,1])[54:66]
group4_T2WI<-names(plot3[,1])[67:107]
group5_T2WI<-names(plot3[,1])[108:133]

index1<-which.max(abs(cor(T2WI[group1_T2WI],score$病理总分)))
group1_T2WI_selected<-group1_T2WI[index1]
#"S(1,0)SumVarnc"
index2<-which.max(abs(cor(T2WI[group2_T2WI],score$病理总分)))
group2_T2WI_selected<-group2_T2WI[index2]
#"S(3,-3)InvDfMom"
index3<-which.max(abs(cor(T2WI[group3_T2WI],score$病理总分)))
group3_T2WI_selected<-group3_T2WI[index3]
# "Horzl_GLevNonU"
index4<-which.max(abs(cor(T2WI[group4_T2WI],score$病理总分)))
group4_T2WI_selected<-group4_T2WI[index4]
#"GrMean"
index5<-which.max(abs(cor(T2WI[group5_T2WI],score$病理总分)))
group5_T2WI_selected<-group5_T2WI[index5]
#"S(0,5)DifEntrp"

##step4 heatmap
target1<-T2star[c(group1_T2star_selected,group2_T2star_selected,group3_T2star_selected,group4_T2star_selected,group5_T2star_selected)]

target2<-SWI[c(group1_SWI_selected,group2_SWI_selected,group3_SWI_selected,group4_SWI_selected,group5_SWI_selected)]

target3<-T2WI[c(group1_T2WI_selected,group2_T2WI_selected,group3_T2WI_selected,group4_T2WI_selected,group5_T2WI_selected)]

target_res<-cor(cbind(target1,target2,target3),score[,c(3:8)])
target_tot<-cor(cbind(target1,target2,target3),score$病理总分)


tacorrplot(target_res, order = "hclust", tl.col = "black", tl.srt = 45,addrect = 5)
heatmap(target_res)

install.packages('gplots')
library(gplots)
?heatmap.2

heatmap.2(target_res,col = bluered(100),colsep= c(1:6),Rowv = NULL,Colv = NULL,
          rowsep=c(1:15),
          sepcolor="white",
          sepwidth=c(0.05,0.05),
          trace="none",keysize=1.5,cexCol = 2,cexRow = 2,margins = c(10,10),keep.dendro = FALSE, verbose = getOption("verbose"))

##corrplot相关系数图
corrplot()

cor_data <- as.data.frame(read_excel("cor_data.xlsx"))
rownames(cor_data)<-cor_data$..1
cor_data<-cor_data[,-c(1)]
cor_data <- as.matrix(cor_data)


heatmap.2(cor_data,col = bluered(100),colsep= c(1:6),Rowv = NULL,Colv = NULL,
          rowsep=c(1:15),
          sepcolor="white",
          sepwidth=c(0.05,0.05),
          trace="none",keysize=1.5,cexCol = 1.5,cexRow = 1.5,margins = c(10,15))

 

 

 


 

你可能感兴趣的:(R语言 热力图,相关系数图, 美化,以及各种调参。)