用emoji表情包來可視化北京市歷史天氣情況！

用emoji表情包來可視化北京市歷史天氣情況！

 

最近有了一個突如其來的想法，主要是看到了R社區有大神作了emoji表情包，並已經打通了ggplot的連接，因此想用ggplot結合emoji表情作一期天氣可視化！

library(RCurl) library(XML) library(dplyr) library(stringr) library(tidyr) library(plyr) library(rvest) library(ggimage) library(Cairo) library(showtext) library(lubridate) 

如下是北京2016年整年日度歷史天氣的獲取過程！

url<-"http://lishi.tianqi.com/beijing/index.html" myheader <-c("User-Agent"="Mozilla/5.0 (Windows NT 10.0; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/56.0.2924.87 Safari/537.36") webpage<-getURL(url,httpheader=myheader) mymonthlink<-getHTMLLinks(url,externalOnly=TRUE)%>%grep(".*?2016\\d{2}.html",.,value=T) 

剛開始信誓旦旦的要用RCurl去爬，結果給我整蒙逼了，不是爬不了，數據弄出來太碎了，後來我用了rvest。

#### #page1<-getURL(mymonthlink[2],.encoding="gbk") #rd<-iconv(page1,"gbk","utf-8") #rdhtml<-htmlParse(rd,encoding="UTF-8") #cesh<-readHTMLList(rdhtml,trim=TRUE,elFun=xmlValue)%>%grep("\\d{4}-\\d{2}-\\d{2}",.,value=T) #cesh<-cesh%>%sub("([a-z])(\\()(\\\)","",.) #cesh<-cesh1%>%str_split(',')%>%plyr::ldply(.fun=NULL) #cesh$V1<-cesh$V1%>%sub("[a-z]\\(","",.)%>%as.Date() #names(cesh)<-c("date","high","low","state","wind","index") #### 以上代碼寫了一半寫不下去了，我有rvest爲啥要用RCurl，確定本身腦抽筋了！ 

用了rvest就輕鬆多了！

mynewdata<-c() for (i in mymonthlink){ mymonthdata<-read_html(i,encoding="gbk")%>%html_nodes("div.tqtongji2>ul")%>%html_text(trim=FALSE)%>%str_trim(.,side="right")%>%.[-1] mynewdata<-c(mynewdata,mymonthdata) } 

爬出來弄成一個 向量了，須要分列，其實能夠直接使用節點區每個變量的值，可是那樣我以爲太麻煩！因此簡單粗暴，爬到一塊兒而後使用stringr去處理！

mynewdata1<-mynewdata mynewdata<-mynewdata1%>%gsub("\t\t\t|\t|\r\n","",.)%>%str_split(' ')%>%plyr::ldply(.fun=NULL)%>%.[,-2] names(mynewdata)<-c("date","high","low","state","wind","index") mynewdata$date<-as.Date(mynewdata$date) mynewdata$high<-as.numeric(mynewdata$high) mynewdata$low<-as.numeric(mynewdata$low) 

將天氣進行歸類！

unique(mynewdata$state) happy<-c("晴","陣雨~晴","多雲轉晴","多雲~晴","雷陣雨~晴","陰~晴","霾~晴","浮塵~晴") depressed<-c("霾","陰","多雲","晴~多雲","霾~多雲","晴~霾","多雲~霾","陣雨轉多雲","多雲轉陰","陰~多雲","多雲~陰","晴~陰","陣雨~多雲","小雨~多雲","小雨~陰","霾~霧","小雪~陰","陰~小雪","小雨~雨夾雪") angry<-c("小雨","雨夾雪","小雪","雷陣雨","陣雨","中雨","小到中雨","雷陣雨~陰","多雲~雷陣雨","陰~雷陣雨","霾~雷陣雨","多雲~陣雨","晴~陣雨","陰~小雨","陣雨~小雨") Terrified<-c("中到大雨","暴雨","雷陣雨~中到大雨") 

分類賦值！

mynewdata$mode<-NULL mynewdata$mood<-ifelse(mynewdata$state%in% happy,"happy",ifelse(mynewdata$state%in% depressed,"depressed",ifelse(mynewdata$state%in% angry,"angry","Terrified"))) 

按照分類匹配emoji表情代碼：

mynewdata <- within(mynewdata,{  mood_code <- NA  mood_code[mood=="happy"]<-"1f604"  mood_code[mood=="depressed"]<-"1f633"  mood_code[mood=="angry"]<-"1f62d"  mood_code[mood=="Terrified"]<-"1f621" }) 

建立多個時間變量！

mynewdata$month<-as.numeric(as.POSIXlt(mynewdata$date)$mon+1) mynewdata$monthf<-factor(mynewdata$month,levels=as.character(1:12),labels=c("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"),ordered=TRUE) mynewdata$weekday<-as.POSIXlt(mynewdata$date)$wday mynewdata$weekdayf<-factor(mynewdata$weekday,levels=rev(0:6),labels=rev(c("Sun","Mon","Tue","Wed","Thu","Fri","Sat")),ordered=TRUE) mynewdata$week <- as.numeric(format(mynewdata$date,"%W")) mynewdata<-ddply(mynewdata,.(monthf),transform,monthweek=1+week-min(week)) mynewdata$day<-day(mynewdata$date) 

讀寫數據，最怕整理好了斷網了或者關機了什麼的，因此要市場作好備份！

write.table(mynewdata,"historyweather.csv",sep=",",row.names=FALSE) mynewdata<-read.csv("historyweather.csv",stringsAsFactors = FALSE,check.names = FALSE) 

圖一的主題：

mytheme<-theme(  rect=element_blank(),  axis.ticks=element_blank(),  text=element_text(face="plain",lineheight=0.9,hjust=0.5,vjust=0.5,size=15),  title=element_text(face="plain",lineheight=0.9,hjust=0,vjust=0.5,size=30),  axis.title=element_blank(),  strip.text=element_text(size = rel(0.8)),  plot.margin = unit(c(5,2,5,2),"lines")  ) 

圖一效果：

CairoPNG("emoji1.png",1000,870)
showtext.begin()
ggplot(mynewdata,aes(weekdayf,monthweek,fill=high))+
geom_tile(colour='white')+
scale_fill_gradient(low=NA, high=NA,guide=FALSE)+
ggtitle("The emoji-weather visualization of beijing in 2016")+
scale_y_reverse(breaks=seq(from=6,to=0,by=-1))+
ggimage::geom_emoji(aes(image=mood_code),size=.1)+
facet_wrap(~monthf ,nrow=3)+
mytheme
showtext.end()
dev.off()

 

圖二主題：

 

mytheme2<-theme(  rect=element_blank(),  axis.ticks=element_blank(),  text=element_text(face="plain",lineheight=0.9,hjust=0.5,vjust=0.5,size=15),  title=element_text(face="plain",lineheight=0.9,hjust=0,vjust=0.5,size=30),  axis.title=element_blank(),  strip.text=element_text(size = rel(0.8)),  plot.margin = unit(c(1,1,1,1),"lines")  ) 

圖二效果：

setwd("F:/數據可視化/R/R語言學習筆記/可視化/ggplot2/商務圖表") CairoPNG("emoji2.png",1200,1200) showtext.begin() ggplot(mynewdata,aes(x=factor(day),y=monthf,fill=high))+ geom_tile(colour='white')+ expand_limits(y =c(-12,12))+ scale_x_discrete(position=c("bottom"))+ coord_polar(theta="x")+ scale_fill_gradient(low=NA, high=NA,guide=FALSE)+ ggimage::geom_emoji(aes(image=mood_code),size=.015)+ geom_image(aes(x=0,y=-12),image ="weather.png", size =.15)+ ggtitle("The emoji-weather visualization of beijing in 2016")+ mytheme2 showtext.end() dev.off() 

OK了，作完收工~

做者簡介：

-------

wechat：ljty1991 
Mail:578708965@qq.com 我的公衆號：數據小魔方（datamofang） 團隊公衆號：EasyCharts qq交流羣：[魔方學院]553270834