先对数据进行处理,然后用ggplot2
包中的geom_rect()
函数绘制热力图。
# 构造数据
df<-data.frame(birdID=1:30,
time=runif(30,min=1,max=24),
height=runif(30,min=0,max=100))
head(df)
#> birdID time height
#> 1 1 12.382977 5.531958
#> 2 2 18.721666 93.664051
#> 3 3 22.465574 77.926301
#> 4 4 8.413322 50.787016
#> 5 5 3.307926 83.626955
#> 6 6 5.527041 34.118721
# 数据分组
time_group<-cut(df$time,1:24,include.lowest=TRUE)
height_group<-cut(df$height,seq(0,100,10),include.lowest=TRUE)
df1<-aggregate(birdID~time_group+height_group,data=df,FUN=length)
colnames(df1)<-c("time_group","height_group","counts")
head(df1)
#> time_group height_group counts
#> 1 (12,13] [0,10] 2
#> 2 (16,17] [0,10] 1
#> 3 (19,20] [0,10] 1
#> 4 (9,10] (10,20] 1
#> 5 (11,12] (10,20] 1
#> 6 (17,18] (10,20] 1
# 对数据进行处理以用geom_rect()画图
a<-gsub(pattern="\\(|\\]|\\[",replacement ="",
x=as.character(df1$time_group))
time_min<-unlist(lapply(strsplit(a,','),function(x){as.numeric(x[1])}))
time_max<-unlist(lapply(strsplit(a,','),function(x){as.numeric(x[2])}))
b<-gsub(pattern="\\(|\\]|\\[",replacement ="",
x=as.character(df1$height_group))
height_min<-unlist(lapply(strsplit(b,','),function(x){as.numeric(x[1])}))
height_max<-unlist(lapply(strsplit(b,','),function(x){as.numeric(x[2])}))
df1$time_max<-time_max
df1$time_min<-time_min
df1$height_min<-height_min
df1$height_max<-height_max
head(df1)
#> time_group height_group counts time_max time_min height_min height_max
#> 1 (12,13] [0,10] 2 13 12 0 10
#> 2 (16,17] [0,10] 1 17 16 0 10
#> 3 (19,20] [0,10] 1 20 19 0 10
#> 4 (9,10] (10,20] 1 10 9 10 20
#> 5 (11,12] (10,20] 1 12 11 10 20
#> 6 (17,18] (10,20] 1 18 17 10 20
# 绘图
library(ggplot2)
ggplot(df1)+
geom_rect(aes(
xmin=time_min,xmax=time_max,
ymin=height_min,ymax=height_max,
fill=counts),show.legend=FALSE)+
geom_text(aes(
x=(time_min+time_max)/2,
y=(height_min+height_max)/2,
label=counts,colour=1/counts),show.legend=FALSE)+
labs(x='time',y='height')+
scale_x_continuous(limits=c(1,24), breaks=seq(1,24,1))+
scale_y_continuous(limits=c(0,100), breaks=seq(0,100,10))+
theme(panel.grid.minor=element_blank())
<sup>Created on 2021-07-07 by the reprex package (v2.0.0)</sup>
图片大概这样