第七章时间序列可视化

Author

221527125沈灿标

1 案例数据

1.1 data7_1：2000-2021年国内生产总值和指数

GDP、第一产业、第二产业、第三产业，国内生产总值，
GDP指数（%），大于100为增长。

datatable(data7_1,rownames = FALSE)

1.2 data7_2：2020-2023年某地区空气质量评价数据

读入数据时需要将日期转化为日期型变量，质量等级转化为因子型变量
AQI为空气质量总指数，由PM2.5~臭氧浓度综合计算，各空气质量数值越大质量越差

datatable(data7_2,rownames = FALSE)

1.3 data7_3：2024年上证指数交易数据

该数据中data为为日期变量，但该日期变量不规则（不连续），周末和公众假期没有交易数据
利用数据作K线图

datatable(data7_3,rownames = FALSE)

2 折线图和面积图

2.1 折线图

ggplot+geom_line+geom_point
如果需要对多个变量同时作折线图，需要将多个变量通过gather函数转化为长型数据。
p1 %+% df2 将p1的df1数据集替换为df2 ，要注意两个数据集必须有相同的变量名。

# 选择绘图变量并融合为长格式
df1<-data7_1 |> select(年份,GDP,第三产业) |> 
  gather(GDP,第三产业,key="指标",value="指标值")  
df2<-data7_1 |> select(年份,第一产业:第三产业) |> 
  gather(2:4,key="指标",value="指标值") |> 
  mutate(指标=fct_inorder(指标))

# 设置绘图主题
mytheme<-theme(legend.position=c(0.2,0.8),              # 将图例放在图内
         legend.background=element_blank())             # 移除图例整体边框

p1<-ggplot(df1,aes(x=年份,y=指标值,color=指标))+ # 设置x轴、y轴和线的颜色
  geom_line(size=0.8)+
  geom_point(aes(shape=指标),size=2)+     # 数值点的形状和大小
  mytheme+ggtitle("(a) GDP与第三产业的折线图")

p2<-p1 %+% df2+ggtitle("(b) 三次产业的折线图")

gridExtra::grid.arrange(p1,p2,ncol=2)

如果指标很多，转化为长型数据后采用分面处理，facet_wrap(~指标,scale="free")
如果横轴为日期型变量，将自动选择合适刻度显示

df<-data7_2 |> select(日期,PM2.5:臭氧浓度) |> 
  filter(year(日期)==2023) |> 
  gather(PM2.5:臭氧浓度,key=指标,value=指标值)

# 绘制折线图
p <- ggplot(df,aes(x=日期,y=指标值,color=指标))+    # 设置x轴、y轴和线的颜色
  geom_line(size=0.45)+                        # 绘制折线图
  theme(legend.position="none",         # 删除图例
       axis.text.x=element_text(size=7,angle=90,hjust=1,vjust=1))+# 设置x轴标签角度
  theme(panel.grid.minor.x=element_blank(),  # 去掉x轴次网格线
        panel.grid.minor.y=element_blank())+ # 去掉y轴次网格线
  scale_x_date(expand=c(0,0),date_breaks="1 month",date_labels="%b")+# 设置x轴间隔为1个月
  facet_wrap(~指标,ncol=3,scale="free")   # 按指标分面,并单独设置各分面图的y轴刻度
p

通过ggpol::geom_tshighlight 对某段时间高亮显示，通过xmin和xmax两个映射参数指定。
日期型数据需要通过as.Date 函数将字符转为为日期。

library(ggpol)

p+geom_tshighlight(aes(xmin=as.Date("01/07/2023",format="%d/%m/%Y"), 
   xmax=as.Date("30/09/2023",format="%d/%m/%Y")),                 # 设置x轴的最小值和最大值
   color="skyblue",fill="lightblue",alpha=0.02)

2.2 面积图

ggplot+geom_area ，数据准备与折线图一致，只是将折线图和横轴的部分填充颜色
facet_wrap(~指标,scale="free") ，如果时间序列较长可以选择分面处理

df<-data7_2 |> select(日期,PM2.5:臭氧浓度) |> 
  filter(year(日期)==2023) |> 
  gather(PM2.5:臭氧浓度,key=指标,value=指标值) |> 
  mutate(指标=fct_inorder(指标))

ggplot(df,aes(x=日期,y=指标值,fill=指标))+
   geom_area()+                                # 绘制面积图
   scale_x_date(expand=c(0,0),date_breaks="3 month",date_labels="%b")+
   guides(fill="none")+
   facet_wrap(~指标,ncol=3,scale="free")

如果时间序列较短可以选择堆叠处理
ggplot+geom_area+geom_line(position="stack") ，绝对值堆叠
ggplot+geom_area+geom_line(position="fill") ，百分比堆叠
scale_fill_brewer 设置填充颜色采用的调色板
注意这个图不同指标的意义和量纲不一致，堆叠没有实际意义。

# 选择一月份数据
df <- df |> filter(日期>="2023/1/1" & 日期<="2023/1/31")

# 图（a）堆叠面积图
p1<-ggplot(df,aes(x=日期,y=指标值,fill=指标))+    # 按指标分组
  geom_area()+            # 绘制面积图
  geom_line(position="stack",color="grey")+       # 绘制线图
  scale_fill_brewer(palette="Blues")+             # 设置配色方案（蓝色）
  theme_bw()+theme(legend.position="bottom")+
  ggtitle("(a) 堆叠面积图")

# 图（b）百分比堆叠面积图
p2<-ggplot(df,aes(x=日期,y=指标值,fill=指标))+
  geom_area(position="fill",color="grey")+        # 绘制百分百堆叠面积图
  scale_fill_brewer(palette="Reds")+
  scale_y_continuous(labels=scales::percent)+     # 显示百分百标签
  theme_bw()+theme(legend.position="bottom")+
  ylab("百分比")+ggtitle("(b) 百分比堆叠面积图")

gridExtra::grid.arrange(p1,p2,ncol=2)

3 风筝图和流线图

3.1 风筝图

风筝图就是面积图依横轴对称复制形成，比较有利观察时间序列的波动规律。
plotrix::kiteChart ，输入必须为均值，将日期变量转发为字符作为行名。
normalize=TRUE ，对数据作归一化处理

library(plotrix)

mat<-as.matrix(data7_2[,c(4:9)]);
rownames(mat)=format(data7_2$日期, format = "%Y/%m/%d") 
                                                  # 将数据框转化成矩阵
# 图7-7（a）原始数据
par(mfrow=c(1,2),cex=0.7,font.main=1)
kiteChart(t(mat),
   varscale=FALSE,     # 不显示每个"风筝线"的最大值
   xlab="时间",ylab="指标",main="(a) 原始数据",
   mar=c(4,4,2,1))    # 设置边距

# 图7-7（b）归一化数据
kiteChart(t(mat),
  timex=TRUE,        # 时间放在水平的x轴
  normalize=TRUE,    # 将每行值缩放为最大宽度为1
  shownorm=FALSE,    # 不显示归一化乘数
  xlab="时间",ylab="指标",main="(b) 归一化数据",
  mar=c(4,4,2,1))    # 设置边距

3.2 流线图

外形为堆叠面积图依横轴对称所得，各类在其中堆叠显示，形成流水形状
ggplot(aes(group=指标,fill=指标))+geom_stream
需要将多个指标数据转化为长型数据

library(ggstream)

# 处理数据
df1 <-data7_2 |> select(日期,PM2.5:臭氧浓度) |> 
  filter(日期>="2023/1/1" & 日期<="2023/3/31") |> 
  gather(PM2.5:臭氧浓度,key=指标,value=指标值) |> 
  mutate(指标=fct_inorder(指标))

df2 <-data7_2 |> select(日期,PM2.5:臭氧浓度) |> 
  filter(日期>="2023/1/1" & 日期<="2023/12/31") |> 
  gather(PM2.5:臭氧浓度,key=指标,value=指标值) |> 
  mutate(指标=fct_inorder(指标))

# 绘制流线图
p1<-ggplot(df1,aes(x=日期,y=指标值,group=指标,fill=指标))+
    geom_stream(bw = 0.3) +  # 绘制流线图，设置带宽=0.2
    theme(legend.position="bottom")+
    guides(fill=guide_legend(nrow=2,title=NULL))+# 图例排成2行,去掉图例标题
    ylab("")+ggtitle("(a) 1~3月份数据的流线图")   # 去掉y轴标签

p2<-ggplot(df2,aes(x=日期,y=指标值,group=指标,fill=指标))+
    geom_stream(bw = 0.3) +
    theme(legend.position="bottom")+
    scale_x_date(expand=c(0,1),date_breaks="1 month",date_labels="%b")+
    guides(fill=guide_legend(nrow=2,title=NULL))+# 图例排成2行,去掉图例标题
    ylab("")+ggtitle("(b) 全年数据的流线图")

gridExtra::grid.arrange(p1,p2,ncol=2)

4 地平线图

用于观测多个长时间序列的波动情况
latticeExtra::horizonplot ，需要输入ts类的时间序列对象
origin为自定义原点

library(latticeExtra)

dt<-data7_2 |> filter(日期>="2023/1/1" & 日期<="2023/12/31") |> 
  select(-c(日期,质量等级)) |> ts()  # 选择绘图数据并生成时间序列对象
horizonplot(dt,main="latticeExtra 包绘制的地平线图",
  layout=c(1,7),                              # 1列7行的页面布局
  origin=median,
  colorkey=TRUE,                              # 显示色键
  par.settings=list(par.main.text=list(cex=1,font=1)))# 设置主标题字体大小

ggHoriPlot::geom_horizon

library(ggHoriPlot)
library(ggthemes)            # 为了使用theme_few主题

# 处理数据
df1 <-data7_2 |> select(日期,PM2.5:臭氧浓度) |> 
  filter(日期>="2023/1/1" & 日期<="2023/3/31") |> 
  gather(PM2.5:臭氧浓度,key=指标,value=指标值) |> 
  mutate(指标=fct_inorder(指标))

df2 <-data7_2 |> select(日期,PM2.5:臭氧浓度) |> 
  filter(日期>="2023/1/1" & 日期<="2023/12/31") |> 
  gather(PM2.5:臭氧浓度,key=指标,value=指标值) |> 
  mutate(指标=fct_inorder(指标))

# 图（a） 1~3月份数据的地平线图
p1<-ggplot(df1)+aes(x=日期,y=指标值,fill=指标)+
  geom_horizon(origin='median',horizonscale=10,show.legend=FALSE) + # 绘制地平线图,原点为最小值，地平线图的切割点为10，不显示图例
  scale_x_date(expand=c(0,1),date_breaks="1 month",date_labels="%b")+# 设置x轴间隔为1个月（向后扩展1期）
  facet_grid(指标~.)+                          # 按指标分面
  scale_fill_hcl(palette='RdYlBu',reverse=F)+  # 设置调色板（颜色不反转）
  mytheme+ggtitle("(a) 1~3月份数据的地平线图")

# 图（b） 全年数据的地平线图
p2<-ggplot(df2)+aes(x=日期,y=指标值,fill=指标)+
  geom_horizon(origin='median',horizonscale=10,show.legend=FALSE)+
  scale_x_date(expand=c(0,0),date_breaks="1 month",date_labels="%b")+# 设置x轴间隔为1个月
  facet_grid(指标~.)+
  scale_fill_hcl(palette='RdYlBu',reverse=F)+
  mytheme+ggtitle("(b) 全年数据的地平线图")

gridExtra::grid.arrange(p1,p2,ncol=1)          # 组合图形

5 双坐标图

plotrix::twoord.plot(lx,ly=,rx=,ry=) ，一般要求lx和rx为相同变量
type=c(A,B) 设定不同作图效果

library(plotrix)

par(mfrow=c(1,2),lab=c(10,2,1),cex.main=0.8,font.main=1)
twoord.plot(data=data7_1,type="b",               # 设置绘图类型
  lcol="black",rcol="red2",rpch=22, # 设置左侧和右侧图的颜色和点的类型
  lx="年份",ly="GDP",rx="年份",ry="GDP指数",
                                                 # 设置左侧和右侧坐标轴
  lytickpos=seq(100000,1000000,by=200000),       # 设置左侧坐标轴标签刻度
  rytickpos=seq(100,120,by=2),                   # 设置右侧坐标轴标签刻度
  xlab="年份",ylab="国内生产总值(亿元)",rylab="国内生产总值指数(上年=100)",# 设置左侧和右侧坐标轴标签
  rylab.at=108,                                  # 设置右侧标签位置   
  axislab.cex=0.7,                               # 设置坐标轴标签字体大小
  main="(a) 双折线图",                           # 设置主标题
  mar=c(4,4,2,4))                                # 设置图形边界

# （b）条形图和折线图
twoord.plot(data=data7_1,type=c("bar","b"),      # 设置绘图类型
  lcol="orange2",rcol="black",rpch=1,
  lx="年份",ly="GDP",rx="年份",ry="GDP指数",
  lytickpos=seq(100000,1000000,by=200000),rytickpos=seq(100,120,by=2),
  xlab="年份",ylab="国内生产总值(亿元)",rylab="国内生产总值指数(上年=100)",
  rylab.at=108,axislab.cex=0.7,main="(b) 条形图和折线图",
  mar=c(4,4,2,4))

6 日历图

openair::calendarPlot ，输入数据框中需要有date为名的日期变量。

library(openair)

# 处理数据
df <- data7_2 |> select(日期,AQI) |> 
  mutate(year=year(日期),date=日期) |>  filter(year=="2023")     # 筛选出2023年的数据

# 绘制日历图
Sys.setlocale(locale="C")      # 修改计算机系统以合理显示x轴标签

[1] "C"

calendarPlot(df,pollutant="AQI",cols="heat",year=2023,month=c(1:12))

Sys.setlocale()

[1] "LC_COLLATE=Chinese (Simplified)_China.utf8;LC_CTYPE=Chinese (Simplified)_China.utf8;LC_MONETARY=Chinese (Simplified)_China.utf8;LC_NUMERIC=C;LC_TIME=Chinese (Simplified)_China.utf8"

通过month参数选择月份；

calendarPlot(selectByDate(df,month=c(1,2,3),year=2023),# 选择月份
   pollutant="AQI",
   key.position="bottom",                                # 设置图例位置
   breaks=c(0,50,100,150,200,300),                       # 设置分组向量
   labels=c("优","良","轻度污染","中度污染","重度污染"), # 设置标签向量
   cols=c("green","yellow","orange","red","purple"))     # 设置颜色向量

ggTimeSeries::ggplot_calendar_heatmap

library(ggTimeSeries)

df<- data7_2 |> rename(date=日期) |> 
  select(date,AQI) |> 
  mutate(year=year(date))

# 绘制日历图
ggplot_calendar_heatmap(dtDateValue=df,
  cDateColumnName="date",                         # 设置日期的列名
  cValueColumnName="AQI",                         # 设置数据的列名
  vcGroupingColumnNames="year",                   # 设置分组的列名
  dayBorderSize=0.2,dayBorderColour="grey60",  # 设置每天的边界线大小和颜色
  monthBorderSize=0.5,monthBorderColour="white")+ # 设置月份间的边界线大小和颜色
  scale_fill_gradientn(colors=rev(brewer.pal(11,"Spectral")))+# 设置调色板
  facet_wrap(~year,ncol=1)                                    # 按年份分面

7 随机成分平滑曲线

forecast::ma(order,centre) ，centre=FALSE 则向前求移动平均，不能计算的日期数值用NA代替。

library(forecast)     # 为了使用ma(移动平均)函数

# 处理数据
d1 <- data7_2 |> filter(year(日期)==2023) |> select(日期,AQI)
ma7<-ma(d1$AQI,order=7,centre=TRUE)              # 计算7日移动平均
ma30<-ma(d1$AQI,order=30,centre=TRUE)            # 计算30日移动平均
df<-data.frame(d1,ma7,ma30) |> 
  gather(AQI:ma30,key=指标,value=指标值) |> 
  mutate(指标=fct_inorder(指标))


# 绘制折线图
size<-ifelse(df$指标=="AQI",0.2,0.8)               # 设置线宽度
ggplot(df,aes(x=日期,y=指标值,color=指标))+
  geom_line(size=size)+                          # 绘制折线图
  scale_x_date(expand=c(0,0),date_breaks="1 month",date_labels="%b")

# 处理数据
d1 <- data7_2 |> filter(year(日期)==2023) |> select(日期,PM2.5:臭氧浓度)
ma <- d1[,-1] |> ma(order=30,centre=TRUE)   
colnames(ma)<-c('maPM2.5','maPM10','ma二氧化硫','ma一氧化碳','ma二氧化氮','ma臭氧浓度')      # 重新命名列名称
df1<-d1 |> gather(2:7,key="指标",value="指标值")
df2<-ma |> as.data.frame() |> gather(1:6,key="ma指标",value="ma指标值")
df<-cbind(df1,df2) 

ggplot(df,aes(x=日期,y=指标值,color=指标))+geom_line(size=0.2)+# 绘制折线图
  geom_line(aes(y=ma指标值,color=ma指标),size=0.8)+# 绘制折线图
  scale_x_date(expand=c(0,0),date_breaks="2 month",date_labels="%b")+
  guides(color="none")+
  facet_wrap(~指标,ncol=3,scale="free")     # 按指标分面，单独设置各分面图的y轴刻度

8 时间序列动态交互图

dygraphs::dygraph ，输入对象必须为xts 函数生成的时间序列对象。

library(dygraphs)
library(xts)

d1 <- data7_2 |> filter(year(日期)==2023)
dts<-xts(x=d1[,-c(1,3)],order.by=d1$日期)           # 生成时间序列对象
dygraph(data=dts$AQI,xlab="时间",ylab="AQI",main="AQI的动态交互图")

dyRoller(rollPeriod=30)

dygraph(data=dts[,c(1,2,3)],xlab="时间",ylab="移动平均值",main="移动平均动态交互图")%>%
dyRoller(dygraph,rollPeriod=30)                      # 30日移动平均

plotly::plotly

library(plotly)

df <- data7_2 |> filter(日期>="2023/1/1"&日期<="2023/3/31") |> select(1:3)
# 绘制图形
p<-plot_ly(data=df,x=~日期,y=~AQI,type="bar")   # 绘制条形图
add_markers(p,symbol=~质量等级)                 # 按因子设置符号

9 不规则时间序列图

9.1 数据准备

通过zoo::rollmean 时间收盘价的5天、10天和20天的移动平均
将日期变量转化为id变量

library(zoo)

df <- data7_3  |>  select(date:volume) |> 
  mutate(ma5 = rollmean(close, k = 5, fill = NA, align = "right"),
         ma10 = rollmean(close, k = 10, fill = NA, align = "right"),
         ma20 = rollmean(close, k = 20, fill = NA, align = "right"),
         date_index = seq_along(date)
         )
datatable(df)

9.2 K线图

线段图geom_segment+矩形图geom_rect+折线图geom_line
scale_x_continuous 将横轴坐标刻度转化回日期型

p1 <- df |> ggplot(aes(x = date_index)) +
  geom_segment(aes(x = date_index, xend = date_index, y = low, yend = high)) +
  geom_rect(aes(xmin = date_index - 0.4, xmax = date_index + 0.4,
                ymin = pmin(open, close), ymax = pmax(open, close),
                fill = close > open)) +
  geom_line(aes(y = ma5, color = "MA5"), size = 0.8) +
  geom_line(aes(y = ma10, color = "MA10"), size = 0.8) +
  geom_line(aes(y = ma20, color = "MA20"), size = 0.8) +
  scale_fill_manual(values = c("TRUE" = "red", "FALSE" = "green")) +
  scale_color_manual(values = c("MA5" = "blue", "MA10" = "orange", "MA20" = "purple")) +
  scale_x_continuous(breaks = seq(1, nrow(df), by = 20), 
                     labels = format(df$date[seq(1, nrow(df), by = 20)], "%Y-%m-%d"),
                      expand = c(0, 0)) +
  theme_minimal() + guides(fill="none")+
  theme(legend.position = "top",
        axis.title.x = element_blank(),
        axis.text.x = element_blank(),
        plot.margin = margin(b = 0)) +
  labs(x = "", y = "", title = "上证指数K线图", color = "移动平均线")
p1

9.3 交易量图

交易量通过条图geom_bar 显示，width = 1 使直条间没有间隙

p2 <- df |> ggplot(aes(x = date_index, y = volume)) +
  geom_bar(stat = "identity", aes(fill = close > open),width = 1) +
  scale_fill_manual(values = c("TRUE" = "red", "FALSE" = "green")) +
  scale_x_continuous(breaks = seq(1, nrow(df), by = 20), 
                     labels = format(df$date[seq(1, nrow(df), by = 20)], "%Y-%m-%d"),
                     expand = c(0, 0)) +
  theme_minimal() +
  theme(legend.position = "none",
        plot.margin = margin(t = 0)) +
  labs(x = "", y = "", title = "")
p2

9.4 整合K线图和交易量图

gridExtra::grid.arrange(p1,p2,ncol=1,
                        heights = c(2, 1))