shiny動態儀錶盤應用——中國世界自然文化遺產可視化案例

這一篇很早就想寫了,一直拖到現在都沒寫完。

雖然最近的社交網路上娛樂新聞熱點特別多,想用來做可視化分析的素材簡直多到不可想像,但是我個人一向不追星,對明星熱文和娛樂類的新聞興趣不是很大。還是更願意把自己的精力貢獻在那些不起眼的,然而卻更能觸動我們心靈與文化內涵的素材上來。

今天要寫的主題中國的世界遺產名錄,我將使用簡單的網路數據抓取,多角度呈現我國當前已經擁有的世界遺產名錄數目、類別、地域分布、詳情介紹等。

zyzw.com/twzs010.htm

library("rvest")nlibrary("stringr")nlibrary("xlsx")n

首先要確定好要爬取的目標信息。我感興趣的是世界遺產的名稱、申請成功的時間、分布的省份、遺產的性質、簡介、詳情頁網址、預覽圖片地址。然後分析頁面信息與後台代碼,準備進入爬取階段。

url<-"http://www.zyzw.com/twzs010.htm"nweb<-read_html(url,encoding="GBK") nName<-web %>% html_nodes("b")%>%html_text(trim = FALSE)n%>%gsub("(nt|,|d|、)","",.)%>%grep("S",.,value=T)%>%str_trim(side="both")%>%.[1:54]n%>%.[setdiff(1:54,c(35,39))]nlink<-paste0("http://www.zyzw.com/zgsjyc/zgsjyc",sprintf("%03d",1:52),".htm")nimg_link<-paste0("http://www.zyzw.com/zgsjyc/zgsjyct/zgsjyc",sprintf("%03d",1:52),".jpg")nmydata<-data.frame(Name=Name,link=link,img_link)nwrite.xlsx(mydata,"E:/***/mydata.xlsx",sheetName="Sheet1",append=FALSE)n

其他信息過於雜亂,抓取清洗非常耗時,索性手動在Excel裡面清洗了。

setwd("E:/shiny/WorldHeritageSites")nlibrary("xlsx")nlibrary("lubridate")nlibrary("ggplot2")nlibrary("plyr")nlibrary("RColorBrewer")nlibrary("dplyr")nlibrary("maptools")nlibrary("ggthemes")nlibrary("leafletCN")nlibrary("leaflet")nlibrary("htmltools")nlibrary("shiny")nlibrary("shinydashboard")nlibrary("rgdal")n

世界遺產申請年份頻率統計:

mydata<-read.xlsx("./data/yichan.xlsx",sheetName="Sheet1",header=T,encoding=UTF-8,stringsAsFactors=FALSE,check.names=FALSE)nnmydata$Time<-ymd(mydata$Time)nggplot(mydata,aes(Time))+ngeom_histogram(binh=30)+ngeom_rug()+nscale_x_date(date_breaks="2 years",date_labels = "%Y")+ntheme_void() %+replace%ntheme(n axis.text=element_text(),n plot.margin = unit(c(1,1,1, 1), "lines"),n axis.line=element_line()n )n

世界遺產類別統計:

class_count<-plyr::count(mydata$Class)nclass_count<-arrange(class_count,freq)nclass_count$label_y=c(0,cumsum(class_count$freq)[1:3])+class_count$freq/2class_count$x<-factor(class_count$x,levels=c("世界文化遺產","世界自然遺產","世界文化與自然遺產","世界文化景觀遺產"),order=T)nggplot(class_count,aes(x=1,y=freq,fill=x))+ngeom_col()+ngeom_text(aes(x=1.6,y=label_y,label=paste(round(class_count$freq*100/sum(class_count$freq)),"%")))+ncoord_polar(theta="y")+nscale_fill_brewer()+nguides(fill=guide_legend(title=NULL,reverse=T))+nlabs(title="中國世界自然與文化遺產類別佔比")+ntheme_void(base_size=15)%+replace%ntheme(plot.margin = unit(c(1,1,1, 1), "lines"))n

世界自然文化遺產地域分布:

china_map <- readOGR("D:/R/rstudy/CHN_adm/bou2_4p.shp",stringsAsFactors=FALSE) nggplot()+ ngeom_polygon(data=china_map,aes(x=long,y=lat,group=group),col="grey60",fill="white",size=.2,alpha=.4)+ngeom_point(data=mydata,aes(x=long,y=lat,shape=Class,fill=Class),size=3,colour="white")+ n coord_map("polyconic") +n scale_shape_manual(values=c(21,22,23,24))+n scale_fill_wsj()+n labs(title="中國世界自然文化遺產分布圖",caption="數據來源:中國世界遺產名錄")+ n theme_void(base_size=15) %+replace%n theme(n plot.title=element_text(size=25,hjust=0),n plot.caption=element_text(hjust=0), n legend.position = c(0.05,0.75),n plot.margin = unit(c(1,0,1,0), "cm")n )n

基於leaflet動態可視交互的世界自然文化遺產地理分布圖

for(i in 1:nrow(mydata)){n mydata$label[i]=sprintf(paste("<b><a href=%s>%s</a></b>","<p>%s</p>","<p>%s</p>","<p><img src=%s width_=300></p>",sep="<br/>"),n mydata$link[i],mydata$Name[i],mydata$Class[i],mydata$Information[i],mydata$img_link[i])n}nleaflet(china_map)%>%amap()%>%addPolygons(stroke = FALSE)%>%naddMarkers(data=mydata,lng=~long,lat=~lat,popup=~label)n

leaflet動態效果請點擊這裡:

rpubs.com/ljtyduyu/3111

接下來把以上所有代碼封裝成一個shinyAPP。

封裝UI:

####封裝UI:nui <- dashboardPage(n dashboardHeader(title = "中國世界遺產名錄可視化"),n dashboardSidebar(n sidebarMenu(n menuItem("申請時間與類型分布", tabName = "dashboard1", icon = icon("dashboard")),n menuItem("中國世界遺產地域分布", tabName = "dashboard2", icon = icon("dashboard")),n menuItem("中國世界遺產分布詳情", tabName = "dashboard3", icon = icon("dashboard")),n menuItem("中國世界遺產名錄摘要", tabName = "widgets", icon = icon("th"))n )n ),nn dashboardBody(n tabItems(nn tabItem(tabName = "dashboard1",n fluidRow(n box(n title = "申請時間分布",n plotOutput("plot1", height = 500)n ),n box(n title = "世界遺產類別分布",n plotOutput("plot2", height = 500)n )n )n ),nn tabItem(tabName = "dashboard2",n fluidRow(n box(n title = "中國世界遺產地域分布",n plotOutput("plot3", width_=1000, height=800),n width =10n )n )n ),nn tabItem(tabName = "dashboard3",n fluidRow(n box(n title = "中國世界遺產分布詳情",n leafletOutput("plot4", width = "100%", height = 1000),n width =12n )n )n ),nn tabItem(tabName = "widgets",n fluidRow(n box(n title = "中國世界遺產名錄摘要",n h4("中國作為著名的文明古國,自1985年加入世界遺產公約,至2017年7月,共有52個項目被聯合國教科文組織列入《世界遺產名錄》,與義大利並列世界第一。其中世界文化遺產32處,世界自然遺產12處,世界文化和自然遺產4處,世界文化景觀遺產4處。源遠流長的歷史使中國繼承了一份十分寶貴的世界文化和自然遺產,它們是人類的共同瑰寶。正一藝術最後編輯於2017年7月9日。"),width =12n )n )n )nn )n )n)n

封裝Server

server <- shinyServer(function(input, output) { n output$plot1 <- renderPlot({n ggplot(mydata,aes(Time))+n geom_histogram(binh=30)+n geom_rug()+n scale_x_date(date_breaks="2 years",date_labels = "%Y")+n theme_void() %+replace%n theme(axis.text=element_text(),plot.margin = unit(c(1,1,1, 1), "lines"),axis.line=element_line())n })n output$plot2 <- renderPlot({n ggplot(class_count,aes(x=1,y=freq,fill=x))+n geom_col()+n geom_text(aes(x=1.6,y=label_y,label=paste(round(class_count$freq*100/sum(class_count$freq)),"%")))+n coord_polar(theta="y")+n scale_fill_brewer()+n guides(fill=guide_legend(title=NULL,reverse=T))+n labs(title="中國世界自然與文化遺產類別佔比")+n theme_void(base_size=15)%+replace%n theme(plot.margin = unit(c(1,1,1,1), "lines"))n })n output$plot3 <- renderPlot({n ggplot()+ n geom_polygon(data=china_map,aes(x=long,y=lat,group=group),col="grey60",fill="white",size=.2,alpha=.4)+n geom_point(data=mydata,aes(x=long,y=lat,shape=Class,fill=Class),size=3,colour="white")+ n coord_map("polyconic") +n scale_shape_manual(values=c(21,22,23,24))+n scale_fill_wsj()+n labs(title="中國世界自然文化遺產分布圖",caption="數據來源:中國世界遺產名錄")+ n theme_void(base_size=15) %+replace%n theme(n plot.title=element_text(size=25,hjust=0),n plot.caption=element_text(hjust=0), n legend.position = c(0.05,0.75),n plot.margin = unit(c(1,0,1,0), "cm")n )n })n output$plot4 <- renderLeaflet({n leaflet(china_map)%>%amap()%>%addPolygons(stroke = FALSE)%>%n addMarkers(data=mydata,lng=~long,lat=~lat,popup=~label)n })n})nshinyApp(ui, server)n

最終的web儀錶盤預覽效果:

在線課程請點擊文末閱讀原文:

數據源文件請移步本人GitHub:

github.com/ljtyduyu/Dat

Hellobi Live | 9月12日 R語言可視化在商務場景中的應用


推薦閱讀:

數據分析的5個坑,你踩過幾個?
巧用數據提升獲客與銷售轉化(附案例)
我們分析了12555份菜譜,發現中國人最愛吃這些菜
NBA球員進攻能力--簡單指標分析
pandas基本功能

TAG:R编程语言 | 数据分析 | 数据可视化 |