专栏首页数据小魔方shiny动态仪表盘应用——中国世界自然文化遗产可视化案例

shiny动态仪表盘应用——中国世界自然文化遗产可视化案例

这一篇很早就想写了,一直拖到现在都没写完。

虽然最近的社交网络上娱乐新闻热点特别多,想用来做可视化分析的素材简直多到不可想象,但是我个人一向不追星,对明星热文和娱乐类的新闻兴趣不是很大。还是更愿意把自己的精力贡献在那些不起眼的,然而却更能触动我们心灵与文化内涵的素材上来。

今天要写的主题中国的世界遗产名录,我将使用简单的网络数据抓取,多角度呈现我国当前已经拥有的世界遗产名录数目、类别、地域分布、详情介绍等。

http://www.zyzw.com/twzs010.htm

library("rvest")
library("stringr")
library("xlsx")

首先要确定好要爬取的目标信息。我感兴趣的是世界遗产的名称、申请成功的时间、分布的省份、遗产的性质、简介、详情页网址、预览图片地址。然后分析页面信息与后台代码,准备进入爬取阶段。

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

其他信息过于杂乱,抓取清洗非常耗时,索性手动在Excel里面清洗了。

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

世界遗产申请年份频率统计:

mydata<-read.xlsx("./data/yichan.xlsx",sheetName="Sheet1",header=T,encoding='UTF-8',stringsAsFactors=FALSE,check.names=FALSE)

mydata$Time<-ymd(mydata$Time)
ggplot(mydata,aes(Time))+
geom_histogram(binh=30)+
geom_rug()+
scale_x_date(date_breaks="2 years",date_labels = "%Y")+
theme_void() %+replace%
theme(
     axis.text=element_text(),
     plot.margin = unit(c(1,1,1, 1), "lines"),
     axis.line=element_line()
   )

世界遗产类别统计:

class_count<-plyr::count(mydata$Class)
class_count<-arrange(class_count,freq)
class_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)
ggplot(class_count,aes(x=1,y=freq,fill=x))+
geom_col()+
geom_text(aes(x=1.6,y=label_y,label=paste(round(class_count$freq*100/sum(class_count$freq)),"%")))+
coord_polar(theta="y")+
scale_fill_brewer()+
guides(fill=guide_legend(title=NULL,reverse=T))+
labs(title="中国世界自然与文化遗产类别占比")+
theme_void(base_size=15)%+replace%
theme(plot.margin = unit(c(1,1,1, 1), "lines"))

世界自然文化遗产地域分布:

china_map <- readOGR("D:/R/rstudy/CHN_adm/bou2_4p.shp",stringsAsFactors=FALSE)       
ggplot()+ 
geom_polygon(data=china_map,aes(x=long,y=lat,group=group),col="grey60",fill="white",size=.2,alpha=.4)+
geom_point(data=mydata,aes(x=long,y=lat,shape=Class,fill=Class),size=3,colour="white")+ 
     coord_map("polyconic") +
     scale_shape_manual(values=c(21,22,23,24))+
     scale_fill_wsj()+
     labs(title="中国世界自然文化遗产分布图",caption="数据来源:中国世界遗产名录")+   
     theme_void(base_size=15) %+replace%
     theme(
          plot.title=element_text(size=25,hjust=0),
          plot.caption=element_text(hjust=0),       
          legend.position = c(0.05,0.75),
          plot.margin = unit(c(1,0,1,0), "cm")
          )

基于leaflet动态可视交互的世界自然文化遗产地理分布图

for(i in 1:nrow(mydata)){
     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/>"),
     mydata$link[i],mydata$Name[i],mydata$Class[i],mydata$Information[i],mydata$img_link[i])
}
leaflet(china_map)%>%amap()%>%addPolygons(stroke = FALSE)%>%
addMarkers(data=mydata,lng=~long,lat=~lat,popup=~label)

leaflet动态效果请点击这里:

http://rpubs.com/ljtyduyu/311149

视频内容

接下来把以上所有代码封装成一个shinyAPP。

封装UI:

####封装UI:
ui <- dashboardPage(
  dashboardHeader(title = "中国世界遗产名录可视化"),
  dashboardSidebar(
    sidebarMenu(
      menuItem("申请时间与类型分布",     tabName = "dashboard1", icon = icon("dashboard")),
      menuItem("中国世界遗产地域分布",   tabName = "dashboard2", icon = icon("dashboard")),
      menuItem("中国世界遗产分布详情",   tabName = "dashboard3", icon = icon("dashboard")),
      menuItem("中国世界遗产名录摘要",   tabName = "widgets", icon = icon("th"))
    )
  ),

  dashboardBody(
    tabItems(

      tabItem(tabName = "dashboard1",
        fluidRow(
          box(
              title = "申请时间分布",
              plotOutput("plot1", height = 500)
          ),
          box(
              title = "世界遗产类别分布",
              plotOutput("plot2", height = 500)
          )
        )
      ),

      tabItem(tabName = "dashboard2",
      fluidRow(
          box(
              title = "中国世界遗产地域分布",
              plotOutput("plot3", width=1000, height=800),
              width =10
          )
        )
      ),

      tabItem(tabName = "dashboard3",
      fluidRow(
          box(
              title = "中国世界遗产分布详情",
              leafletOutput("plot4", width = "100%", height = 1000),
              width =12
          )
        )
      ),

      tabItem(tabName = "widgets",
      fluidRow(
          box(
              title = "中国世界遗产名录摘要",
              h4("中国作为著名的文明古国,自1985年加入世界遗产公约,至2017年7月,共有52个项目被联合国教科文组织列入《世界遗产名录》,与意大利并列世界第一。其中世界文化遗产32处,世界自然遗产12处,世界文化和自然遗产4处,世界文化景观遗产4处。源远流长的历史使中国继承了一份十分宝贵的世界文化和自然遗产,它们是人类的共同瑰宝。正一艺术最后编辑于2017年7月9日。"),width =12
          )
        )
      )

    )
  )
)

封装Server

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

最终的web仪表盘预览效果:

数据源文件请移步本人GitHub:

https://github.com/ljtyduyu/DataWarehouse/tree/master/File

本文分享自微信公众号 - 数据小魔方(datamofang),作者:杜雨

原文出处及转载信息见文内详细说明,如有侵权,请联系 yunjia_community@tencent.com 删除。

原始发表时间:2017-09-25

本文参与腾讯云自媒体分享计划,欢迎正在阅读的你也加入,一起分享。

我来说两句

0 条评论
登录 后参与评论

相关文章

  • 超强脑洞第三弹之——ggplot构造瀑布图

    对,就是瀑布图,你没看错。而且是使用ggplot现有图层叠加构造,并没有用任何ggplot的外挂插件。 作图理念是在数据源的构造上,方法与《Excel图表之道》...

    数据小磨坊
  • 带实际执行进度的甘特图

    今天要跟大家分享的图标是带实际执行进度的甘特图! ▽▼▽ 由于本图所用到的技巧和思路特别复杂,过程相对繁琐,所以本案例的介绍会省略掉很多细节性的步骤,否则图文会...

    数据小磨坊
  • 左手用R右手Python系列8——数据去重与缺失值处理

    因为最近事情略多,最近更新的不勤了,但是学习的脚步不能停,一旦停下来,有些路就白走了,今天就盘点一下R语言和Python中常用于处理重复值、缺失值的函数。 在R...

    数据小磨坊
  • istio-2:istio1.4.2-demo部署与体验,聊聊一些个人看法

    b.本文主要以《深入浅出Istio:Service Mesh快速入门与实践》中的python-flask-demo为例论述。

    Criss@陈磊
  • istio-2:istio1.4.2-demo部署与体验,聊聊一些个人看法

    b.本文主要以《深入浅出Istio:Service Mesh快速入门与实践》中的python-flask-demo为例论述。

    千里行走
  • 从事嵌入式开发,C语言学算法要学到很高深吗?

    懂得嵌入式开发,必须要精通C语言算法 从事嵌入式软件开发多年,嵌入式开发未来前景也非常广阔,消费类电子产品大部分都属于嵌入式开发系列,嵌入式软件开发从开发角度分...

    程序员互动联盟
  • 跟我学Spring Cloud(Finchley版)-04-服务注册与服务发现-原理剖析

    地址硬编码问题——电影微服务中将用户微服务的地址写死,如果用户微服务地址发生变化,难道要重新上线电影微服务吗?

    用户1516716
  • R语言逻辑斯蒂回归小实例

    Logistic regression, also called a logit model, is used to model dichotomous out...

    用户7010445
  • 基于Python遗传算法的人工神经网络优化

    人工神经网络(ANN)是一种简单的全连接神经网络,其通过前向传播来进行参数计算,使用后向传播进行参数权重更新。一般我们会采用随机梯度下降来更新权重,但今天我们换...

    深度学习与Python
  • 用Python实现科研自动化

    这个学期如期开课了,虽然是在家里。这学期我导开了一门《高等教育管理专题研究》,一口气给了11个专题。为了对这11个专题的文献分布情况有一个粗略的印象,我觉得都得...

    公众号机器学习与生成对抗网络

扫码关注云+社区

领取腾讯云代金券