R语言数据可视化之美 · 第6章

精读版:概念讲解 + 图 + 代码,看这一页就够了

6.1 折线图与面积图系列

一句话:时间序列最常用的两种:折线图和面积图。

6.1.1 折线图

一句话:折线图:连续间隔/时间跨度上的数值变化,看趋势首选。

折线图(linechart)用于在连续间隔或时间跨度上显示定量数值,最常用来显示趋势和关系(与其他折线组合起来)。此外,折线图也能给出某时间段内的整体概览,看看数据在这段时间内的发展情况。要绘制折线图,可以先在笛卡儿坐标上定出数据点,然后用直线把这些点连接起来。

在折线图中,X轴包括类别型或者序数型变量,分别对应文本坐标轴和序数坐标(如日期坐标轴)两种类型;Y轴为数值型变量。折线图主要应用于时间序列数据的可视化。

#EasyCharts团队出品,
#如有问题修正与深入学习,可联系微信:EasyCharts

library(ggplot2)
library(RColorBrewer)
library(reshape2)


#-------------------------图6-1-1 多数据系列图. (a)折线图-------------------------
mydata<-read.csv("Line_Data.csv",stringsAsFactors=FALSE) 
mydata$date<-as.Date(mydata$date)

mydata<-melt(mydata,id="date")
ggplot(mydata, aes(x =date, y = value,color=variable) )+
  #geom_area(fill="#FF6B5E",alpha=0.75)+ 
  geom_line(size=1)+
  scale_x_date(date_labels = "%Y",date_breaks = "2 year")+
  xlab("Year")+ 
  ylab("Value")+
  theme( axis.title=element_text(size=10,face="plain",color="black"),
         axis.text = element_text(size=10,face="plain",color="black"),
         legend.position = c(0.15,0.8),
         legend.background = element_blank()) 

#-------------------------图6-1-1 多数据系列图.(b)面积图.-------------------------
ggplot(mydata, aes(x =date, y = value,group=variable) )+
  geom_area(aes(fill=variable),alpha=0.5,position="identity")+ 
  geom_line(aes(color=variable),size=0.75)+#color="black",
  scale_x_date(date_labels = "%Y",date_breaks = "2 year")+
  xlab("Year")+ 
  ylab("Value")+
  theme( axis.title=element_text(size=10,face="plain",color="black"),
         axis.text = element_text(size=10,face="plain",color="black"),
         legend.position = c(0.15,0.8),
         legend.background = element_blank()) 


#--------------------------------------图6-1-2 填充面积折线图. (a)纯色填充-------------------
mydata<-read.csv("Area_Data.csv",stringsAsFactors=FALSE) 
mydata$date<-as.Date(mydata$date)
ggplot(mydata, aes(x =date, y = value) )+
  geom_area(fill="#FF6B5E",alpha=0.75)+ 
  geom_line(color="black",size=0.75)+
  scale_x_date(date_labels = "%Y",date_breaks = "2 year")+
  xlab("Year")+ 
  ylab("Value")+
  theme( axis.title=element_text(size=10,face="plain",color="black"),
         axis.text = element_text(size=10,face="plain",color="black")) 


#------------------------图6-1-2 填充面积折线图.(b)颜色映射填充.------------------------

x<-as.numeric(mydata$date)
newdata<-data.frame(spline(x,mydata$value,n=1000,method= "natural"))
newdata$date<-as.Date(newdata$x,origin = "1970-01-01")
ggplot(newdata, aes(x =date, y = y) )+ #geom_area(fill="#FF6B5E",alpha=0.75)
  geom_bar(aes(fill=y,colour=y),stat = "identity",alpha=1,width = 1)+ 
  geom_line(color="black",size=0.5)+
  scale_color_gradientn(colours=brewer.pal(9,'Reds'),name = "Value")+
  scale_x_date(date_labels = "%Y",date_breaks = "2 year")+
  xlab("Year")+ 
  ylab("Value")+
  guides(fill=FALSE)+
  theme( axis.title=element_text(size=10,face="plain",color="black"),
         axis.text = element_text(size=10,face="plain",color="black"),
         legend.position = c(0.12,0.75),
         legend.background = element_blank() )

#------------------------图6-1-3 夹层填充面积图. (a)单色------------------------------

mydata<-read.csv("Line_Data.csv",stringsAsFactors=FALSE) 
mydata$date<-as.Date(mydata$date)

mydata1<-mydata

mydata1$ymin<-apply(mydata1[,c(2,3)], 1, min)
mydata1$ymax<-apply(mydata1[,c(2,3)], 1, max)

ggplot(mydata1, aes(x =date))+
  geom_ribbon( aes(ymin=ymin, ymax=ymax),alpha=0.5,fill="white",color=NA)+
  #geom_area(aes(fill=variable),alpha=0.5,position="identity")+ 
  geom_line(aes(y=AMZN,color="#FF6B5E"),size=0.75)+#color="black",
  geom_line(aes(y=AAPL,color="#00B2F6"),size=0.75)+#color="black",
   scale_x_date(date_labels = "%Y",date_breaks = "2 year")+
   xlab("Year")+ 
   ylab("Value")+
   scale_colour_manual(name = "Variable", 
                       labels = c("AMZN", "AAPL"),
                       values = c("#FF6B5E", "#00B2F6"))+
   theme( axis.title=element_text(size=10,face="plain",color="black"),
         axis.text = element_text(size=10,face="plain",color="black"),
         legend.position = c(0.15,0.8),
         legend.background = element_blank()) 

#------------------------图6-1-3 夹层填充面积图.  (b)多色------------------------------
mydata1$ymin<-apply(mydata1[,c(2,3)], 1, min)
mydata1$ymax<-apply(mydata1[,c(2,3)], 1, max)

mydata1$ymin1<-mydata1$ymin
mydata1$ymin1[as.integer((mydata1$AAPL-mydata1$AMZN)>0)]=NA

mydata1$ymax1<-mydata1$ymax
mydata1$ymax1[as.integer((mydata1$AAPL-mydata1$AMZN)>0)==0]=NA

mydata1$ymin2<-mydata1$ymin
mydata1$ymin2[as.integer((mydata1$AAPL-mydata1$AMZN)<=0)==0]=NA

mydata1$ymax2<-mydata1$ymax
mydata1$ymax2[as.integer((mydata1$AAPL-mydata1$AMZN)<=0)==0]=NA


ggplot(mydata1, aes(x =date))+
  geom_ribbon( aes(ymin=ymin1, ymax=ymax1),alpha=0.5,fill="#FF6B5E",color=NA)+#,fill = AMZN > AAPL
  geom_ribbon( aes(ymin=ymin2, ymax=ymax2),alpha=0.5,fill="#00B2F6",color=NA)+#,fill = AMZN > AAPL
  #geom_area(aes(fill=variable),alpha=0.5,position="identity")+ 
  geom_line(aes(y=AMZN,color="#FF6B5E"),size=0.75)+#color="black",
  geom_line(aes(y=AAPL,color="#00B2F6"),size=0.75)+#color="black",
  scale_x_date(date_labels = "%Y",date_breaks = "2 year")+
  xlab("Year")+ 
  ylab("Value")+
  scale_colour_manual(name = "Variable", 
                      labels = c("AMZN", "AAPL"),
                      values = c("#FF6B5E", "#00B2F6"))+
  theme( axis.title=element_text(size=10,face="plain",color="black"),
         axis.text = element_text(size=10,face="plain",color="black"),
         legend.position = c(0.15,0.8),
         legend.background = element_blank()) 

#--------------------------------图6-1-3 夹层填充面积图.(c)颜色映射填充.------------------------------------------
library(ggridges)
ggplot(mydata1, aes(x=date)) +
  geom_ridgeline_gradient( aes(y=ymin, height = ymax-ymin,  fill = ymax-ymin)) +
  geom_line(aes(y=AMZN),color="black",size=0.75)+#color="black",
  geom_line(aes(y=AAPL),color="black",size=0.75)+#color="black",
  scale_fill_gradientn(colours= brewer.pal(9,'RdBu'),name = "Value")+
  theme(legend.position = c(0.15,0.8),
        legend.background = element_blank()) 

为多数据系列折线图,X轴变量为时序数据。在散点图系列中,曲线图(带直线而没有数据标记的散点图)与折线图的图像显示效果类似。在曲线图中,X轴也表示时间变量,但是必须为数值格式,这是两者之间最大的区别。

所以,如果X轴变量是数值格式,应该使用曲线图来显示数据,而不是折线图。在折线图系列中,标准的折线图和带数据标记的折线图可以用于很好地可视化数据。因为图表的三维透视效果很容易让读者误解数据,所以不推荐使用三维折线图。

另外,堆积折线图和百分比堆积折线图等推荐使用相应的面积图,例如,堆积折线图的数据可以使用堆积面积图绘制,展示的效果将会更加清晰和美观。

6.1.2 面积图

一句话:面积图:折线+区域填充,强调累积量,更美观。

面积图(areagraph)又叫区域图,是在折线图的基础之上形成的,它将折线图中的折线与自变量坐标轴之间的区域使用颜色或者纹理填充(填充区域称为“面积”),这样可以更好地突出趋势信息,同时让图表更加美观。跟折线图一样,面积图可显示某时间段内量化数值的变化和发展,最常用来显示趋势,而非表示具体数值,

所示为单数据系列面积图。多数据系列的面积图如果使用得当,那么效果可以比多数据系列的折线图美观很多。需要注意的是,颜色要带有一定的透明度,透明度可以很好地帮助使用者观察不同数据系列之间的重叠关系,避免数据系列之间的遮挡(见

(b))。但是,数据系列最好不要超过3个,不然图表看起来会比较混乱,反而不利于数据信息的准确和美观表达。当数据系列较多时,建议使用折线图、分面面积图或者峰峦图展示数据。

颜色映射填充的面积图:如

所示,填充面积不是如

所示的纯色填充,而是将折线部分的数据点(x,y)根据y值颜色映射到颜色渐变主题,这样可以更好地促进数据信息的表达,但是这种图表只适用于单数据系列面积图。多数据系列面积图由于存在互相遮挡的情况,所以会导致数据表达过于余,反而影响数据的清晰表达。两条折线间填充面积图:两条折线之间可以使用面积填充,这样可以很清晰地观察数据之间的差异变化,这种图表只适用于双数据系列的数值差异比较展示,如

所示为三种不同类型的两条折线间填充面积图。

就是直接使用单色填充两条折线之间的面积:

是分段填充,当变量“AMZN”大于变量“AAPL”时,使用蓝色填充,反之则使用红色填充:

是使用颜色映射填充的面积图,将

的颜色映射方法映射到面积填充,这样可以更加清晰地对比每个时间点的差异。这个可以借助ggridges包的geom_ridgeline_gradient()函数实现。技能折线图和面积图系列R中ggplot2包的geom_line()函数可以绘制折线图,如

所示;geom_area()函数可以绘制面积图,如

所示:使用geom_bar()函数结合geom_line()函数可以绘制颜色映射填充的面积图,如

所示。其核心代码如下所示

在TheCommercialandPoliticalAtlas(Playfair,1786)[45]一书中,他用折线图展示了英格兰从1700年至1780年间的进出口数据,从图中可以很清楚地看出对英格兰有利和不利(即顺差、逆差)的年份,左边表明了对外贸易对英格兰不利,而随着时间发展,大约1752年后,对外贸易逐渐变得有利(见

)。另外,他还在TheStatisticalBreviary(Playfair,1801)[46]一书中,第一次使用了饼图来展示一些欧洲国家的领土比例。事实上,除了这两种图形之外,他还发明了条形图和圆环图。

1WilliamPlayfair的维基百科:http://en.wikipedia.org/wiki/William_Playfair堆积面积图(stackedareagraph)的原理与多数据系列面积图相同,但它能同时显示多个数据系列,每一个系列的开始点是先前数据系列的结束点,如

#EasyCharts团队出品,
#如有问题修正与深入学习,可联系微信:EasyCharts

library(ggplot2)
library(RColorBrewer)
library(reshape2)


mydata<-read.csv("StackedArea_Data.csv",stringsAsFactors=FALSE) 
mydata$Date<-as.Date(mydata$Date)

#----------------------------图6-1-4堆积面积图.(a) 堆积面积图--------------------------------
mydata<-melt(mydata,id="Date")
ggplot(mydata, aes(x =Date, y = value,fill=variable) )+
  geom_area(position="stack",alpha=1)+ 
  geom_line(position="stack",size=0.25,color="black")+
  scale_x_date(date_labels = "%Y",date_breaks = "2 year")+
  xlab("Year")+ 
  ylab("Value")+
  theme( axis.title=element_text(size=10,face="plain",color="black"),
         axis.text = element_text(size=10,face="plain",color="black"),
         legend.position = "right",
         legend.background = element_blank()) 

#-----------------------------图6-1-4堆积面积图.  (b)百分比堆积面积图.----------------------------------
ggplot(mydata, aes(x =Date, y = value,fill=variable) )+
  geom_area(position="fill",alpha=1)+ 
  geom_line(position="fill",size=0.25,color="black")+
  scale_x_date(date_labels = "%Y",date_breaks = "2 year")+
  xlab("Year")+ 
  ylab("Value")+
  theme( axis.title=element_text(size=10,face="plain",color="black"),
         axis.text = element_text(size=10,face="plain",color="black"),
         legend.position = "right",
         legend.background = element_blank()) 

所示。堆积面积图上的最大面积代表了所有数据量的总和,是一个整体。各个堆积起来的面积表示各个数据量的大小,这些堆积起来的面积图在表现大数据的总量分量的变化情况时格外有用,所以层叠面积图不适用于表示带有负值的数据集。

总的来说,它们适合用来比较同一间隔内多个变量的变化。在堆积面积图的基础之上,将各个面积的因变量的数据加和后的总量进行归一化就形成了百分比堆积面积图,如

所示。该图并不能反映总量的变化,但是可以清晰地反映每个数值所占百分比随时间或类别变化的趋势线,对于分析各个指标分量占比极为有用。1图片来源:http://en.wikipedia.org/wiki/William_Playfair堆积面积图侧重于表现不同时间段(数据区间)的多个分类累加值之间的趋势。

百分比堆积面积图表现不同时间段(数据区间)的多个分类占比的变化趋势。而堆积柱形图和堆积面积图的差别在于,堆积面积图的X轴上只能表示连续数据(时间或者数值),堆积柱形图的X轴上只能表示分类数据。技能堆积面积图R中ggplot2包的geom_area()函数可以绘制面积图系列,其中position=stack”,表示多数据系列的堆叠,可以绘制如

所示的堆积面积图;position="full",表示多数据系列以百分比的形式堆叠,可以绘制如

所示的百分比堆积面积图。

所示图表的实现代码如下所示

6.2 日历图

一句话:日历图:日历当画布,看长期数据在周/月/年维度的规律。

我们平常的日历也可以当作可视化工具,适用于显示不同时间段,以及活动事件的组织情况。时间段通常以不同单位显示,例如日、周、月和年。今天我们最常用的日历形式是公历,每个月份的月历由7个垂直列组成(代表每周7天),如

所示。每周7天月份单一日期日历图的主要可视化形式有如

#EasyCharts团队出品,如有商用必究,
#如需使用与深入学习,请联系微信:EasyCharts

library(ggplot2)
library(data.table) #提供data.table()函数
library(ggTimeSeries)
library(RColorBrewer)
set.seed(1234)
dat <- data.table(
  date = seq(as.Date("1/01/2014", "%d/%m/%Y"),as.Date("31/12/2017", "%d/%m/%Y"),"days"),
  ValueCol = runif(1461)
)
dat[, ValueCol := ValueCol + (strftime(date,"%u") %in% c(6,7) * runif(1) * 0.75), .I]
dat[, ValueCol := ValueCol + (abs(as.numeric(strftime(date,"%m")) - 6.5)) * runif(1) * 0.75, .I]

dat$Year<- as.integer(strftime(dat$date, '%Y'))   #年份
dat$month <- as.integer(strftime(dat$date, '%m')) #月份
dat$week<- as.integer(strftime(dat$date, '%W'))   #周数

MonthLabels <- dat[,list(meanWkofYr = mean(week)), by = c('month') ]
MonthLabels$month <-month.abb[MonthLabels$month]

ggplot(data=dat,aes(date=date,fill=ValueCol))+
  stat_calendar_heatmap()+
  scale_fill_gradientn(colours= rev(brewer.pal(11,'Spectral')))+ 
  facet_wrap(~Year, ncol = 1,strip.position = "right")+
  scale_y_continuous(breaks=seq(7, 1, -1),labels=c("Mon","Tue","Wed","Thu","Fri","Sat","Sun"))+
  scale_x_continuous(breaks = MonthLabels[,meanWkofYr], labels = MonthLabels[, month],expand = c(0, 0)) +
  xlab(NULL)+ 
  ylab(NULL)+
  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"),
         axis.line=element_line(colour="black",size=0.25),
         axis.title=element_text(size=10,face="plain",color="black"),
         axis.text = element_text(size=10,face="plain",color="black"))

#---------------------------------------------------------
library(dplyr)
dat17 <- filter(dat,Year==2017)[,c(1,2)]

dat17$month <- as.integer(strftime(dat17$date, '%m'))  #月份
dat17$monthf<-factor(dat17$month,levels=as.character(1:12),
                     labels=c("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"),ordered=TRUE)
dat17$weekday<-as.integer(strftime(dat17$date, '%u'))#周数
dat17$weekdayf<-factor(dat17$weekday,levels=(1:7),
                       labels=(c("Mon","Tue","Wed","Thu","Fri","Sat","Sun")),ordered=TRUE)
dat17$yearmonth<- strftime(dat17$date, '%m%Y')   #月份
dat17$yearmonthf<-factor(dat17$yearmonth)
dat17$week<- as.integer(strftime(dat17$date, '%W'))#周数

dat17<-dat17 %>% group_by(monthf)%>%mutate(monthweek=1+week-min(week))

dat17$day<-strftime(dat17$date, "%d")

ggplot(dat17, aes(weekdayf, monthweek, fill=ValueCol)) + 
  geom_tile(colour = "white") + 
  scale_fill_gradientn(colours=rev(brewer.pal(11,'Spectral')))+
  geom_text(aes(label=day),size=3)+
  facet_wrap(~monthf ,nrow=3) +
  scale_y_reverse()+
  xlab("Day") + ylab("Week of the month") +
  theme(strip.text = element_text(size=11,face="plain",color="black"))

所示的两种:以年为单位的日历图(见

)和以月为单位的日历图(见

)。日历图的数据结构一般为(Date,Value),将Value按照Date(日期)在日历上展示,其中Value映射到颜色。Mon Tue Wed Thu Fri Sat SunMon Tue Wed Thu Fri Sat Sun Mon TueWed Thu Fri Sat Sun Mon Tue Wed Thu Fri Sat Sun技能日历图R中ggTimeSeries包的ggplot_calendar_heatmap()函数可以绘制如

所示的日历图,但是不能设定日历图每个时间单元的边框格式。使用stat_calendar_heatmap()函数和ggplot2包的ggplot()函数就可以调整日历图每个时间单元的边框格式,具体代码如下所示。其关键是使用as.integer(strftime())日期型处理组合函数获取某天对应所在的年份、月份、周数等数据信息。

#构造2014-01-01到2017-12-31的数据集date=seq(as.Date(“1/01/2014"“%d/%m/%Y").as.Date(31/12/2017",“%d/%m/%Y"),"days).dat[.ValueCol:=ValueCol +(strftime(date,%u")%in%c(6.7)*runif(1)*0.75).J]dat[.ValueCol :=ValueCol +(abs(as.numeric(strftime(date,%m"))-6.5))*runif(1)*0.75,]dat$Year<-as.integer(strftime(dat$date,%Y))#年份dat$month<-as.integer(strftime(dat$date,“%m))#月份dat$week<-as.integer(strftime(dat$date,“%W))#周数MonthLabels<-dat[.list(meanWkofYr= mean(week).by=c(month)]MonthLabels$month<-month.abb[MonthLabels$month]scale_fill_gradientn(colours=rev(brewer.pal(11,Spectral')+facet_wrap(~Year,ncol =1,strip.position=“right")+scale_y_continuous(breaks=seq(7.1,-1).labels=c(Mon""Tue”,"Wed","Thu","Fri"."Sat","Sun"))+panel.border=element_rect(colour="grey60".fill=NA).strip.background=element_blank()1ggTimeSeries包的参考网址:http://www.ggplot2-exts.org/ggTimeSeries.htmlstrip.text=element_text(size=13.face="plain",color="black").axis.line=element_line(colour="black"size=0.25),axis.title=element_text(size=10,face="plain",color=“black").axis.text=element_text(size=10.face="plain",color="black"))技能日历图使用R中ggplot2包的geom_tile()函数,借助facet_wrap()函数分面,就可以绘制如

所示的以月为单位的日历图,具体代码如下所示

6.3 螺旋图

一句话:螺旋图:沿阿基米德螺旋线展开时间序列,适合周期性强的数据。

螺旋图(spiralchart)也被称为时间系列螺旋图。这种图表沿阿基米德螺旋线(Archimedesspiral,见

)画上基于时间的数据[4748]。图表从螺旋形的中心点开始向外发展。螺旋图十分多变,可使用条形、线条或数据点,沿着螺旋路径显示螺旋图有两大好处。

(1)显示大型数据集:螺旋图能大幅度地节省空间,可用于显示大时间段数据的变化趋势:(2)绘制周期性数据:螺旋图每一圈的刻度差相同,当每一圈的刻度差是数据周期的倍数时,能够直观地表达数据的周期性。螺旋柱形图如

ch_图6-3-2_不同形式的螺旋图_(a1).png
图6-3-2
#EasyCharts团队出品,
#如需使用与深入学习,请联系微信:EasyCharts

library(dplyr)
library(ggplot2)
library(readxl)
library(RColorBrewer)

colormap <- colorRampPalette(brewer.pal(9,'YlGnBu'))(9)

dat <- read_excel("SpiralChart_Data.xlsx")

dat$time <-  with(dat, as.POSIXct(paste(Date, Time), tz="GMT"))  #把日期转换成POSIXct格式
dat$hour <-  as.numeric(dat$time) %% (24*60*60) / 3600 #时刻
dat$day <- as.Date(dat$time)   #把天数转换成日期型
dat$datt<-as.numeric(strftime(dat$day , "%d"))  #把天数转换成数值型
dat$datt<-dat$datt-min(dat$datt)


dat$Value <- as.numeric(dat$Value)
dat$Value2<-dat$Value/max(dat$Value)

N<-24
width<-0.5

#---------------------------------------图6-3-2 不同形式的螺旋图。(a) 螺旋柱形图--------------------------------

bars <- dat %>% 
  mutate(hour.group = cut(hour, breaks=seq(0,24,width), labels=seq(0,23.75,width),include.lowest=TRUE), 
         hour.group = as.numeric(as.character(hour.group))) %>%
  group_by(datt, hour.group) %>%
  summarise(meanTT = mean(Value2))  %>%
  mutate(value=meanTT*max(dat$Value),
         xmin=  hour.group,
         xmax = hour.group + width,
         ymin = datt*N + hour.group,
         ymax = datt*N + hour.group + meanTT*N*1.1)

poly <- bars %>%
  rowwise() %>%
  do(with(., data_frame(day=datt,
                        date=day,
                        hour=hour.group,
                        value=value,
                        x = c(xmin, xmax, xmax, xmin),
                        y = c(ymin ,
                              ymin + width,
                              ymax + width,
                              ymax ))))

ggplot(poly, aes(x, y, group = interaction(hour, day),fill=value)) +
  geom_polygon(colour="black",size=0.25) +
  scale_fill_gradientn(colours=colormap)+

  ylab("Date")+
  xlab("")+
  theme_bw()+
  coord_polar() +
  
  scale_y_continuous(limits=c(-N/2, max(poly$y)), 
                       breaks=seq(N,max(poly$y),N),
                       labels=unique(dat$day) )+
  scale_x_continuous(limits=c(0,N), breaks=seq(0,N-1,1), minor_breaks=0:N,
                     labels=paste0(rep(c(12,1:11),1), rep(c("AM","PM"),each=12))) +
  theme( panel.background = element_blank(),
         panel.border =  element_rect(fill=NA,colour = "grey80",size=.25),
         panel.grid.major.y  = element_line(colour = "grey80",size=.25),#,linetype ="dotted" ),
         panel.grid.major.x  = element_line(colour = "grey80",size=.25),#,linetype ="dotted" ),
         panel.grid.minor.y  = element_blank(),
         panel.grid.minor.x  = element_blank(),
         axis.line = element_line(colour = "grey80",size=.25),
         # panel.grid.minor = element_line(colour = "grey60",size=.25,linetype ="dotted" ),
         axis.text.y = element_text(size = 10,colour="grey50"),#,hjust=0,vjust=1),
         axis.line.y = element_line(size=0.25)
  )
 

#----------------------------------------图6-3-2 不同形式的螺旋图。(b) 螺旋热力图---------------------------------------------

bars <- dat %>% 
  mutate(hour.group = cut(hour, breaks=seq(0,24,width), labels=seq(0,23.75,width),include.lowest=TRUE), #
         hour.group = as.numeric(as.character(hour.group))) %>%
  group_by(datt, hour.group) %>%
  summarise(meanTT = mean(Value2))  %>%
  mutate(value=meanTT*max(dat$Value),
         xmin=  hour.group,
         xmax = hour.group + width,
         ymin = datt*N + hour.group,
         ymax = datt*N + hour.group + 24)

poly <- bars %>%
  rowwise() %>%
  do(with(., data_frame(day=datt,
                        date=day,
                        hour=hour.group,
                        value=value,
                        x = c(xmin, xmax, xmax, xmin),
                        y = c(ymin ,
                              ymin + width,
                              ymax + width,
                              ymax ))))


ggplot(poly, aes(x, y, group = interaction(hour, day),fill=value)) +
  geom_polygon(colour="black",size=0.25) +
  
  coord_polar() +
  # ylim(-20, max(poly$y)) +
  #viridis::scale_fill_viridis(discrete = TRUE, option = 'C')# +
  scale_x_continuous(limits=c(0,N), breaks=seq(0,N-1,1), minor_breaks=0:N,
                     labels=paste0(rep(c(12,1:11),1), rep(c("AM","PM"),each=12))) +
  scale_y_continuous(limits=c(-N/2, max(poly$y)), 
                     breaks=seq(N,max(poly$y),N),
                     labels=unique(dat$day) )+
  
  #scale_fill_gradient2(low="green", mid="yellow", high="red", midpoint=mean(bars$meanTT)) +
  scale_fill_gradientn(colours=colormap)+
  ylab("Date")+
  xlab(NA)+
  theme_bw()+
  theme( panel.background = element_blank(),
         panel.border =  element_rect(fill=NA,colour = "grey80",size=.25),
         panel.grid.major.y  = element_line(colour = "grey80",size=.25),#,linetype ="dotted" ),
         panel.grid.major.x  = element_line(colour = "grey80",size=.25),#,linetype ="dotted" ),
         panel.grid.minor.y  = element_blank(),
         panel.grid.minor.x  = element_blank(),
         axis.line = element_line(colour = "grey80",size=.25),
         # panel.grid.minor = element_line(colour = "grey60",size=.25,linetype ="dotted" ),
         axis.text.y = element_text(size = 10,colour="grey50"),#,hjust=0,vjust=1),
         axis.line.y = element_line(size=0.25)
  )


#-----------------------------------图6-3-3 不同形式的螺旋图和雷达图.(a) 径向热力图.------------------------------------

bars <- dat %>% 
  mutate(hour.group = cut(hour, breaks=seq(0,24,width), labels=seq(0,23.75,width),include.lowest=TRUE), #
         hour.group = as.numeric(as.character(hour.group))) %>%
  group_by(datt, hour.group) %>%
  summarise(meanTT = mean(Value2))  %>%
  # mutate(value=meanTT*max(dat$TravelTime),
  #        xmin=  hour.group,
  #        xmax = hour.group + width,
  #        ymin = datt*N ,
  #        ymax = datt*N  + 24)
  # 
     mutate(value=meanTT*max(dat$Value),
             xmin=  hour.group,
             xmax = hour.group + width,
             ymin = datt*N,
             ymax = datt*N + meanTT*N*1.1)

poly <- bars %>%
  rowwise() %>%
  do(with(., data_frame(day=datt,
                        date=day,
                        hour=hour.group,
                        value=value,
                        x = c(xmin, xmax, xmax, xmin),
                        y = c(ymin ,
                              ymin ,
                              ymax + width,
                              ymax + width ))))


ggplot(poly, aes(x, y, group = interaction(hour, day),fill=value)) +
  geom_polygon(colour="black",size=0.25) +
  
  coord_polar() +
  # ylim(-20, max(poly$y)) +
  #viridis::scale_fill_viridis(discrete = TRUE, option = 'C')# +
  scale_x_continuous(limits=c(0,N), breaks=seq(0,N-1,1), minor_breaks=0:N,
                     labels=paste0(rep(c(12,1:11),1), rep(c("AM","PM"),each=12))) +
  scale_y_continuous(limits=c(-N/2, max(poly$y)*1.2), 
                     breaks=seq(N,max(poly$y)*1.2,N),
                     labels=unique(dat$day))+
  
  #scale_fill_gradient2(low="green", mid="yellow", high="red", midpoint=mean(bars$meanTT)) +
  scale_fill_gradientn(colours=colormap)+
  #scale_fill_brewer(palette="Blues")+
  ylab("Date")+
  xlab(NA)+
  theme_bw()+
  theme( panel.background = element_blank(),
         panel.border =  element_rect(fill=NA,colour = "grey80",size=.25),
         panel.grid.major.y  = element_line(colour = "grey80",size=.25),#,linetype ="dotted" ),
         panel.grid.major.x  = element_line(colour = "grey80",size=.25),#,linetype ="dotted" ),
         panel.grid.minor.y  = element_blank(),
         panel.grid.minor.x  = element_blank(),
         axis.line = element_line(colour = "grey80",size=.25),
         # panel.grid.minor = element_line(colour = "grey60",size=.25,linetype ="dotted" ),
         axis.text.y = element_text(size = 10,colour="grey50"),#,hjust=0,vjust=1),
         axis.line.y = element_line(size=0.25)
  )


#--------------------------------------图6-3-3 不同形式的螺旋图和雷达图. (b) 螺旋柱形图. -----------------------------------------------

bars <- dat %>% 
  mutate(hour.group = cut(hour, breaks=seq(0,24,width), labels=seq(0,23.75,width),include.lowest=TRUE), #
         hour.group = as.numeric(as.character(hour.group))) %>%
  group_by(datt, hour.group) %>%
  summarise(meanTT = mean(Value2))  %>%
  mutate(value=meanTT*max(dat$Value),
         xmin=  hour.group,
         xmax = hour.group + width,
         ymin = datt*N ,
         ymax = datt*N  + 24)

poly <- bars %>%
  rowwise() %>%
  do(with(., data_frame(day=datt,
                        date=day,
                        hour=hour.group,
                        value=value,
                        x = c(xmin, xmax, xmax, xmin),
                        y = c(ymin ,
                              ymin ,
                              ymax + width,
                              ymax + width ))))


ggplot(poly, aes(x, y, group = interaction(hour, day),fill=value)) +
  geom_polygon(colour="black",size=0.25) +
  
  coord_polar() +
  # ylim(-20, max(poly$y)) +
  #viridis::scale_fill_viridis(discrete = TRUE, option = 'C')# +
  scale_x_continuous(limits=c(0,N), breaks=seq(0,N-1,1), minor_breaks=0:N,
                     labels=paste0(rep(c(12,1:11),1), rep(c("AM","PM"),each=12))) +
  scale_y_continuous(limits=c(-N/2, max(poly$y)), 
                     breaks=seq(N,max(poly$y),N),
                     labels=unique(dat$day) )+
  
  #scale_fill_gradient2(low="green", mid="yellow", high="red", midpoint=mean(bars$meanTT)) +
  scale_fill_gradientn(colours=colormap)+
  #scale_fill_brewer(palette="Blues")+
  ylab("Date")+
  xlab(NA)+
  theme_bw()+
  theme( panel.background = element_blank(),
         panel.border =  element_rect(fill=NA,colour = "grey80",size=.25),
         panel.grid.major.y  = element_line(colour = "grey80",size=.25),#,linetype ="dotted" ),
         panel.grid.major.x  = element_line(colour = "grey80",size=.25),#,linetype ="dotted" ),
         panel.grid.minor.y  = element_blank(),
         panel.grid.minor.x  = element_blank(),
         axis.line = element_line(colour = "grey80",size=.25),
         # panel.grid.minor = element_line(colour = "grey60",size=.25,linetype ="dotted" ),
         axis.text.y = element_text(size = 10,colour="grey50"),#,hjust=0,vjust=1),
         axis.line.y = element_line(size=0.25)
  )

所示。螺旋柱形图的数据结构一般为(Date,Value),将Date沿着阿基米德螺旋线展开,然后将Value同时映射到柱形高度和色带(colorbar)。螺旋热力图如

所示,将Date沿着阿基米德螺旋线展开,然后将Value对应到方块的颜色,再映射到色带。在螺旋图的基础上进行拓展,将Date从螺旋排布转换成径向排布,就可以得到径向柱形图和径向热力图,分别如

ch_图6-3-3_不同形式的螺旋图(b).pngch_图6-3-3_不同形式的螺旋图和雷达图_(a2).png
图6-3-3

所示。径向柱形图的数据Value同时映射到柱形高度和色带;而径向热力图只映射到颜色。204IR语言数据可视化之美:专业图表绘制指南总的来说,螺旋柱形图和径向柱形图都是使用柱形高度和颜色两个视觉特征展示数据,这样可以更加清晰地表达数据信息与数据变化规律。

技能螺旋柱形图R中ggplot2包的geom_polygon()函数可以自定义4个顶点:(x,y),(x,y+width),(x+width),(x+width,y+width),从而绘制四边形,其中width为多边形的高度与宽度数值。直角坐标系下的图6-3-2(a)和

的螺旋柱形图如

ch_图6-3-4_不同形式的螺旋图和雷达图(b).png
图6-3-4

所示。

所示的螺旋柱形图的实现代码如下所示。(a)直角坐标系下的

(b)直角坐标系下的

#dat为3732×3的表格数据,三列分别为“Date"Time”“Value”dat<-read_excel("SpiralChart_Data.xlsx")as.numeric(dat$time)%%(24*60*60)/3600#时刻dat$day<-as.Date(dat$time)#把天数转换成日期型dat$datt<-as.numeric(strftime(dat$day.“%d")#把天数转换成数值型dat$datt<-dat$datt-min(dat$datt)dat$Value<-as.numeric(dat$Value)dat$Value2<-dat$Value/max(dat$Value)N<-24#对应一天24个小时hour.group =as.numeric(as.character(hour.group)) %>%group_by(datt,hour.group)%>%xmin=hour.group,xmax=hour.group +width,(*Lue+dnonno+N=xednoo+Np=y=c(ymin,ymin+width.ymax+width,ymax)))geom_polygon(colour="black"size=0.25)+scale_x_continuous(limits=c(0,N).breaks=seq(0.N-1.1),minor_breaks=0:N,labels=paste()(rep(c(12,1:11).1),rep(c("AM""PM").each=12))+scale_y_continuous(limits=c(-N/2.max(poly$y).breaks=seq(N,max(poly$y).N)scale_fill_gradientn(colours=brewer.pal(9.YIGnBu'))+螺旋面积图:螺旋图还可以包括螺旋面积图,如


#EasyChartsŶӳƷñؾ
#ʹѧϰϵ΢ţEasyCharts

library(ggplot2)
library(data.table)
library(RColorBrewer)


set.seed(1)
dtData <- data.table(
  date = seq(as.Date("1/01/2014", "%d/%m/%Y"),as.Date("31/12/2017", "%d/%m/%Y"),"days"),
  ValueCol = runif(1461))
dtData[, ValueCol := ValueCol + (strftime(date,"%u") %in% c(6,7) * runif(1) * 0.75), .I]
dtData[, ValueCol := ValueCol + (abs(as.numeric(strftime(date,"%m")) - 6.5)) * runif(1) * 0.75, .I]


dtData$Year<- as.integer(strftime(dtData$date, '%Y'))   #

dtData$DateNum<-as.numeric(dtData$date)-as.numeric(as.Date(paste(as.character(strftime(dtData$date, "%Y")),"-01-01", sep = "")))


Step<-5
dtData$Asst<-rep(Step,nrow(dtData))

YearRange<-unique(dtData$Year)
for(i in 1:length(YearRange)){
  dtData$Asst[dtData$Year==YearRange[i]]<-seq(i*Step, (i+1)*Step, length.out = length(dtData$Asst[dtData$Year==YearRange[i]]))
}
circlelabel<-c("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec")
circlemonth<-seq(15,345,length=12)
circlebj<-rep(c(-circlemonth[1:3],rev(circlemonth[1:3])),2)

#-------------------------------------ͼ6-3-5ͬʽͼ. (b)ɫӳ----------------------------------------
Height<-4.8
dtData$Valueht<-(dtData$ValueCol-min(dtData$ValueCol))/(max(dtData$ValueCol)-min(dtData$ValueCol))*Height
       
ggplot()+
 geom_linerange(data=dtData,aes(x=DateNum,ymin=Asst-5,ymax=Asst+Valueht-5,color=ValueCol),size =1)+
  geom_line(data=dtData,aes(x=DateNum,y=Asst+Valueht-5,group=Year),size =0.25,color="black")+
  geom_line(data=dtData,aes(x=DateNum,y=Asst-5,group=Year),size =0.25,color="grey20")+
  
  coord_polar(theta="x",start=0)+
  scale_x_continuous(breaks=c(1,31,59,90,120,151,181,212,243,273,304,334))+
  scale_y_continuous(limits=c(-5,28),breaks=c(2.5,7.5,12.5,17.5),labels=c("2014","2015","2016","2017"))+
  scale_color_gradientn(colours=rev(brewer.pal(11,'Spectral')))+
  geom_text(data=NULL,aes(x=circlemonth,y=28,label=circlelabel,
                          angle=circlebj),size=4,color="grey50")+#,hjust=0.5,vjust=.5family="myfont",
  ylab("Year")+
  theme_bw()+
  theme( panel.background = element_blank(),
         panel.border =  element_rect(fill=NA,colour = "grey80",size=.25),
         panel.grid.major.y  = element_line(colour = "grey80",size=.25),#,linetype ="dotted" ),
         panel.grid.major.x  = element_line(colour = "grey80",size=.25),#,linetype ="dotted" ),
         panel.grid.minor.y  = element_blank(),
         panel.grid.minor.x  = element_blank(),
         axis.line = element_line(colour = "grey80",size=.25),
         # panel.grid.minor = element_line(colour = "grey60",size=.25,linetype ="dotted" ),
         axis.text.y = element_text(size = 10,colour="grey50"),#,hjust=0,vjust=1),
         axis.line.y = element_line(size=0.25)
  )


#----------------------------------------ͼ6-3-5ͬʽͼ.(a)ɫ-----------------------------------------
ggplot()+
  geom_ribbon(data=dtData,aes(x=DateNum,ymin=Asst-5,ymax=Asst+Valueht-5,group=Year,fill=Year),
              size =0.75,fill="#FF8B49")+
  geom_line(data=dtData,aes(x=DateNum,y=Asst+Valueht-5,group=Year),size =0.25,color="black")+
  geom_line(data=dtData,aes(x=DateNum,y=Asst-5,group=Year),size =0.25,color="grey20")+
  
  coord_polar(theta="x",start=0)+
  xlim(1,355)+
  scale_x_continuous(breaks=c(1,31,59,90,120,151,181,212,243,273,304,334))+
  scale_y_continuous(limits=c(-5,28),breaks=c(2.5,7.5,12.5,17.5),labels=c("2014","2015","2016","2017"))+
  geom_text(data=NULL,aes(x=circlemonth,y=28,label=c("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"),
                          angle=circlebj),size=4,color="grey50")+
  ylab("Year")+
  theme_bw()+
  theme( panel.background = element_blank(),
         panel.border =  element_rect(fill=NA,colour = "grey80",size=.25),
         panel.grid.major.y  = element_line(colour = "grey80",size=.25),#,linetype ="dotted" ),
         panel.grid.major.x  = element_line(colour = "grey80",size=.25),#,linetype ="dotted" ),
         panel.grid.minor.y  = element_blank(),
         panel.grid.minor.x  = element_blank(),
         axis.line = element_line(colour = "grey80",size=.25),
         # panel.grid.minor = element_line(colour = "grey60",size=.25,linetype ="dotted" ),
         axis.text.y = element_text(size = 10,colour="grey50"),#,hjust=0,vjust=1),
         axis.line.y = element_line(size=0.25)
  )

所示。只是将

的柱形展示换成面积展示,这样更加适合连续的时序数据的可视化。

是将螺旋颜色映射填充面积图,将每个数值映射到色带。技能螺旋面积图R中ggplot2包的geom_ribbon()函数可以绘制如

所示的纯色填充螺旋面积图,而使用geom_linerange()函数和geom_line()函数可以绘制

所示的颜色映射填充螺旋面积图,具体代码如下所示。date= seq(as.Date(“1/01/2014",“%d/%6m/%Y").as.Date("31/12/2017"“%d/%m/%Y")."days").dtData[ValueCol=ValueCol +(strftime(date,%u)%in%c(6,7)*runif(1)*0.75),]dtData[,ValueCol:=ValueCol +(abs(as.numeric(strftime(date,%m))-6.5))*runif(1)*0.75.]dtData$Year<-as.integer(strftime(dtData$date,%Y))#年份#将日期转换成1.2.3364.365的形式并保存DateNumdtData$DateNum<-as.numeric(dtData$date)-#构造间隔为5的阿基米德螺旋线dtData$Asst<-rep(Step,nrow(dtData)YearRange<-unique(dtData$Year)dtData$Asst[dtData$Year==YearRange[i]]<-seq(i*Step,(i+1)*Step,length.out =length(dtData$Asst[dtData$Year==YearRange[i])}#将数字ValueCol归一化到[0.4.8]dtData$Valueht<-(dtData$ValueCol-min(dtData$ValueCol)(max(dtData$ValueCol)-min(dtData$ValueCol))*Heightcirclemonth<-seq(15.345,length=12)#设定月份标签位置的×轴数值circlebj<-rep(c(-circlemonth[1:3],rev(circlemonth[1:3])).2)#设定月份标签位置的旋转角度geom_linerange(data=dtData.aes(x=DateNum.ymin=Asst-Step.ymax=Asst+Valueht-Step,color=ValueCol),size=1)+geom_line(data=dtData,aes(x=DateNum.y=Asst+Valueht-Step.group=Year),size =0.25,color="black")+geom_line(data=dtData.aes(x=DateNum,y=Asst-Step.group=Year),size =0.25,color=grey20")+geom_text(data=NULL,aes(x=circlemonth.y=28.label=circlelabel.angle=circlebj).size=4.color=grey50")+coord_polar(theta="x"start=0)+scale_x_cntinuous(breaks=c(1,31,59,90,120,151,181,212,243,273.304,334))+scale_y_continuous(limits=c(-Step.28)breaks=c(2.5.7.5,12.5.17.5)).labels=c(“2014""2015""2016""2017")+scale_color_gradientn(colours=rev(brewer.pal(11.'Spectral')+

6.4 量化波形图

一句话:量化波形图:堆积面积图的变形,河流状展示多类别随时间变化。

量化波形图(streamgraph),有时候也被称为“河流图”或者“主题河流图”(themeriverchart),是堆积面积图的一种变形,通过“流动”的形状来展示不同类别的数据随时间的变化情况。但其不同于堆积面积图,量化波形图并不是将数据描绘在一个固定的、笔直的轴上(堆积图的基准线就是X轴),而是将数据分散到一个变化的中心基准线上(该基准线不一定是笔直的)。通过使用流动的有机形状,量化波形图可显示不同类别的数据随着时间的变化,这些有机形状有点像河流,因此量化波形图看起来相当美观。

所示的量化波形图示意可以看出,它是用颜色区分不同的类别,或每个类别的附加定量,流向则与表示时间的X轴平行。每个类别的对应数值则是与波浪的宽度成比例从而展示出来。由于每个类别的数值变化就会形同一条粗细不一的小河,汇集、扭结在一起,因此而得名为河流图。

量化波形图很适合用来显示大容量的数据集,以便查找各种不同类别随着时间推移的趋势和模式。比如,波浪形状中的季节性峰值和谷值可以代表周期性模式。量化波形图也可以用来显示大量资产在一段时间内的波动率。

数值2数值1类别1类别2时间量化波形图的缺点在于它们存在不易读的问题,当显示大型数据集时,这类图就显得特别混乱。具有较小数值的类别经常会被“淹没”,以让出空间来显示具有更大数值的类别,使我们不能看到所有数据。此外,我们也不可能读取到量化波形图中所显示的精确数值。

因此,量化波形图还是比较适合不想花太多时间深入解读图表和探索数据的人,它适合用来显示一般表面的数据趋势。我们需要注意的是,除非使用交互技术,否则量化波形图无法精准地表达数据。但不可否认的是,在面对巨大数据量,且数值波动幅度大的情况下,量化波形图拥有优雅的视觉结构,能很好地吸引读者的注意力,同时凸显变化大的数据。

在展示量化波形图前,最好先根据数据系列最大值进行排序处理。如

#EasyCharts团队出品,
#如有问题修正与深入学习,可联系微信:EasyCharts

library(ggplot2)
library(reshape2)
library(ggTimeSeries)

df<-read.csv("StreamGraph_Data.csv",header=TRUE)
df_series<-df[,2:ncol(df)]
Col_Max<-apply(df_series,2,max)
Col_Sort<-sort(Col_Max,index.return=TRUE,decreasing = TRUE)

mydata<-melt(df,id="time")

mydata$variable<-factor(mydata$variable,levels=colnames(df_series)[Col_Sort$ix])
ggplot(mydata, aes(x = time, y = value, group = variable, fill = variable)) +
  stat_steamgraph(colour="black",size=0.25)+ 
  xlab('Time') + 
  ylab('') + 
  theme_light()

所示的量化波形图,由于没有使用交互技术,而只是静态图表,从而导致数据系列太多时,很难将图例与图表中的波形数据系列一一对应。而先求取每个数据系列的最大数值,然后根据数值排序后,再进行展示的量化波形图(见

),能很好地与

的量化波形图对应起来,波形最大值越大,越位于

所示量化波形图的外围,也越排列在图例的上方。其实,量化波形图是多个时间序列的数据系列对称堆叠而成的,无法精准地表达数据的具体数值。所以,我们也可以使用时间序列的峰峦图展示数据,如

#EasyCharts团队出品,如有商用必究,
#如需使用与深入学习,请联系微信:EasyCharts

library(ggplot2)
library(RColorBrewer)  
library(reshape2)


df<-read.csv("StreamGraph_Data.csv",header=TRUE)

#------------------------------------------------图6-4-3 时间序列峰峦图(a)-----------------------------------
x<-seq(1:nrow(df))
label<-letters[1:ncol(df)]#colnames(y2)<-
colnames(df)<-c(seq(1,ncol(df),1))

# base plot
dfData2<-as.data.frame(cbind(x,df))

Order<-sort(colSums(dfData2[,2:ncol(dfData2)]),index.return=TRUE,decreasing = TRUE) 
label2<-label[Order$ix]
mydata<-melt(dfData2,id="x")
#levels(mydata$variable)[as.integer( colnames(Order))]
mydata$variable <- factor(mydata$variable, levels = levels(mydata$variable)[Order$ix])

N<-ncol(df)
Step<-1500
mydata$offest<--as.numeric(mydata$variable)*Step# adapt the 0.2 value as you need

mydata$V1_density_offest<-mydata$value+mydata$offest


ggplot(mydata, aes(x, V1_density_offest, color=variable)) + 
  #geom_linerange(aes(x, ymin=offest,ymax=V1_density_offest, color==variable),size =1.5, alpha =1) 
  geom_ribbon(aes(x, ymin=offest,ymax=V1_density_offest, fill=variable),alpha=1,colour=NA)+
  geom_line(aes(group=variable),color="black")+
  scale_y_continuous(breaks=seq(-Step,-Step*N,-Step),labels=label2)+
  #scale_fill_manual(values =COLS)+
  xlab("Time")+
  ylab("Class")+
  theme_classic()+
  theme(
    panel.background=element_rect(fill="white",colour=NA),
    panel.grid.major.x = element_line(colour = "grey80",size=.25),
    panel.grid.major.y = element_line(colour = "grey60",size=.25),
    axis.line = element_blank(),
    text=element_text(size=15),
    plot.title=element_text(size=15,hjust=.5),#family="myfont",
    legend.position="none"
  )

#----------------------------------------------------图6-4-3 时间序列峰峦图(b)----------------------------------
library(RColorBrewer)
colormap <- colorRampPalette(rev(brewer.pal(11,'Spectral')))(32)

label<-letters[1:ncol(df)]#colnames(y2)<-
colnames(df)<-c(seq(1,ncol(df),1))

# base plot
dfData2<-as.data.frame(cbind(x,df))

Order<-sort(colSums(dfData2[,2:ncol(dfData2)]),index.return=TRUE,decreasing = TRUE) 
label2<-label[Order$ix]

dfData2<-dfData2[c(1,Order$ix+1)]

mydata<-melt(dfData2,id="x")
colnames(dfData2)<-c("x",c(seq(ncol(y2),1,-1)))


N<-ncol(df)
Step<-1500
mydata$offest<--as.numeric(mydata$variable)*Step# adapt the 0.2 value as you need

mydata$V1_density_offest<-mydata$value+mydata$offest


ggplot(mydata, aes(x, V1_density_offest,group=variable)) + 
  geom_linerange(aes(x, ymin=offest,ymax=V1_density_offest, color=value),size =1.5, alpha =1) +
  scale_color_gradientn(colours=colormap)+
  #geom_ribbon(aes(x, ymin=offest,ymax=V1_density_offest, fill=variable),alpha=1,colour=NA)+
   geom_line(aes(group=variable),color="black")+
   scale_y_continuous(breaks=seq(-Step,-Step*N,-Step),labels=label2)+
  xlab("Time")+
  ylab("Class")+
  theme_classic()+
  theme(
    panel.background=element_rect(fill="white",colour=NA),
    panel.grid.major.x = element_line(colour = "grey80",size=.25),
    panel.grid.major.y = element_line(colour = "grey60",size=.25),
    axis.line = element_blank(),
    text=element_text(size=13),
    plot.title=element_text(size=15,hjust=.5),#family="myfont",
    legend.position="right"
  )

所示。

将数值映射到渐变颜色条,这样可以清晰地表示每个数值的具体数值,更好地观察每个数据系列随时间的变化规律,同时可以更好地比较不同数据系列之间的数值。技能量化波形图R中ggTimeSeries包的statsteamgraph()函数可以绘制量化波形图。其关键在于要根据数据系列最大值排序处理,可以先使用apply()函数求取每个数据系列的最大值,然后使用sort()函数对所有数据系列的最大值进行排序。

所示的量化波形图的实现代码如下所示

)。Doc jan FebMarAprMay JunJul Aug SepOe

6.5 地平线图

一句话:地平线图:折线折叠压缩显示大量时序数据,金融行情常用。

地平线图(horizongraph)是在Panopticon软件开发时提出的一种时序数据可视化方法,如图6-5-1所示。最开始的时候,地平线图被金融投资经理用来展示同一时间的股票数据[3.50]。现在地平线图主要用于如下三个方面。

(1)辨识异常数据、异常变化和主要的数据规律;(2)在合理的精度范围内观察每个数据系列(股票)随时间的变化;(3)比较不同数据系列(股票)的数值情况。平常的股票时序数据包括某一年的每一天的股票价格,其常见的数据可视化方法主要是折线图或者面积图,但是这样无法观察到异常的数据,且对于大数据集的图表占用面积较大,所以这才有了地平线图。如

所示,从普通的折线图发展到地平线图,主要包括如下步骤。(1)时序数据使用基于起始日期数值的百分比,替代实际股票价格,得到如

所示的百分比数值的折线图。这样可以保证不同的数据系列能有相同的高度,同时可以增强不同数据系列之间的对比。(2)为了让读者更好地观察异常数据、异常变化和主要模式,双向渐变颜色主题(因为股票数据系列既有正值,又有负值)可以用于颜色条带(colorband)上,如

所示,图表的高饱和度颜色部分可以明显地展示,这有点类似平常的热力图。由于颜色条带可以清晰地展示数据间的差异,这样可以让读者更加简单地观察数据的变化情况。在图表中,每个颜色条带的高度都对应到数据变化的比例(

中颜色条带的高度代表10%的数据变化),这样也可以让读者更加精准地观察数据。在颜色条带中,蓝色代表正值,红色代表负值。(3)由于希望图表能够以尽可能小的图表面积展示大数据集的数据信息,所以可以将红色部分的条带依旧对应表示数据的负值部分,如

所示,这样就能有效地降低图表的高度。(4)为了进一步降低图表的高度,我们可以将每个颜色条带平移到X轴,同时保持颜色条带的颜色信息,这种技术被称为双伪色调着色技术(two-tonepseudocolourig),如

所示,如此,可以将图表高度降低2/3。这样可以将图表的颜色限制在三种不同的颜色条带上,方便读者观察数据,但是这样依旧可以准确地保留数据信息。(5)最后为了展示大量不同数据系列的信息,可以采用分面展示技术(smallmultiple),将不同数据系列的小图表纵向排列展示。

技能地平线图R中latticeExtra包的latticeExtra()函数和ggalt包的geom_horizon()函数都可以绘制地平线图,其中使用ggalt包的geomhorizon()函数绘制

#EasyCharts团队出品,
#如有问题修正与深入学习,可联系微信:EasyCharts

library(ggplot2)
library(RColorBrewer)
library(ggalt) # ggalt 的下载语句:devtools::install_github("hrbrmstr/ggalt")
library(reshape2)
colormap <- colorRampPalette(rev(brewer.pal(11,'RdYlBu')))(15)

df<-as.data.frame(matrix(cumsum(rnorm(250 * 15)), ncol = 15))
colnames(df) <- paste("series", LETTERS[1:15])
df$x<-rownames(df)

dfData<-melt(df,id='x')
ggplot(dfData, aes(x =as.numeric(x), y = value) )+
  geom_horizon(colour=NA,size=0.25,bandwidth=10)+
  facet_wrap(~variable, ncol = 1,strip.position = "left")+
  scale_fill_manual(values=colormap)+
  xlab('Time') + 
  ylab('') + 
  theme_bw()+
  theme(strip.background = element_blank(),
        strip.text.y = element_text(hjust=0, angle=180,size=10),
        axis.text.y=element_blank(),
        panel.grid = element_blank(),
        panel.spacing.y=unit(-0.05, "lines"),
        panel.grid.major.y=element_blank(),
        panel.grid.minor.y =element_blank(),
        axis.ticks.y = element_blank())

所示地平线图的具体代码如下所示

本章一句话总结:时间序列选图:折线图看一般趋势、面积图强调累积量、螺旋图看周期性、雷达图做多维指标对比。
×