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语言热图怎么实现"这篇文章的内容，相信大家都有了一定的了解，希望小编分享的内容对大家有帮助，若想了解更多相关的知识内容，请关注行业资讯频道。