R与ggplot2，作多图组合及时间粒度分析

是 否 +2 论坛币

k人 参与回答

经管之家送您一份

应届毕业生专属福利!

求职就业群

赵安豆老师微信：zhaoandou666

经管之家联合CDA

送您一个全额奖学金名额~ !

立即领取

感谢您参与论坛问题回答

经管之家送您两个论坛币！

+2 论坛币

#载入包

1. if (!suppressWarnings(require("ggplot2"))) {
   
2.   install.packages("ggplot2")
   
3.   require("ggplot2")
   
4. }
   
5. 
   
6. if (!suppressWarnings(require("reshape2"))) {
   
7.   install.packages("reshape2")
   
8.   require("reshape2")
   
9. }
   
10. 
    
11. if (!suppressWarnings(require("plyr"))) {
    
12.   install.packages("plyr")
    
13.   require("plyr")
    
14. }
    
15. 
    
16. if (!suppressWarnings(require("zoo"))) {
    
17.   install.packages("zoo")
    
18.   require("zoo")
    
19. }
    
20. 
    
21. if (!suppressWarnings(require("grid"))) {
    
22.   install.packages("grid")
    
23.   require("grid")
    
24. }
    
25. 
    
26. if (!suppressWarnings(require("gridExtra"))) {
    
27.   install.packages("gridExtra")
    
28.   require("gridExtra")
    
29. }
    
30. report <- read.csv("H:/自媒体/2015-07-20/茶与咖啡/report.csv", header = T, sep = ",", stringsAsFactors = F)
    
31. report$week <- as.Date(report[,1])

复制代码

饮品就如人的面孔一样千差万别，但是人们经常饮用的饮料无外乎茶、啤酒、咖啡、酒这四大类，这四类饮品已经深深的融入到人类的历史文化中了。
中国是茶的发源地，中国人种茶、饮茶已经有3000的历史了，茶文化已经融入到中国人的骨髓里，常言道：“开门七件事，柴米油盐酱醋茶”，茶已经从士绅的茶座走向了每一个中国人的心里，也走出了中国；啤酒的销量仅次于水和茶，说起啤酒的历史那应该和酒一样古老，公元前6000年左右巴比伦人用黏土板雕刻的献祭用啤酒制作法是最古老的有关啤酒的文献，这一清凉夏日饮品19世纪才传入中国，但史载我们的仙人很早以前也掌握了麦芽酿造技术，即所谓的蘖法酿醴（li），但是汉代以后该方法失传了，取而代之的是酒曲发酵的甜酒；而咖啡应该是最年轻的，但是它却以温柔的一面改变着历史和创造历史的人。

#作最近四年的四种饮料的对比，看看谁是number one

1. teabar <- cbind(report, year = substr(report$week,1,4))
   
2. teabar <- teabar[, -1]
   
3. teabar <- aggregate(.~ year, data = teabar,sum)#透视表按年汇总
   
4. teabar <- teabar[9:12,]
   
5. teabar <- melt(teabar, id = "year")
   
6. 
   
7. theme_opts <- theme(panel.background=element_rect(fill=rgb(red = 242, green = 242, blue = 242, max = 255)),
   
8.       plot.background=element_rect(fill=rgb(red = 242, green = 242, blue = 242, max = 255)),
   
9.       panel.grid.major=element_line(colour=rgb(red = 146, green = 146, blue = 146, max = 255),size=.75),
   
10.      #panel.border=element_rect(colour=rgb(red = 242, green = 242, blue = 242, max = 255)),
    
11.       axis.ticks=element_blank(),
    
12.       axis.text.x = element_text(colour="grey20", size=12),
    
13.       axis.text.y = element_text(colour="grey20",size=12),
    
14.       axis.text.y = element_text(size=13,colour=rgb(red = 74, green = 69, blue = 42, max = 255),face="bold"),
    
15.       axis.title.y=element_text(size=11,colour=rgb(red = 74, green = 69, blue = 42, max = 255),face="bold",vjust=1.5),
    
16.       axis.title.x=element_text(size=11,colour=rgb(red = 74, green = 69, blue = 42, max = 255),face="bold",vjust=-.5),
    
17.       legend.position="none")
    
18. cols <- c(rgb(red = 0, green = 130, blue = 137, max = 255),#茶
    
19.           rgb(red = 252, green = 157, blue = 154, max = 255),#咖啡
    
20.           rgb(red = 253, green = 117, blue = 107, max = 255),#啤酒
    
21.           rgb(red = 200, green = 200, blue = 169, max = 255))#酒
    
22. p <- ggplot(teabar,aes(x = variable, y = value, fill = variable)) +
    
23.   geom_bar(stat = "identity",fill = cols) +
    
24.   coord_flip() +
    
25.   ylab("") +
    
26.   xlab("") +
    
27.   theme_opts + guides(fill=FALSE)
    
28. p + facet_wrap( ~ year, ncol=2)

复制代码

如果搜索量代表着人们对茶、啤酒、咖啡、酒代表着人们的偏好，那么谁才是人们心中的最佳饮品呢？咖啡是近四年来搜索量均排名第一，其次为茶、酒、啤酒。但从趋势上分析，茶和啤酒正变得越来越热，而咖啡经历暴涨之后略显颓势，有趣的是酒自2005年期搜索量一直在下降，知道近两年进入了平台期。但酒类人家也曾阔过，和酒类相比，2005年之前，其他三类饮料根本不是一个档次。另外，在2007-2010年之间四类饮料的搜索量均跌入了谷底期。

#下一步画年折线图，看看有没有什么趋势

1. teabar <- cbind(report, year = substr(report$week,1,4))
   
2. teabar <- teabar[, -1]
   
3. teabar <- aggregate(.~ year, data = teabar,sum)#透视表按年汇总
   
4. #teabar <- melt(teabar, id = "year")
   
5. teabar$year <- 2004:2015
   
6. 
   
7. theme_opts <- theme(panel.background=element_rect(fill=rgb(red = 242, green = 242, blue = 242, max = 255)),
   
8.       plot.background=element_rect(fill=rgb(red = 242, green = 242, blue = 242, max = 255)),
   
9.       panel.grid.major=element_line(colour=rgb(red = 146, green = 146, blue = 146, max = 255),size=.75),
   
10.      panel.border=element_blank(),
    
11.       axis.ticks=element_blank(),
    
12.       axis.text.x = element_text(colour="grey20", size=12),
    
13.       axis.text.y = element_text(colour="grey20",size=12),
    
14.       axis.text.y = element_text(size=13,colour=rgb(red = 74, green = 69, blue = 42, max = 255),face="bold"),
    
15.       axis.title.y=element_text(size=11,colour=rgb(red = 74, green = 69, blue = 42, max = 255),face="bold",vjust=1.5),
    
16.       axis.title.x=element_text(size=11,colour=rgb(red = 74, green = 69, blue = 42, max = 255),face="bold",vjust=-.5),
    
17.       legend.position="none")
    
18. 
    
19. #绘制p1
    
20. p1 <- ggplot(teabar,aes(x = year)) +
    
21.   geom_line(aes(y = 茶), color = rgb(red = 0, green = 130, blue = 137, max = 255), size=1.6) +
    
22.   annotate("text", x = 2012.5, y = 2300, colour=rgb(red = 0, green = 130, blue = 137, max = 255), label="茶", size = 6, fontface = "bold") +
    
23.   geom_line(aes(y = 咖啡), color = rgb(red = 252, green = 157, blue = 154, max = 255), size = 1.6) +
    
24.   annotate("text", x = 2012.5, y = 3300, colour = rgb(red = 252, green = 157, blue = 154, max = 255), label = "咖啡", size = 6, fontface = "bold") +
    
25.   geom_line(aes(y = 啤酒), color = rgb(red = 253, green = 117, blue = 107, max = 255), size = 1.6) +
    
26.   annotate("text", x = 2012.5, y = 1800, colour = rgb(red = 253, green = 117, blue = 107, max = 255), label = "啤酒", size = 6, fontface = "bold") +
    
27.   geom_line(aes(y = 酒), color = rgb(red = 200, green = 200, blue = 169, max = 255), size = 1.6) +
    
28.   annotate("text", x = 2012.5, y = 2800, colour = rgb(red = 200, green = 200, blue = 169, max = 255), label = "酒", size = 6, fontface = "bold") +
    
29.   theme_bw() +
    
30.   scale_x_continuous(minor_breaks = 2004, breaks = c(2004,2005,2006,2007,2008,2009,2010,2011,2012,2013,2014,2015)) + #这里空着这竖行次网格线minor_breaks
    
31.   ggtitle("") +
    
32.   ylab("") +
    
33.   xlab("") +
    
34.   theme_opts

复制代码

从年跨度上分析，我们可能就得到这一点知识，如果就此止步，也许会错过很多偏好的细节。不如把时间的粒度缩小一点，看看什么情况。从季度趋势上分析，每类产品在第四季度和第一季度之间都有有一个峰值，而且在时间上更偏向与第四季度，但啤酒成了一个例外，它的搜索峰值在年中，即第二和第三季度之间，个人猜测，原因可能是第四季度和第一季度是为圣诞节、元旦采购的时间，而第三季度则是清凉夏日。如果这些搜索量和人们的消费习惯相关，很难拒绝将广告、折扣等促销活动安排在峰值时期。


#下一步化季度折线图

1. teabar <- report
   
2. teabar$year <- as.yearqtr(teabar$week)
   
3. teabar <- teabar[, -1]
   
4. teabar <- aggregate(.~ year, data = teabar,sum)#透视表按年汇总
   
5. teabar$year <- as.character(teabar$year)
   
6. teabar$year <- gsub(" Q", "0", teabar$year)
   
7. teabar$year <- as.numeric(teabar$year)
   
8. teabar <- teabar[-length(teabar[,1]),]
   
9. #teabar <- melt(teabar, id = "year")
   
10. #teabar$year <- 2004:2015
    
11. #quarter <- teabar$year
    
12. quarter <- 1:44
    
13. teabar <- cbind(teabar, quarter)
    
14. #quarter <- quarter[!is.na(quarter)]
    
15. temp <- seq(1, 44, by = 4)
    
16. theme_opts <- theme(panel.background=element_rect(fill=rgb(red = 242, green = 242, blue = 242, max = 255)),
    
17.       plot.background=element_rect(fill=rgb(red = 242, green = 242, blue = 242, max = 255)),
    
18.       panel.grid.major=element_line(colour=rgb(red = 146, green = 146, blue = 146, max = 255),size=.75),
    
19.      panel.border=element_blank(),#element_rect(colour=rgb(red = 242, green = 242, blue = 242, max = 255)),
    
20.       axis.ticks=element_blank(),
    
21.       axis.text.x = element_text(colour="grey20", size=12),
    
22.       axis.text.y = element_text(colour="grey20",size=12),
    
23.       axis.text.y = element_text(size=13,colour=rgb(red = 74, green = 69, blue = 42, max = 255),face="bold"),
    
24.       axis.title.y=element_text(size=11,colour=rgb(red = 74, green = 69, blue = 42, max = 255),face="bold",vjust=1.5),
    
25.       axis.title.x=element_text(size=11,colour=rgb(red = 74, green = 69, blue = 42, max = 255),face="bold",vjust=-.5),
    
26.       legend.position="none")
    
27. cols <- c(rgb(red = 0, green = 130, blue = 137, max = 255),#茶
    
28.           rgb(red = 252, green = 157, blue = 154, max = 255),#咖啡
    
29.           rgb(red = 253, green = 117, blue = 107, max = 255),#啤酒
    
30.           rgb(red = 200, green = 200, blue = 169, max = 255))#酒
    
31. #绘制p1
    
32. p1 <- ggplot(teabar,aes(x = quarter)) +
    
33.   geom_line(aes(y = 茶), color = rgb(red = 0, green = 130, blue = 137, max = 255), size=1.6) +
    
34.   annotate("text", x = 1, y = 525, colour=rgb(red = 0, green = 130, blue = 137, max = 255), label="茶", size = 6, fontface = "bold") +
    
35.   
    
36.   theme_bw() +
    
37.   scale_x_continuous(minor_breaks = 0, breaks = c(1, 5, 9, 13, 17, 21, 25, 29, 33, 37, 41), labels =  c("2004Q1","2005Q1","2006Q1","2007Q1","2008Q1","2009Q1","2010Q1","2011Q1","2012Q1","2013Q1","2014Q1")) + #这里空着这竖行次网格线minor_breaks
    
38.   ggtitle("") +
    
39.   ylab("") +
    
40.   xlab("") +
    
41.   theme_opts +
    
42.   theme(axis.text.x = element_blank(), plot.margin = unit(c(-1,0.5,0.5,0.5), "lines"))
    
43. 
    
44. p2 <- ggplot(teabar,aes(x = quarter)) +
    
45.   geom_line(aes(y = 咖啡), color = rgb(red = 252, green = 157, blue = 154, max = 255), size = 1.6) +
    
46.   annotate("text", x = 1, y = 650, colour = rgb(red = 252, green = 157, blue = 154, max = 255), label = "咖啡", size = 6, fontface = "bold") +
    
47.   
    
48.   theme_bw() +
    
49.   scale_x_continuous(minor_breaks = 0, breaks = c(1, 5, 9, 13, 17, 21, 25, 29, 33, 37, 41), labels =  c("2004Q1","2005Q1","2006Q1","2007Q1","2008Q1","2009Q1","2010Q1","2011Q1","2012Q1","2013Q1","2014Q1")) + #这里空着这竖行次网格线minor_breaks
    
50.   ggtitle("") +
    
51.   ylab("") +
    
52.   xlab("") +
    
53.   theme_opts +
    
54.   theme(axis.text.x = element_blank(), plot.margin = unit(c(-1,0.5,0.5,0.5), "lines"))
    
55. 
    
56. p3 <- ggplot(teabar,aes(x = quarter)) +
    
57.   geom_line(aes(y = 啤酒), color = rgb(red = 253, green = 117, blue = 107, max = 255), size = 1.6) +
    
58.   annotate("text", x = 1, y = 500, colour = rgb(red = 253, green = 117, blue = 107, max = 255), label = "啤酒", size = 6, fontface = "bold") +
    
59.   theme_bw() +
    
60.   scale_x_continuous(minor_breaks = 0, breaks = c(1, 5, 9, 13, 17, 21, 25, 29, 33, 37, 41), labels =  c("2004Q1","2005Q1","2006Q1","2007Q1","2008Q1","2009Q1","2010Q1","2011Q1","2012Q1","2013Q1","2014Q1")) + #这里空着这竖行次网格线minor_breaks
    
61.   ggtitle("") +
    
62.   ylab("") +
    
63.   xlab("") +
    
64.   theme_opts +
    
65.   theme(plot.margin = unit(c(-1,0.5,0.5,0.5), "lines"))
    
66. 
    
67. p4 <- ggplot(teabar,aes(x = quarter)) +
    
68.   geom_line(aes(y = 酒), color = rgb(red = 200, green = 200, blue = 169, max = 255), size = 1.6) +
    
69.   annotate("text", x = 1, y = 850, colour = rgb(red = 200, green = 200, blue = 169, max = 255), label = "酒", size = 6, fontface = "bold") +
    
70.   theme_bw() +
    
71.   scale_x_continuous(minor_breaks = 0, breaks = c(1, 5, 9, 13, 17, 21, 25, 29, 33, 37, 41), labels =  c("2004Q1","2005Q1","2006Q1","2007Q1","2008Q1","2009Q1","2010Q1","2011Q1","2012Q1","2013Q1","2014Q1")) + #这里空着这竖行次网格线minor_breaks
    
72.   ggtitle("") +
    
73.   ylab("") +
    
74.   xlab("") +
    
75.   theme_opts +
    
76.   theme(plot.margin = unit(c(-1,0.5,0.5,0.5), "lines"))
    
77. gp1<- ggplot_gtable(ggplot_build(p1))
    
78. gp2<- ggplot_gtable(ggplot_build(p2))
    
79. gp3<- ggplot_gtable(ggplot_build(p3))
    
80. gp4<- ggplot_gtable(ggplot_build(p4))
    
81. maxWidth = unit.pmax(gp1$widths[2:3], gp2$widths[2:3], gp3$widths[2:3], gp4$widths[2:3])
    
82. gp1$widths[2:3] <- maxWidth
    
83. gp2$widths[2:3] <- maxWidth
    
84. gp3$widths[2:3] <- maxWidth
    
85. gp4$widths[2:3] <- maxWidth
    
86. grid.arrange(gp1, gp2, gp3, gp4)#, nrow=4设置排列方式

复制代码

#画月折线图
如果将时间粒度再缩小一些，在月度图上可能看到的、更多的细节，除了年末和年初的一个月会出现峰值以外（啤酒除外），每个一两个月还会出现一个小峰值，这可能又是一个人们的购物习惯，每次购物间隔约为1到2个月。周折线则将这种习惯定位到月末至月初的一周时间。

更多数据及代码链接：http://pan.baidu.com/s/1hqhaPJe 密码：微信索取

关于我们，关注理性与文艺，用数据创作内容性的精致阅读，这里是数据分析挖掘人员与文艺青年的集结地，不做培训，不做鼓吹，只踏踏实实的做一个又一个数据驱动的文章，并设计机器人减轻数据分析的负担，无论你感兴趣还是想参与都可以关注，请加微信公众号大音如霜

扫码加我 拉你入群

请注明：姓名-公司-职位

以便审核进群资格，未注明则拒绝

分享0 收藏7 回帖

关键词：ggplot2 gplot plot GPL Packages ggplot 多图 时间序列

最近的帖子老是超过限制

不错，谢谢分享。。。。

32个赞！！！！

好棒！谢谢分享！

谢谢分享

主可以分享下数据么，sample就可以了！

挺好看的，支持一下