热力图

热力图和等高线图

热力图
sales<-read.csv("sales.csv")
install.packages("RColorBrewer")
library(RColorBrewer)

rownames(sales)<-sales[,1]#只取第一列
sales<-sales[,-1]#取第一列以外的所有列
data_matrix<-data.matrix(sales)

pal=brewer.pal(7,"YlOrRd")#取色

breaks<-seq(3000,12000,1500)


layout(matrix(data=c(1,2), nrow=1, ncol=2), widths=c(8,1),
heights=c(1,1))#Create layout with 1 row and 2 columns (for the heatmap and scale);
the heatmap column is 8 times as wide as the scale column。右边的列是画热力图，左边的列画图例。


par(mar = c(5,10,4,2),oma=c(0.2,0.2,0.2,0.2),mex=0.5)#Set margins for the heatmap

image(x=1:nrow(data_matrix),y=1:ncol(data_matrix),#image函数的功能就是根据z值得不同配不同的颜色。
z=data_matrix,axes=FALSE,xlab="Month",#axes=FALSE,先不画坐标轴。
ylab="",col=pal[1:(length(breaks)-1)],
breaks=breaks,main="Sales Heat Map")

axis(1,at=1:nrow(data_matrix),labels=rownames(data_matrix),
col="white",las=1)#x轴

axis(2,at=1:ncol(data_matrix),labels=colnames(data_matrix),
col="white",las=1)#y轴

abline(h=c(1:ncol(data_matrix))+0.5,
v=c(1:nrow(data_matrix))+0.5, col="white",lwd=2,xpd=FALSE)#画格子

breaks2<-breaks[-length(breaks)]

# Color Scale 以下部分是画图例
par(mar = c(5,1,4,7))
# If you get a figure margins error while running the above code,
enlarge the plot device or adjust the margins so that the graph and
scale fit within the device.

image(x=1, y=0:length(breaks2),z=t(matrix(breaks2))*1.001,#*1.001是为了画图颜色容易，不然卡在分界点
col=pal[1:length(breaks)-1],axes=FALSE,breaks=breaks,
xlab="", ylab="",xaxt="n")

axis(4,at=0:(length(breaks2)-1), labels=breaks2, col="white",
las=1)

abline(h=c(1:length(breaks2)),col="white",lwd=2,xpd=F)

 

相关性热力图
genes<-read.csv("genes.csv")

rownames(genes)<-genes[,1]
data_matrix<-data.matrix(genes[,-1])

pal=heat.colors(5)

breaks<-seq(0,1,0.2)

layout(matrix(data=c(1,2), nrow=1, ncol=2), widths=c(8,1),
heights=c(1,1))

par(mar = c(3,7,12,2),oma=c(0.2,0.2,0.2,0.2),mex=0.5)

image(x=1:nrow(data_matrix),y=1:ncol(data_matrix),
z=data_matrix,xlab="",ylab="",breaks=breaks,
col=pal,axes=FALSE)

text(x=1:nrow(data_matrix)+0.75, y=par("usr")[4] + 1.25,
srt = 45, adj = 1, labels = rownames(data_matrix),
xpd = TRUE)

axis(2,at=1:ncol(data_matrix),labels=colnames(data_matrix),
col="white",las=1)

abline(h=c(1:ncol(data_matrix))+0.5,v=c(1:nrow(data_matrix))+0.5,
col="white",lwd=2,xpd=F)

title("Correlation between genes",line=8,adj=0)

breaks2<-breaks[-length(breaks)]

# Color Scale
par(mar = c(25,1,25,7))
image(x=1, y=0:length(breaks2),z=t(matrix(breaks2))*1.001,
col=pal[1:length(breaks)-1],axes=FALSE,
breaks=breaks,xlab="",ylab="",
xaxt="n")

axis(4,at=0:(length(breaks2)),labels=breaks,col="white",las=1)
abline(h=c(1:length(breaks2)),col="white",lwd=2,xpd=F)

 

nba <- read.csv("nba.csv")

rownames(nba)<-nba[,1]

data_matrix<-t(scale(data.matrix(nba[,-1])))

pal=brewer.pal(6,"Blues")

statnames<-c("Games Played", "Minutes Played", "Total Points",
"Field Goals Made", "Field Goals Attempted", 
"Field Goal Percentage", "Free Throws Made", 
"Free Throws Attempted", "Free Throw Percentage", 
"Three Pointers Made", "Three Pointers Attempted", 
"Three Point Percentage", "Offensive Rebounds", 
"Defensive Rebounds", "Total Rebounds", "Assists", "Steals", 
"Blocks", "Turnovers", "Fouls")

par(mar = c(3,14,19,2),oma=c(0.2,0.2,0.2,0.2),mex=0.5)

#Heat map 
image(x=1:nrow(data_matrix),y=1:ncol(data_matrix),
z=data_matrix,xlab="",ylab="",col=pal,axes=FALSE)

#X axis labels
text(1:nrow(data_matrix), par("usr")[4] + 1, 
srt = 45, adj = 0,labels = statnames,
xpd = TRUE, cex=0.85)

#Y axis labels
axis(side=2,at=1:ncol(data_matrix),
labels=colnames(data_matrix),
col="white",las=1, cex.axis=0.85)

#White separating lines
abline(h=c(1:ncol(data_matrix))+0.5,v=c(1:nrow(data_matrix))+0.5,
col="white",lwd=1,xpd=F)

#Graph Title
text(par("usr")[1]+5, par("usr")[4] + 12,
"NBA per game performance of top 50corers", 
xpd=TRUE,font=2,cex=1.5)

nba <- nba[order(nba$PTS),]