rm(list = ls())
library(ggplot2)
library(reshape2)
# test data
mydata <- mtcars[, c(1,3,4,5,6,7)]
head(mydata);dim(mydata);class(mydata)
## mpg disp hp drat wt qsec
## Mazda RX4 21.0 160 110 3.90 2.620 16.46
## Mazda RX4 Wag 21.0 160 110 3.90 2.875 17.02
## Datsun 710 22.8 108 93 3.85 2.320 18.61
## Hornet 4 Drive 21.4 258 110 3.08 3.215 19.44
## Hornet Sportabout 18.7 360 175 3.15 3.440 17.02
## Valiant 18.1 225 105 2.76 3.460 20.22
## [1] 32 6
## [1] "data.frame"
#Compute the correlation matrix
cormat <- round(cor(mydata),2)
cormat
## mpg disp hp drat wt qsec
## mpg 1.00 -0.85 -0.78 0.68 -0.87 0.42
## disp -0.85 1.00 0.79 -0.71 0.89 -0.43
## hp -0.78 0.79 1.00 -0.45 0.66 -0.71
## drat 0.68 -0.71 -0.45 1.00 -0.71 0.09
## wt -0.87 0.89 0.66 -0.71 1.00 -0.17
## qsec 0.42 -0.43 -0.71 0.09 -0.17 1.00
melted_cormat <- melt(cormat)
head(melted_cormat)
## Var1 Var2 value
## 1 mpg mpg 1.00
## 2 disp mpg -0.85
## 3 hp mpg -0.78
## 4 drat mpg 0.68
## 5 wt mpg -0.87
## 6 qsec mpg 0.42
lower_tri <- cormat
lower_tri[lower.tri(lower_tri)] <- NA #OR upper.tri function
lower_tri
## mpg disp hp drat wt qsec
## mpg 1 -0.85 -0.78 0.68 -0.87 0.42
## disp NA 1.00 0.79 -0.71 0.89 -0.43
## hp NA NA 1.00 -0.45 0.66 -0.71
## drat NA NA NA 1.00 -0.71 0.09
## wt NA NA NA NA 1.00 -0.17
## qsec NA NA NA NA NA 1.00
#Finished correlation matrix heatmap
melted_cormat <- reshape2::melt(lower_tri, na.rm = TRUE)
order_1 <- data.frame(table(melted_cormat$Var2))
order_2 <- as.character(order_1$Var1[sort(order_1$Freq,decreasing = T)])
order_2
## [1] "qsec" "wt" "drat" "hp" "disp" "mpg"
melted_cormat$Var2 <- factor(melted_cormat$Var2,levels = order_2)
################################################################### Heatmap
########################################
data_1 <- data.frame(x1 = 1:length(order_2), y1 = length(order_2):1, z = order_2)
data_1$label <- rep(LETTERS[1:3],2)
data_1
## x1 y1 z label
## 1 1 6 qsec A
## 2 2 5 wt B
## 3 3 4 drat C
## 4 4 3 hp A
## 5 5 2 disp B
## 6 6 1 mpg C
data_2 <- data.frame(x2 = 4:c(4+length(unique(data_1$label))-1), y2 = c(4+length(unique(data_1$label))-1):4, label = unique(data_1$label))
data_1; data_2
## x1 y1 z label
## 1 1 6 qsec A
## 2 2 5 wt B
## 3 3 4 drat C
## 4 4 3 hp A
## 5 5 2 disp B
## 6 6 1 mpg C
## x2 y2 label
## 1 4 6 A
## 2 5 5 B
## 3 6 4 C
data_line <- merge(data_1, data_2, by = "label")
#################################################
ggplot(data = melted_cormat, aes(Var2, Var1, fill = value))+
geom_tile(color = "white") +
scale_fill_gradient2(low = "blue", high = "red", mid = "white",
midpoint = 0, limit = c(-1,1), space = "Lab",
name="Pearson\nCorrelation") +
coord_fixed() +
geom_text(aes(Var2, Var1, label = value), color = "black", size = 4) #+
#####################################################plot add point line
melted_cormat$Var11 <- as.integer(factor(melted_cormat$Var1))
melted_cormat$Var22 <- as.integer(factor(melted_cormat$Var2))
p1 <- ggplot()+
geom_tile(data = melted_cormat, aes(Var22, Var11, fill = value),color = "white") +
scale_fill_gradient2(low = "blue", high = "red", mid = "white",
midpoint = 0, limit = c(-1,1), space = "Lab",
name="Pearson\nCorrelation") +
coord_fixed() +
geom_text(data = melted_cormat, aes(Var22, Var11, label = value), color = "black", size = 4) +
geom_curve(data=data_line, aes(x=x1,y=y1,
xend=x2,yend=y2,
color=label),
curvature = -0.1,size=1, show.legend =F) +
geom_point(data = data_1, aes(x=x1,y=y1), size = 5, color = "green") +
geom_point(data= data_2, aes(x=x2,y=y2), size = 5, color = "red") +
scale_color_manual(values=c("#b85315","#189164","#bababa")) +
geom_text(data= data_2, aes(x=x2,y=y2,label = label), hjust= -1, vjust= 0.5)
p2 <- p1 + scale_x_discrete(name ="AA", limits=order_2) +
scale_y_discrete(name ="BB", limits = rev(order_2))
p2 + theme(plot.margin=unit(c(1,1,1.5,1.2),"cm"),
legend.position = "right",
legend.direction = "vertical",
legend.justification=c(0,1),
panel.background = element_blank(),
axis.ticks = element_blank(),
axis.text.y = element_text(colour="black",size=10,face="plain",family = "sans",
hjust = 1, margin = margin(l = 10, r = -2)),
axis.text.x = element_text(colour="black",size=10,face="plain",family = "sans",
angle = 45, vjust = 1.2, hjust = 1),
axis.title = element_blank(),
legend.background = element_blank(),
legend.key = element_rect(colour = NA, fill = NA))
##############################
#ggsave(filename = paste0(Sys.Date(),"heatmap_line_point.tif"),
# plot = last_plot(), device = "tiff", path = dir_path,
# width = 18, height = 15, units = "cm",
# dpi = 300, limitsize = TRUE)
#symmetry correlation matrix
#ref https://rpubs.com/TX-YXL/665773
#https://stdworkflow.com/1080/use-r-language-ggplot2-to-draw-points-and-lines-to-show-the-results-of-mantel-s-test