R语言热图怎么实现
这篇“R语言热图怎么实现”文章的知识点大部分人都不太理解，所以小编给大家总结了以下内容，内容详细，步骤清晰，具有一定的借鉴价值，希望大家阅读完这篇文章能有所收获，下面我们一起来看看这篇“R语言热图怎么实现”文章吧。
员工经过长期磨合与沉淀，具备了协作精神，得以通过团队的力量开发出优质的产品。创新互联坚持“专注、创新、易用”的产品理念，因为“专注所以专业、创新互联网站所以易用所以简单”。公司专注于为企业提供网站建设、网站制作、微信公众号开发、电商网站开发，小程序制作，软件按需网站建设等一站式互联网企业服务。
热图(一)-- heatmap
rc <- rainbow(nrow(test),start = 0, end = .3)
cc <- rainbow(ncol(test),start = 0, end = .3)
heatmap(test,cexCol=0.9,labRow=NA,main = "Heatmap")
heatmap(test, col = cm.colors(256), scale = "column", RowSideColors = rc, ColSideColors = cc, margins = c(5,10), main = "Heatmap(rainbow color)")
热图(二)-- pheatmap
library(pheatmap)
annotation_row = data.frame(GeneClass = factor(rep(c("Path2", "Path3", "Path4"), c(10, 4, 6))))
annotation_col = data.frame(CellType = factor(rep(c("CT1", "CT2"), 5)), Time = 1:5)
pheatmap(test,border_color=NA,col=rainbow(nrow(test),start = 0, end = .3),cexCol=0.9,cellwidth = 30,
cellheight = 18,main = "Pheatmap")
par(mar=c(5,4,8,10))
pheatmap(test,main = 'Pheatmap')
### add numbers
pheatmap(test,
border_color=NA,
col=rainbow(nrow(test),
start = 0, end = .3),
cexCol=0.9,
cellwidth = 30,
cellheight = 18,
display_numbers=T,
main = "Pheatmap")
热图(三)-- heatmap.2
library(gplots)
heatmap.2(test,keysize=1.5,symkey=F,density.info="none",trace="none",labRow=NA,
col="heat.colors",main="heatmap.2")
xval <- formatC(test, format="f", digits=2)
pal <- colorRampPalette(c(rgb(0.96,0.96,1), rgb(0.1,0.1,0.9)), space = "rgb")
heatmap.2(test,
symkey=F,
density.info="none",
labRow=NA,
col=pal,
tracecol="#303030",
trace="none",
cellnote=xval,
notecol="black",
notecex=0.8,
keysize=1.5,
main="heatmap.2")
热图(四)-- ggplot2（上、下三角热图）
mydata <- mtcars[, c(1,3,4,5,6,7)]
head(mydata)
cormat <- round(cor(mydata),2)
head(cormat)
library(reshape2)
melted_cormat <- melt(cormat)
head(melted_cormat)
library(ggplot2)
ggplot(data = melted_cormat, aes(x=Var1, y=Var2, fill=value)) +
geom_tile()
############################### 2
# Get lower triangle of the correlation matrix
get_lower_tri<-function(cormat){
cormat[upper.tri(cormat)] <- NA
return(cormat)
}
# Get upper triangle of the correlation matrix
get_upper_tri <- function(cormat){
cormat[lower.tri(cormat)]<- NA
return(cormat)
}
upper_tri <- get_upper_tri(cormat)
upper_tri
# Melt the correlation matrix
library(reshape2)
melted_cormat <- melt(upper_tri)
melted_cormat <- na.omit(melted_cormat)
# Heatmap
library(ggplot2)
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), name="Pearson\nCorrelation") +
theme_minimal()+
theme(axis.text.x = element_text(angle = 45, vjust = 1,
size = 12, hjust = 1))+
coord_fixed()
################################### 3
reorder_cormat <- function(cormat){
# Use correlation between variables as distance
dd <- as.dist((1-cormat)/2)
hc <- hclust(dd)
cormat <-cormat[hc$order, hc$order]
}
# Reorder the correlation matrix
cormat <- reorder_cormat(cormat)
upper_tri <- get_upper_tri(cormat)
# Melt the correlation matrix
melted_cormat <- melt(upper_tri)
melted_cormat <- na.omit(melted_cormat)
# Create a ggheatmap
ggheatmap <- ggplot(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), name="Pearson\nCorrelation") +
theme_minimal()+ # minimal theme
theme(axis.text.x = element_text(angle = 45, vjust = 1,
size = 12, hjust = 1))+
coord_fixed()
# Print the heatmap
print(ggheatmap)
########################################4
ggheatmap +
geom_text(aes(Var2, Var1, label = value), color = "black", size = 4) +
theme(
axis.title.x = element_blank(),
axis.title.y = element_blank(),
panel.grid.major = element_blank(),
panel.border = element_blank(),
panel.background = element_blank(),
axis.ticks = element_blank(),
legend.justification = c(1, 0),
legend.position = c(0.6, 0.7),
legend.direction = "horizontal")+
guides(fill = guide_colorbar(barwidth = 7, barheight = 1,
title.position = "top", title.hjust = 0.5))
热图(五)-- LDheatmap
#source("http://bioconductor.org/biocLite.R")
#biocLite("Heatplus")
library(Heatplus)
library(LDheatmap)
library(combinat)
library(genetics)
data(CEUData)
MyHeatmap <- LDheatmap(CEUSNP, genetic.distances = CEUDist,
color = grey.colors(20))
flippedHeatmap<-LDheatmap(MyHeatmap,flip=TRUE)
old.prompt <- devAskNewPage(ask = TRUE)
LDheatmap.highlight(MyHeatmap, i = 3, j = 8, col = "black", fill = "grey" )
# Plot a symbol in the center of the pixel which represents LD between
# the fourth and seventh SNPs:
LDheatmap.marks(MyHeatmap, 4, 7, gp=gpar(cex=2), pch = "*")
rgb.palette <- colorRampPalette(rev(c("blue", "orange", "red")), space = "rgb")
LDheatmap(MyHeatmap, color=rgb.palette(18))
热图(六)--其他
a) 系统树颜色
data <- read.table("E:/Mariel_ma/DATA/sig_expression.txt",header = TRUE,sep='\t')
head(data)
sig <- log2(data[,2:ncol(data)]+1)
data1<-as.matrix(sig)
#rownames(data1)<- data[,1]
#data3 <- data1[1:12,]
library(gplots)
library("devtools")
my_palette <- colorRampPalette(c("Magenta","Goldenrod3","SpringGreen3"))(n = nrow(data1))
heatmap.2(data1,keysize=1.5,symkey=F,denscol=tracecol,
density.info="none",trace="none",scale="row",dendrogram ="row",
labRow=NA,col=my_palette,
margins = c(8,8))
#data2 <-data1[1:12,]
#source("http://bioconductor.org/biocLite.R")
#biocLite("Heatplus") # annHeatmap or annHeatmap2
data2 <-data1
my_palette <- colorRampPalette(c("Magenta","Goldenrod3","SpringGreen3"))(n = nrow(data1))
library(Heatplus)
library(permute)
library(vegan)
library(RColorBrewer)
library(gplots)
data.dist <- vegdist(data2, method = "bray")
row.clus <- hclust(data.dist, "aver")
var1 <- round(runif(n = nrow(data2), min = 1, max = 2))
var1 <- replace(var1, which(var1 == 1), "deepskyblue")
var1 <- replace(var1, which(var1 == 2), "magenta")
#cbind(row.names(data2), var1)
data.dist.g <- vegdist(t(data2), method = "bray")
col.clus <- hclust(data.dist.g, "aver")
#heatmap.2(data2,Rowv = as.dendrogram(row.clus),
Colv = as.dendrogram(col.clus), col = my_palette,
RowSideColors = var1, margins = c(10, 3))
heatmap.2(data2, Rowv = as.dendrogram(row.clus),
Colv = as.dendrogram(col.clus), col = my_palette,
RowSideColors = var1, margins = c(11, 5), trace = "none",
density.info = "none", xlab = "genera", ylab = "Samples",
main = "Heatmap example", lhei = c(2, 8))
#plot(annHeatmap2(data2,col = colorRampPalette(c("Magenta","Goldenrod3","SpringGreen3"),
space = "rgb")(61), breaks = 50,dendrogram = list(Row = list(dendro = as.dendrogram(row.clus)),
Col = list(dendro = as.dendrogram(col.clus))), legend = 3,labels = list(Col = list(nrow = 12))))
plot(annHeatmap2(data2, col = colorRampPalette(c("Magenta","Goldenrod3","SpringGreen3"),
space = "rgb")(61), breaks = 50, dendrogram = list(Row = list(dendro = as.dendrogram(row.clus)),
Col = list(dendro = as.dendrogram(col.clus))),
legend = 3, labels = list(Col = list(nrow = 6)),
ann = list(Row = list(data = ann.dat))
))
ann.dat <- data.frame(var1 = c(rep("cat1", 200), rep("cat2", 496)),
var2 = rnorm(nrow(data2), mean = 50, sd = 20))
plot(annHeatmap2(data2, col = colorRampPalette(c("Magenta","Goldenrod3","SpringGreen3"),
space = "rgb")(61), breaks = 50, dendrogram = list(Row = list(dendro = as.dendrogram(row.clus)),
Col = list(dendro = as.dendrogram(col.clus))),
legend = 3, labels = list(Col = list(nrow = 6)),
ann = list(Row = list(data = ann.dat)),
cluster = list(Row = list(cuth = 0.76, col = brewer.pal(4, "Set2")))
))
热图(六)--其他
b) 注释信息
library(MASS)
library(pheatmap)
library(RColorBrewer)
sim.expr.data <- function(n, n0, p, rho.0, rho.1){
n1 = n - n0
times = 1:p # used for creating covariance matrix
H <- abs(outer(times, times, "-"))
V0 <- rho.0^H
V1 <- rho.1^H
# rows are people, columns are genes
genes0 <- MASS::mvrnorm(n = n0, mu = rep(0,p), Sigma = V0)
genes1 <- MASS::mvrnorm(n = n1, mu = rep(0,p), Sigma = V1)
genes <- rbind(genes0,genes1)
return(genes)
}
n = 100 ; n0 = 50 ; n1 = 50; p = 100
genes <- sim.expr.data(n = 100, n0 = 50, p = 100,
rho.0 = 0.01, rho.1 = 0.95)
colnames(genes) <- paste0("Gene", 1:p)
rownames(genes) <- paste0("Subject", 1:n)
genes[1:5, 1:5]
# RColorBrewer::display.brewer.all()
col.pal <- RColorBrewer::brewer.pal(9, "Reds")
annotation_col <- data.frame(
Exposure = factor(c(rep("X=0",n0), c(rep("X=1", n1)))),
Type = factor(sample(c("T-cell","B-cell"),n, replace=T)))
rownames(annotation_col) = paste0("Subject", 1:n)
head(annotation_col)
annotation_row <- data.frame(
Pathway = factor(rep(1:4,each=25)))
rownames(annotation_row) = paste0("Gene", 1:n)
head(annotation_row)
pheatmap::pheatmap(t(genes),
cluster_row = T,
cluster_cols = F,
annotation_col = annotation_col,
annotation_row = annotation_row,
color = col.pal,
fontsize = 6.5,
fontsize_row=6,
fontsize_col = 6,
gaps_col=50)
热图(六)--其他
c) triple heatmap
library(ggplot2);
library(reshape2)
library (grid)
#X axis quantitaive ggplot data
datfx <- data.frame(indv=factor(paste("ID", 1:20, sep = ""),
levels =rev(paste("ID", 1:20, sep = ""))), matrix(sample(LETTERS[1:7],80, T), ncol = 4))
# converting data to long form for ggplot2 use
datf1x <- melt(datfx, id.var = 'indv')
plotx <- ggplot(datf1x, aes(indv, variable)) + geom_tile(aes(fill = value),
colour = "white") + scale_fill_manual(values= terrain.colors(7))+ scale_x_discrete(expand=c(0,0))
px <- plotx
#Y axis quantitaive ggplot data
datfy <- data.frame(indv=factor(paste("ID", 21:40, sep = ""),
levels =rev(paste("ID",21:40, sep = ""))), matrix(sample(LETTERS[7:10],100, T), ncol = 5))
# converting data to long form for ggplot2 use
datf1y <- melt(datfy, id.var = 'indv')
ploty <- ggplot(datf1y, aes( variable, indv)) + geom_tile(aes(fill = value),
colour = "white") + scale_fill_manual(values= c("cyan4", "midnightblue", "green2", "lightgreen")) + scale_x_discrete(expand=c(0,0))
py <- ploty + theme(legend.position="left", axis.title=element_blank())
)
# plot XY quantative fill
datfxy <- data.frame(indv=factor(paste("ID", 1:20, sep = ""),
levels =rev(paste("ID", 1:20, sep = ""))), matrix(rnorm (400, 50, 10), ncol = 20))
names (datfxy) <- c("indv",paste("ID", 21:40, sep = ""))
datfxy <- melt(datfxy, id.var = 'indv')
levels (datfxy$ variable) <- rev(paste("ID", 21:40, sep = ""))
pxy <- plotxy <- ggplot(datfxy, aes(indv, variable)) + geom_tile(aes(fill = value),
colour = "white") + scale_fill_gradient(low="red", high="yellow") + theme(
axis.title=element_blank())
#Define layout for the plots (2 rows, 2 columns)
layt<-grid.layout(nrow=2,ncol=2,heights=c(6/8,2/8),widths=c(2/8,6/8),default.units=c('null','null'))
#View the layout of plots
grid.show.layout(layt)
#Draw plots one by one in their positions
grid.newpage()
pushViewport(viewport(layout=layt))
print(py,vp=viewport(layout.pos.row=1,layout.pos.col=1))
print(pxy,vp=viewport(layout.pos.row=1,layout.pos.col=2))
print(px,vp=viewport(layout.pos.row=2,layout.pos.col=2))
以上就是关于“R语言热图怎么实现”这篇文章的内容，相信大家都有了一定的了解，希望小编分享的内容对大家有帮助，若想了解更多相关的知识内容，请关注创新互联行业资讯频道。
分享名称：R语言热图怎么实现
分享网址：http://mswzjz.cn/article/ppcppp.html