用R语言画日历

当我们拿到一系列连续的时间序列数据（比如气候数据，利率数据等），可以用日历图来直观的显示数据的变化程度，而在R中有多种方式可以实现日历图。

首先日历图有两种，一是以年为整体单位，一是像我们常用的日历一样以月为单位。在本文中，以年为单位的日历图我们使用基于ggplot2衍生的ggTimeSeries包两种函数作图，以月为单位的日历图我们使用ggplot 和openair包两种方法作图

数据说明

年日历图数据
数据说明：美国2016年1月1号到2020年12月31号的十年期国债收益率数据

数据来源：https://fred.stlouisfed.org/series/DGS10

月日历图数据
数据说明：来自openair包的伦敦气象检测站数据mydata

年日历图

首先我们安装ggTimeSeries包，此包需通过github安装，网上大多数相关文章里对ggTimeSeries包来源的原始网址已失效，目前实测有效的安装方法为：

devtools::install_github('Ather-Energy/ggTimeSeries')

安装成功后，我们来画图,ggTimeSeries包中有两种函数可以画年日历图，第一种是ggplot_calendar_heatmap, 第二种是接在ggplot后面的stat_calendar_heatmap

数据处理

library(tidyverse)
library(lubridate)
library(quantmod)
# 获取数据
getSymbols('DGS10',src='FRED')

# 提取时间段数据
DGS <- DGS10[(index(DGS10) >= "2016-01-01" & index(DGS10) <= "2020-12-31"),]
# 转为dataframe
DGS <- data.frame(Date=index(DGS),DGS= as.numeric(DGS$DGS10))
head(DGS)

##         Date  DGS
## 1 2016-01-01   NA
## 2 2016-01-04 2.24
## 3 2016-01-05 2.25
## 4 2016-01-06 2.18
## 5 2016-01-07 2.16
## 6 2016-01-08 2.13

ggplot_calendar_heatmap()

ggplot_calendar_heatmap() 函数作图比较简单，只需要数据有 日期 和 值 两列，自动设定了横纵日历坐标，后面也可以像ggplot一样添加其他作图元素

首先，仅设置函数里的参数，做出的图是下面这样

library(ggTimeSeries)
library(RColorBrewer)
ggplot_calendar_heatmap(DGS,
                        cDateColumnName = "Date", # 日期列名
                        cValueColumnName = "DGS", # 值列名
                        monthBorderSize = 1    # 月度分界线粗细
                        )

原始图看起来有点着急，接下来，加一些图形设置的参数做美化，调整之后是这样：

ggplot_calendar_heatmap(DGS,
                        cDateColumnName = "Date", # 日期列名
                        cValueColumnName = "DGS", # 值列名
                        dayBorderSize = 0.05,      # 日度框线粗细 最细只能到0.5
                        dayBorderColour = "grey", # 日度框线颜色
                        monthBorderSize = 0.8    # 月度分界线粗细
                        )+ 
  # 设置分面 Year是默认的年分面方式， strip.position设置分面子图标题位置
  facet_wrap(~Year,ncol = 1,strip.position = "right") + 
  # 设置颜色
  scale_fill_gradientn(colours= rev(brewer.pal(11,'Spectral'))) +
  # 设置背景细节
  theme( panel.background = element_blank(),
         panel.border = element_rect(colour="grey60",fill=NA),
         strip.background = element_blank(),
         strip.text = element_text(size=13,face="plain",color="black"))

stat_calendar_heatmap()

stat_calendar_heatmap()函数是可以接在正常的ggplot后面的函数，但是这需要对原始数据做一定的设置,比如计算月份和周数，而且在最后设置月份和周的标签时也要独立设置

# 数据处理
DGS <- DGS %>% mutate(Year = year(Date), # 年份
                      month=month(Date), # 月
                      week=week(Date),   # 周数
                      )

# 设置月标签
MonthLabels <- DGS %>% group_by(month) %>% summarise(Monthweek=mean(week))
MonthLabels$month <- month.abb[MonthLabels$month]
# 周标签
WeekLabels <- c("Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun")
head(DGS)

##         Date  DGS Year month week
## 1 2016-01-01   NA 2016     1    1
## 2 2016-01-04 2.24 2016     1    1
## 3 2016-01-05 2.25 2016     1    1
## 4 2016-01-06 2.18 2016     1    1
## 5 2016-01-07 2.16 2016     1    1
## 6 2016-01-08 2.13 2016     1    2

# 画图
ggplot(data=DGS,aes(date=Date,fill=DGS))+
  stat_calendar_heatmap()+
  facet_wrap(~Year,ncol = 1,strip.position = "right") + 
  # 设置颜色
  scale_fill_gradientn(colours= rev(brewer.pal(11,'Spectral'))) +
  # 设置标签
  scale_y_continuous(breaks=seq(7, 1, -1),labels=WeekLabels)+
  scale_x_continuous(breaks = MonthLabels$Monthweek, labels = MonthLabels$month,expand = c(0, 0)) +
  # 设置背景细节
  theme( panel.background = element_blank(),
         panel.border = element_rect(colour="grey",fill=NA),
         strip.background = element_blank(),
         strip.text = element_text(size=13,face="plain",color="black"))

两种函数图形对比，差异主要体现在每日色块的框线以及缺失值部分的颜色上。

月度日历图

openair

openair包是由英国利兹大学ITS，伦敦国王学院以及defra联合开发的专门针对空气污染数据分析的函数包，在cran中可以直接搜索到，安装方法为:

install.packages('openair')

这里我们仅使用其中的污染物数据 mydata 和日历图函数calendarPlot.

library(openair)
# 载入数据
data(mydata)
head(mydata)

## # A tibble: 6 x 10
##   date                   ws    wd   nox   no2    o3  pm10   so2    co  pm25
##                         
## 1 1998-01-01 00:00:00  0.6    280   285    39     1    29  4.72  3.37    NA
## 2 1998-01-01 01:00:00  2.16   230    NA    NA    NA    37 NA    NA       NA
## 3 1998-01-01 02:00:00  2.76   190    NA    NA     3    34  6.83  9.60    NA
## 4 1998-01-01 03:00:00  2.16   170   493    52     3    35  7.66 10.2     NA
## 5 1998-01-01 04:00:00  2.4    180   468    78     2    34  8.07  8.91    NA
## 6 1998-01-01 05:00:00  3      190   264    42     0    16  5.50  3.05    NA

数据有10列，我们使用ws列（风速），取2000年数据作图

calendarPlot(mydata, 
             pollutant = "ws", # 数据所在列名
             year = 2000, # 年份取值
             main="伦敦2000风速日历"
             )

图形函数中可以像plot一样设置参数，上图中x轴标签全是星，因为地理位置在中国，我们可以对时区以及颜色做进一步设置

# 设置为英国时区
Sys.setlocale(locale = "C")
# 画图
calendarPlot(mydata, 
             pollutant = "ws", # 数据所在列名
             year = 2000, # 年份取值
             cols = c("steelblue","green", "yellow",  "red"), # 设置颜色
             main="London WindSpeed Calendar 2013"
             )

ggplot

月度日历图可以使用ggplot的geom_tile()来实现，我们首先解析一下日历的结构，如果设定一个坐标轴，可以吧日历看成是横轴为 周一-周日，纵轴为当月第几周的一个方块图，因此通过geom_tile实现日历图时需要在数据里计算出星期日和月内周数量。

# 数据处理
ws_20 <- mydata %>% filter(year(date)==2000) %>%
  mutate(Date = date(date)) %>%
  # 取每日的均值
  group_by(Date) %>%
  summarise(ws = mean(ws,na.rm=T)) %>%
  # 设置月和周
  mutate(Month = lubridate::month(Date,label = T),
         Week = as.integer(strftime(Date, '%W')),
         Weekdayf = as.integer(strftime(Date, '%w')),
         # 直接取的周是从周一开始，而周内日数字是周日是0，所以讲所有的weekdayf为0的周数字加1
         Week = ifelse(Weekdayf==0,Week+1,Week),
         ) %>%
  # 按月统计周
  group_by(Month) %>%
  mutate(Weekday = lubridate::wday(Date,label=T), # 周日
         MonthWeek = Week + 1 - min(Week), # 月
         Days = mday(Date) # 月日
        )

head(ws_20)

## # A tibble: 6 x 8
## # Groups:   Month [1]
##   Date          ws Month  Week Weekdayf Weekday MonthWeek  Days
##                       
## 1 2000-01-01  2.38 Jan       0        6 Sat             1     1
## 2 2000-01-02  4.40 Jan       1        0 Sun             2     2
## 3 2000-01-03  6.25 Jan       1        1 Mon             2     3
## 4 2000-01-04  4.43 Jan       1        2 Tue             2     4
## 5 2000-01-05  6.92 Jan       1        3 Wed             2     5
## 6 2000-01-06  6.56 Jan       1        4 Thu             2     6

以上是处理后数据，为了最大程度还原日历，数据处理时将周的顺序设置为从周日开始，接下来正式画图：

ws_20 %>% ggplot(aes(x=Weekday,y=MonthWeek,fill=ws))+
  geom_tile(color = "white") + 
  geom_text(aes(label = Days), size = 3) + 
  scale_fill_gradientn(colours = rev(brewer.pal(11, "Spectral"))) + 
  facet_wrap(~Month,ncol = 4,scales = "free_x")+
  scale_y_reverse() + 
  labs(x="Day",y=NULL,title = "London WindSpeed Calendar 2000")+
  theme(plot.title = element_text(hjust = 0.5),
        axis.text.y = element_blank(),
        axis.ticks.y = element_blank(),
        strip.text = element_text(size = 11, face = "plain", color = "black"),
        panel.grid = element_blank())

相比之下，openair里的函数更简便，而ggplot更灵活

本文灵感来源为《R语言：数据可视化之美》一书，再结合github上多方搜索后整理结果。

《R语言：数据可视化之美》书中还有很多专业图形，如华夫图，径向图等，初见如获至宝。

本文在知乎账号“重明论”同步更新