架构师的修炼机器学习小组大数据

基于R shinydashboard的道路交通可视化案例

2017-07-22  本文已影响816人  真依然很拉风

作品概述

这个作品刚刚获得“中国电科杯”城市数据创新大赛的城市交通专项奖,现在作为案例分享出来供同行交流讨论。虚的就不说了,此文只讨论技术。

先上图:

实时道路交通可视化 实时道路拥堵排名 历史路况时间序列图 每日每小时道况热力图 每小时内道况南丁格尔玫瑰图 每小时内总体路况圆盘图 各道路每日拥堵时长排名 实时路况数据下载

这个作品的构建过程与设计工具如下:

shiny与shinydashboard的特点

shinyRstudio出品的一个可以在R中构建交互式网页的引擎,shinydashboard则是基于shiny提供的一套快速搭建dashboard的工具。

先谈谈shiny的优缺点:

所用工具包

再谈谈R中所用的包,主要分类两类:数据处理和可视化。
数据处理包:

可视化包:

构建shinydashboard

一个shiny程序基本包含两部分:ui.Rserver.R。其中ui.R主要用来设计限定网页结构,比如每一行是什么图形或内容,尺寸大小如何设定,文字怎么插入,控件的位置和编号等等——基本上可以概括为:一切关于外在结构而不涉及内在计算的都在ui.R中设计。反之,server.R就主要用来做数据处理、计算和可视化,并把结果映射至ui.R中,所以它才是核心,代码也长得多。

本作品的ui.R核心代码如下:

dashboardPage(
  dashboardHeader(title = "深圳道路的数据画像",titleWidth = 220),
  dashboardSidebar(
    sidebarMenu(
    menuItem(iconv("实时路况展示",to="UTF-8"), tabName = "realtime_traffic", icon = icon("road")),
    radioButtons(inputId = "choose_direction", label = "请选择一个方向:",selected=1,choiceNames=c("1(东->西 或 北->南)","2(西->东 或 南->北)"),choiceValues=1:2),
    radioButtons(inputId = "rank_class", label = "请选择道路排名类别:",selected="拥堵排名",choices=c("拥堵排名","通畅排名")),
    numericInput(inputId = "rank_num",label = "请输入道路交通排名数量:",min = 5,max = 100,step = 1,value=20),
    menuItem(iconv("道路画像分析",to="UTF-8"), icon = icon("area-chart"), tabName = "statistics"),
    selectInput(inputId = "choose_road",label = "请选择一条道路:",choices = all_roads),
    radioButtons(inputId = "choose_direction2", label = "请选择一个方向:",selected=1,choiceNames=c("1(东->西 或 北->南)","2(西->东 或 南->北)"),choiceValues=1:2),
    menuItem(iconv("历史路况回顾",to="UTF-8"), icon = icon("calendar"), tabName = "history"),
    dateInput(inputId = "choose_date", label = "请选择4月的一天:",value = "2017-04-01",min = "2017-04-01",max = "2017-04-30"),
    radioButtons(inputId = "choose_direction3", label = "请选择一个方向:",selected="东->西",choices=c("东->西","西->东","北->南","南->北")),
    radioButtons(inputId = "rank_class2", label = "请选择道路排名类别:",selected="拥堵排名",choices=c("拥堵排名","通畅排名")),
    numericInput(inputId = "rank_num2",label = "请输入道路交通排名数量:",min = 5,max = 100,step = 1,value=20),
    menuItem(iconv("实时数据下载",to="UTF-8"),tabName = "data_download",icon = icon("database"))
 ),width = 220),
  dashboardBody(
    tags$head(
      tags$link(rel = "stylesheet", type = "text/css", href = "custom.css")),
    tabItems(
      tabItem("realtime_traffic",
              fluidRow(
                box(ggiraphOutput("map"),width = 12,solidHeader = T,collapsible = T)
              ),
              fluidRow(
                box(ggiraphOutput("rank1"),width = 6,solidHeader = T,collapsible = T),
                box(ggiraphOutput("rank2"),width = 6,solidHeader = T,collapsible = T)
              ),
              fluidRow(
                box(ggiraphOutput("rank3"),width = 6,solidHeader = T,collapsible = T),
                box(ggiraphOutput("rank4"),width = 6,solidHeader = T,collapsible = T)
              )
      ),
      tabItem("statistics",
              fluidRow(
                box(dygraphOutput("ts_history"),width = 12,solidHeader = T,collapsible = T)
                ),
              fluidRow(
                box(ggiraphOutput("heat"),width = 12,solidHeader = T,collapsible = T)
              ),
              fluidRow(
                box(ggiraphOutput("polar_weekdays"),width = 6,solidHeader = T,collapsible = T),
                box(ggiraphOutput("polar_holidays"),width = 6,solidHeader = T,collapsible = T)
              )
              ),
      tabItem("history",
              # fluidRow(
              #   box(img(src="https://ss1.bdstatic.com/70cFvXSh_Q1YnxGkpoWK1HF6hhy/it/u=3245526806,2208748886&fm=21&gp=0.jpg"),width = 12,solidHeader = T)
              # )),
              fluidRow(
                box(ggiraphOutput("history_bars"),width = 12,solidHeader = T,collapsible = T)
              ),
              fluidRow(
                box(ggiraphOutput("day_rank"),width = 12,solidHeader = T,collapsible = T)
              )),
      tabItem("data_download",
              fluidRow(
              box(
                dataTableOutput("rawdata"),width = 12
              )
              ),
              fluidRow(
                p("数据来源:",strong(a("深圳市交通运输委员会",href="http://sztocc.sztb.gov.cn/roadcongmore.aspx")))
              ),
              downloadButton("downloadCsv", "下载实时数据")
              )
      )
      ))

这些代码基本是在模板的基础上改,menuItem()是左侧sidebar里的一个子页面,tabName是这个页面的名称,它来指定后来的各个布局元素存放在哪个页面里。radioButtons是单选框,numericInput是数字输入框,dateInput是日期选择框,这些控件都有唯一一个id来标识,以input$id来取它们的值传输至server.R中。

在dashboardBody中,每个tabItem代表一个子页面,这跟前面的tabName一一对应;里面的fluidRow表示一行,box是基本的容器,可以放图形或其他输出内容(也可以不加box,不过这样没法设定宽度),每个box的宽度最大为12,同一行的多个box可以各自设定总和为12的宽度(这一点比flexdashboard自由)。

注意到代码里的box的内容基本都有OutPut后缀(如ggiraphOutput、dataTableOutput、dygraphOutput等),这是那些包提供的shiny接口函数——换句话说如果一个包里有这种类似于以Output的shiny接口函数,它产出的内容才能放在shiny中,否则不行(这一点限制比不上flexdashboard)。

shinydashboard默认的风格很丑,好在它支持CSS,tag$head(tag$link())就可以引进CSS,不过这个CSS必须放在项目路径下的www文件夹中。CSS正常地写就好,如果遇到失效的,可能是优先级的问题,就多加点前缀。鉴于CSS是前端领域的知识,本文不多说。

加载包与读取数据都可以放在shinyServer()外面执行。关于数据,要分为两种:一种是固定不变的,这种按照常规的数据赋值方法即可;另一种是随着用户的交互而动态改变的,这种要加个reactive()函数,比如:

traffic_choosen = reactive(traffic[traffic$direction_id == input$choose_direction, 1: 7])
roads_map < - reactive({
    roads_map < - join(roads, traffic_choosen(), type="inner")
    roads_map
})

这里的traffic_choosen和roads_map都是根据用户在名为direction_id的控件中的选择值筛选的子集,所以它是动态可变的,都加了一个reactive();不过要注意加了reactive()后,traffic_choosen和roads_map就不是一个变量,而是一个函数,如果要调用这个动态变量值,就必须要加括号。

后面就是给ui.R中的框架填充内容,一般都是以output$id来指定。

output$ts_history <- renderDygraph({
  df1 <- (traffic_history %>% filter(road == input$choose_road & direction_id==1))[,c("time","index")]
  df2 <- (traffic_history %>% filter(road == input$choose_road & direction_id==2))[,c("time","index")]
  df <- full_join(df1,df2,by="time")
  df <- df[!duplicated(df$time),]
  rownames(df) <- df$time
  df$time <- NULL
  colnames(df) <- c("方向1","方向2")
  dygraph(df,main = paste(input$choose_road,"4月内历史交通指数",sep="")) %>% 
    dyOptions(colors=c("orange","steelblue"),axisLineColor = "#FEFEFE",drawGrid = F) %>%
    dyLegend(show="onmouseover",labelsSeparateLines = T) %>%
    dyRangeSelector() %>% 
     dyUnzoom()
})

比如这段代码就指定了一个id为ts_history的用dygraph包画的时间序列交互图,而在ui.R中要与其呼应:

box(dygraphOutput("ts_history"), width=12, solidHeader=T, collapsible=T)

注意到画图语句外层都有一个render为前缀的函数(renderDygraph、renderggiraph、renderDataTable),同样这也是shiny接口的标志,必须以这个函数转换之后才能在shiny中传输。

server.R中也可以捕获用户的在图形中的交互行为,联想到ggiraph交互图形中总有一个参数是data_id,之前以为填什么不重要,但是在这里起作用了——用户在某处点击一下,便捕获到该处的data_id值。

selected_road <- reactive({
if( is.null(input$map_selected)){
  NA
} else input$map_selected
})

这段代码的含义就是:如果用户没有选中某条道路,select_road就是NA;反之就是用户选中的那条道路。

通过响应捕捉,可以进一步强化交互性。

主要图形解析

下面开始对前面的几张图的设计思路与处理方法做个简单的介绍。

实时道路交通可视化

这个图最为复杂,它首先以深圳地图为底图,然后再叠加路径图。这个路径图是100+条道路的经纬度坐标画成的。而这些道路的经纬度坐标获取难度就比较大:首先在百度地图上查询道路起点和终点的坐标,然后调用百度地图API,输入起点和终点的坐标,查询驾车路线,会返回一串散点的坐标,在ggplot2中把这些散点连接成path就可以把道路可视化出来;不过这些点的坐标有可能不准,所以还需要人工校对。这些路径的颜色映射的是rvest采集的该道路实时的交通指数——由于交委网站上在任一时刻并不总是会有全量的数据,因此本图中只展示有数据的道路的交通状况。从这张图中可以一眼看出整个深圳市总体的道路状况,一眼可看出哪条道路最堵。

实时道路排名

这个比较简单,根据用户选择的排名种类和排名数据对实时数据进行筛选、排序,以条形图的方式展现即可。

历史路况时间序列图

这个时间序列图把一条道路一个月内每5分钟的交通指数都可视化出来了。这个图形很神奇,横轴纵轴都可以缩放选择,下方有缩略图。

每日每小时道况热力图

这个热力图放在大屏上就像一座墙,倒还是挺壮观的。这是一个30*24的热力图,每一块映射每小时内的平均交通指数,用以呈现周期性规律。

每小时内道况南丁格尔玫瑰图

这里分为工作日和节假日来呈现某条道路24小时内的总体交通状况,其中每一片花瓣映射着各种交通状况的比例。

每小时内总体路况圆盘图

这张图以每天为单位,汇总全部条道路的交通指数,用以研究每日全市总体的交通周期性规律。

各道路每日拥堵时长排名

原本以5min为间隔采集的数据都是离散的,无法计算连续时长。这里借鉴了微积分的思想,以每一个5min内的最终状态作为5min内的持续状态,于是多个5min累加来代表一天中的拥堵时长。

实时路况数据下载

这个就是展示一下实时数据并提供下载,如果你不会爬虫,可以在这上面来下载数据。

Shiny中的坑

所以shiny终究只能产出一个原型,它离真正企业级的数据可视化系统差距还是不小。因此,如果是专门做数据可视化的,前端是必须要前进的方向。

上一篇下一篇

猜你喜欢

热点阅读