日历热力图

实现上面图形的R代码如下：

library(ggplot2)
library(plyr)
# 数据生成
date <- seq.Date(from=as.Date('2017-01-01'), to=as.Date('2017-12-31'), by='1 day')
date.range <- as.character(format(date,"%Y-%m-%d"))
n <- length(date.range)

Movement <- abs(round(rnorm(n)*10,0))
myMovement <- data.frame('date' = date.range,Movement)
dat <- myMovement
head(dat)
str(dat)
# 将date转化成日期数据
dat$date <- as.Date(dat$date)
str(dat)
# 先取得月份，再转为因子格式
dat$month<-as.numeric(as.POSIXlt(dat$date)$mon+1)
dat$monthf<-factor(dat$month,levels=as.character(1:12),
                   labels=c("Jan","Feb","Mar","Apr","May","Jun","Jul",
                            "Aug","Sep","Oct","Nov","Dec"),ordered=TRUE)
# 得到每周的星期，也转为因子格式
dat$weekday = as.POSIXlt(dat$date)$wday  
dat$weekdayf<-factor(dat$weekday,levels=c("0","1","2","3","4","5","6"),
                     labels=c("Sun","Mon","Tue","Wed","Thu","Fri","Sat"),ordered=TRUE)
# 先得到全年的周序号，然后得到每个月的周序号
dat$week <- as.numeric(format(dat$date,"%W"))
dat <- ddply(dat, .(monthf), transform, monthweek = 1 + week - min(week))
dat$monthweek <- ifelse(dat$weekday == 0, dat$monthweek + 1, dat$monthweek)
dat$monthweek <- factor(dat$monthweek,levels = c("6","5","4","3","2","1"))
# 先得到每月的日期,再转化成因子
dat$Monthday <- as.numeric(as.POSIXlt(dat$date)$mday)
dat$Monthday <- as.character(dat$Monthday)
P <- ggplot(dat, aes(weekdayf, monthweek, fill = Movement)) +
  geom_tile(colour='white') +
  facet_wrap(~monthf ,nrow=3) +
  labs(title = "2017-Movement") +
  xlab("") + ylab("") + 
  geom_text(data = dat,aes(label = Monthday)) +
  theme(plot.title = element_text(hjust = 0.5),# 标题居中
        axis.text.x = element_text(angle = 45,hjust = 1,vjust = 1),
        axis.text.y = element_blank(),
        axis.ticks.y = element_blank()) +
  scale_fill_gradient(name = "Time(min)",space="Lab",limits=c(0, max(dat$Movement)),
                      low="#F0F8FF", high="red")
P

参数解释：