A Visualization Panel with Shiny

本文介绍利用R语言中Shiny构建可视化面板，该可视化面板包含了以下三个部分：基于Leaflet的地图可视化、基于plotly的交互图形以及基于DT的交互式表格。效果见https://yuan1615.shinyapps.io/VSmap/。

• 地图可视化

通过指标数量筛选按钮及城市筛选按钮进行数据筛选，在地图上绘制气泡图，并建立鼠标悬停显示。

这里还可以将气泡图更换为热力图，详细操作可参见Leaflet。

• 交互图形

利用plotly构建交互式图形

• 交互式表格

利用DT构建交互式表格，可实现表格筛选、下载及搜索等功能

详细代码附上：

library(shiny)
library(tidyverse)
library(DT)
library(leaflet)
library(sp)
library(htmltools)
library(plotly)

load(file = "negative_comment.Rdata")

area_neg_comment <- negative_comment %>% group_by(city_name, grid_area_id) %>% 
    summarise(n_neg_comment=n()) %>% filter(grid_area_id != "(NULL)")

load(file = "short_time.Rdata")

area_short_time <- short_time %>% group_by(city_name, grid_area_id) %>% 
    summarise(n_short_time=n()) %>% filter(grid_area_id != "(NULL)")
area_short_time$grid_area_id <- as.character(area_short_time$grid_area_id)


load(file = "fail_lock.Rdata")

area_fail_lock <- fail_lock%>% group_by(city_name, grid_area_id) %>% 
    summarise(n_fail_lock=n()) %>%  filter(grid_area_id != "(NULL)")
area_fail_lock$grid_area_id <- as.character(area_fail_lock$grid_area_id)


lng_lat <- distinct(negative_comment[, c("grid_area_id", "grid_area_name",
                                         "control_person_name",
                                         "min_lng","max_lng",
                                         "min_lat","max_lat")])
lng_lat <- lng_lat[-which(lng_lat$min_lat=="(NULL)"),]
lng_lat$min_lng <- as.numeric(lng_lat$min_lng)
lng_lat$max_lng <- as.numeric(lng_lat$max_lng)
lng_lat$min_lat <- as.numeric(lng_lat$min_lat)
lng_lat$max_lat <- as.numeric(lng_lat$max_lat)

lng_lat <- lng_lat %>% 
    mutate(lat = (max_lng+min_lng)/2,
           lng = (min_lat+max_lat)/2) %>% 
    select(grid_area_id,grid_area_name,control_person_name,lat, lng)


map_data <- inner_join(lng_lat, area_neg_comment)
map_data <- inner_join(map_data, area_short_time)
map_data <- inner_join(map_data, area_fail_lock)

load(file = "manager.Rdata")

manager <- manager[, c("area_name","grid_number")]
colnames(manager) <- c("area_name","grid_area_id")

map_data <- left_join(map_data, manager)

# 脱敏处理
n = nrow(map_data)
map_data$grid_area_id <- as.character(sample(1:n, n))
map_data$grid_area_name <- substring(map_data$grid_area_name, 6, 20)
map_data$control_person_name <- paste(substring(map_data$control_person_name, 1, 1),
                                      "**",
                                      sep = "")
# map_data$n_neg_comment <- sample(map_data$n_neg_comment, n)
# map_data$n_short_time <- sample(map_data$n_short_time, n)
# map_data$n_fail_lock <- sample(map_data$n_fail_lock, n)

#----  城市中心经纬度 ----
city_lng_lat <- data.frame(city_name = c("Shang Hai", "Hang Zhou", "Nan Jing", 
                               "Zheng Zhou","Luo Yang","He Fei"),
                 lng = c(121.482265,120.204587,118.802997,113.665336,112.4508,117.229991),
                 lat = c(31.245198,30.253332,32.065876,34.751305,34.626878,31.828787))

##### 绘制综合地图 #####

addLabel <- function(data) {
    data$label <- paste0(
        '<b>', ifelse(is.na(data$`grid_area_id`), data$`grid_area_name`, data$`grid_area_name`), '</b><br>
    <table style="width:120px;">
    <tr><td>grid_ID:</td><td align="right">', data$grid_area_id, '</td></tr>
    <tr><td>manager:</td><td align="right">', data$control_person_name, '</td></tr>
    <tr><td>neg_comment:</td><td align="right">', data$n_neg_comment, '</td></tr>
    <tr><td>short_time:</td><td align="right">', data$n_short_time, '</td></tr>
    <tr><td>fail_lock:</td><td align="right">', data$n_fail_lock, '</td></tr>
    </table>'
    )
    data$label <- lapply(data$label, HTML)
    
    return(data)
}
zoomLevel <- 50 


ui <- fluidPage(
    # shinythemes::themeSelector(),  # <--- Add this somewhere in the UI
    # img(src = "ceshi.jpg", width = 1500, height = 100),
    headerPanel("VS MAP"),
    includeCSS("./www/main.css"),
    sidebarLayout(
        sidebarPanel(
            sliderInput("orderINput", "Order Number", 0, 100, c(0, 50), pre = ""),
            selectInput("typeInput", "City Name",
                        choices = c("Shang Hai", "Hang Zhou", "Nan Jing", 
                                    "Zheng Zhou","Luo Yang","He Fei"),
                        multiple = F,
                        selected = c("Shang Hai"))
        ),
        mainPanel(
            tabsetPanel(
                tabPanel("Map", leafletOutput("map")),
                tabPanel("Summary Plot",
                         plotlyOutput("SP")),
                tabPanel("Tabel Group By Area",
                         downloadButton("downloadData_daqu", "Download the Data"),
                         DT::dataTableOutput("results_daqu")),
                tabPanel("Details Tabel",
                         downloadButton("downloadData", "Download the Data"),
                         DT::dataTableOutput("results"))
            )
            
        )
    )
)

server <- function(input, output) {
  
    filtered <- reactive({
        map_data %>%
            filter(n_neg_comment >= input$orderINput[1],
                   n_short_time >= input$orderINput[1],
                   n_fail_lock >= input$orderINput[1],
                   city_name %in% input$typeInput
            )
        
    })
    
    filtered_daqu <- reactive({
      daqu <- map_data %>%
        filter(n_neg_comment >= input$orderINput[1],
               n_short_time >= input$orderINput[1],
               n_fail_lock >= input$orderINput[1],
               city_name %in% input$typeInput
        ) %>% group_by(city_name, area_name) %>% 
        summarise(n_neg_comment=sum(n_neg_comment),
                  n_short_time=sum(n_short_time),
                  n_fail_lock=sum(n_fail_lock))
      colnames(daqu) <- c("city","area","n_neg_comment",
                          "n_short_time","n_fail_lock")
      daqu
    })
    
    filtered_neg <- reactive({
        negative_comment %>%
            filter(
                   city_name %in% input$typeInput
            )
        
    })
    
    filtered_short <- reactive({
        short_time %>%
            filter(
                city_name %in% input$typeInput
            )
        
    })
    filtered_fail <- reactive({
        fail_lock %>%
            filter(
                city_name %in% input$typeInput
            )
        
    })
    
    output$results <- DT::renderDataTable({
        a <- filtered()[,c(1,2,3,6,7,8,9)]
        colnames(a) <- c("grid_id","grid_name","manager","city_name",
                         "n_neg_comment",
                         "n_short_time","n_fail_lock")
        a
    })
    
    
    output$downloadData <- downloadHandler(
        
        filename = function() {
            paste("data-", Sys.Date(), ".csv", sep="")
        },
        content = function(file) {
            write_csv(filtered(), file)
        }
    )
    
    output$results_daqu <- DT::renderDataTable({
      filtered_daqu()
    })
    
    output$downloadData_daqu <- downloadHandler(
      
      filename = function() {
        paste("data-", Sys.Date(), ".csv", sep="")
      },
      content = function(file) {
        write.csv(filtered_daqu(), file)
      }
    )
    
    output$results_bike1 <- DT::renderDataTable({
        filtered_neg()[, c(1,3,4,5,6,10,11,14)]
    })
    
    output$downloadData_bike1 <- downloadHandler(
        
        filename = function() {
            paste("data-", Sys.Date(), ".csv", sep="")
        },
        content = function(file) {
            write.csv(filtered_neg()[, c(1,3,4,5,6,10,11,14)], file)
        }
    )
    
    output$results_bike2 <- DT::renderDataTable({
        filtered_short()[, c(3,4,7,8,13)]
    })
    
    output$downloadData_bike2 <- downloadHandler(
        
        filename = function() {
            paste("data-", Sys.Date(), ".csv", sep="")
        },
        content = function(file) {
            write.csv(filtered_short()[, c(3,4,7,8,13)], file)
        }
    )
    
    output$results_bike3 <- DT::renderDataTable({
        filtered_fail()[, c(3,4,5,8,9,13)]
    })
    
    output$downloadData_bike3 <- downloadHandler(
        
        filename = function() {
            paste("data-", Sys.Date(), ".csv", sep="")
        },
        content = function(file) {
            write.csv(filtered_fail()[, c(3,4,5,8,9,13)], file)
        }
    )
    
    
    output$map <- renderLeaflet({
        a <- city_lng_lat %>% filter(city_name %in% input$typeInput)
        
      map <- leaflet(addLabel(filtered())) %>%
            setMaxBounds(-180, -90, 180, 90) %>%
            setView(a[1,2],a[1,3], zoom = 10) %>%
            addTiles() %>%
            addProviderTiles(providers$CartoDB.Positron, group = "Light") %>%
            addProviderTiles(providers$HERE.satelliteDay, group = "Satellite") %>%
            addLayersControl(
                baseGroups    = c("Light","Satellite"),
                overlayGroups = c("neg_comment", "short_time", "fail_lock")
            ) %>%
            hideGroup("short_time") %>%
            hideGroup("fail_lock") %>%
            addEasyButton(easyButton(
                icon    = "glyphicon glyphicon-globe", title = "Reset zoom",
                onClick = JS(paste("function(btn, map){ map.setView([",a[1,3],",",a[1,2],
                                   "], 10); }", sep = "")))) %>%
            addEasyButton(easyButton(
                icon    = "glyphicon glyphicon-map-marker", title = "Locate Me",
                onClick = JS("function(btn, map){ map.locate({setView: true, maxZoom: 6}); }")))%>%
            clearMarkers() %>%
            addCircleMarkers(
                lng          = ~lng,
                lat          = ~lat,
                radius       = ~(n_neg_comment-min(n_neg_comment))/(max(n_neg_comment)-min(n_neg_comment))*zoomLevel,
                stroke       = FALSE,
                fillOpacity  = 0.5,
                label        = ~label,
                labelOptions = labelOptions(textsize = 15),
                group        = "neg_comment"
            ) %>%
            addCircleMarkers(
                lng          = ~lng,
                lat          = ~lat,
                radius       = ~(n_short_time-min(n_short_time))/(max(n_short_time)-min(n_short_time))*zoomLevel,
                stroke       = FALSE,
                color        = "#00b3ff",
                fillOpacity  = 0.5,
                label        = ~label,
                labelOptions = labelOptions(textsize = 15),
                group        = "short_time"
            ) %>%
            addCircleMarkers(
                lng          = ~lng,
                lat          = ~lat,
                radius       = ~(n_fail_lock-min(n_fail_lock))/(max(n_fail_lock)-min(n_fail_lock))*zoomLevel,
                stroke       = FALSE,
                color        = "#005900",
                fillOpacity  = 0.5,
                label        = ~label,
                labelOptions = labelOptions(textsize = 15),
                group = "fail_lock"
            )
        map
    })
    
    
    filtered_all <- reactive({
      temp <- map_data %>%
        filter(n_neg_comment >= input$orderINput[1],
               n_short_time >= input$orderINput[1],
               n_fail_lock >= input$orderINput[1]
        ) %>% group_by(city_name) %>% 
        summarise(n_neg_comment=sum(n_neg_comment),
                  n_short_time=sum(n_short_time),
                  n_fail_lock=sum(n_fail_lock))
      
      colnames(temp) <- c("city","n_neg_comment",
                          "n_short_time","n_fail_lock")
      temp$city <- factor(temp$city, levels = temp$city[order(-temp$n_short_time)])
      
      temp
    })
    
    output$SP <- renderPlotly({
      
      fig <- plot_ly(filtered_all(), x = ~city, y = ~n_neg_comment, type = 'bar', name = 'neg comment')
      fig <- fig %>% add_trace(y = ~n_short_time, name = 'short time')
      fig <- fig %>% add_trace(y = ~n_fail_lock, name = 'fail lock')
      fig <- fig %>% layout(yaxis = list(title = 'Count'), barmode = 'group')
      
      fig
    })
    
}

shinyApp(ui = ui, server = server)