用R做一个灵活的时间序列数据可视化工具

  • A+

一、数据可视化的烦恼

数据分析师经常需要看数据。通常而言,数据或存放在MySQL数据库,或存放在Hadoop集群,或存放在阿里云的ODPS上。分析师根据业务需求写SQL语句从数据平台上提取出需要的数据,随后就面临着本文要重点讨论的怎么对数据可视化的难题。

用R做一个灵活的时间序列数据可视化工具

对于一个固定的需求,通常需要观察多组数据。普通一点的分析师,可能是拷贝出一组数据,贴到Excel里,绘个图看一下,然后拷贝下一组数据;高级一点的分析师,可能是用R写好一段代码,然后修改分组的变量取值重复运行代码来观察多组数据。我在工作中动辄需要观察一百组数据,上述两种方法仍然不够好用,最好的方法是我鼠标点击一百次,每点击一次产生一幅图。

更可恶的是,每来一个新需求,不论是Excel还是R都得根据新需求定制化一遍操作或一套代码。

于是某一天,我实在忍不了,就尝试做了一个工具,将SQL写完后的数据可视化工作给工程化了。

这个工具首先支持select查询语句,执行成功后会显示执行结果,同时提供一个设置面板,让用户选择数据分组字段、x轴字段、y轴字段,然后生成分组结果,每点击一个结果,生成该分组数据的图。目前该工具只支持时间序列数据,能够绘制点图和线图。

二、技术方案

Shiny:R的Web开发框架,让数据分析师能够将分析成果快速转化为交互式网页分享给别人。

它跟通常我们了解的其他框架不一样:其他框架一般都是前后端分离,后端提供json,前端根据json绘图绘表,需要若干个程序员协同开发完成。然而这种可视化的小工具往往是得不到研发资源的支持,只能本数据分析师一人操刀前后端全包。

当一个项目以数据计算和可视化为核心,只投入数据分析师一个人,要求快速实现效果,对执行效率和负载无要求,那么shiny无疑是一个非常诱人的方案。

三、代码

  1. #########################
  2. # 时间序列数据可视化工具
  3. # @author: shuiping.chen@alibaba-inc.com
  4. # @date: 2016-07-10
  5. #########################
  6. library(shiny)
  7. library(shinyjs)
  8. library(DT)
  9. library(dplyr)
  10. library(tidyr)
  11. library(stringr)
  12. library(ggplot2)
  13. library(scales)
  14. library(plotly)
  15. run.sql <- function(sql, debug=FALSE) {  if(debug==FALSE){
  16.     df <- XXXXX # 自行定义函数,根据数据存储位置,执行SQL语句
  17.   }  else{
  18.     # 测试数据    group_id <- rep(1, nrow(economics))    dt <- paste(as.character(economics$date), "00:00:00")    df <- cbind(group_id, dt, economics)
  19.   }  return(df)
  20. }ui <- fluidPage(  useShinyjs(),  titlePanel("时间序列数据可视化工具"),
  21.   # 第一部分:SQL命令提交界面  div(id="download",      fluidRow(        column(12,               textOutput(outputId="download_info")
  22.         )
  23.       ),      fluidRow(        column(12,
  24.                HTML(                 paste('<textarea id="sql_cmd" rows="10", cols="180">',
  25.                        "select * from xxxx limit 1000;",
  26.                        '</textarea>')
  27.                )
  28.         )
  29.       ),
  30.       fluidRow(
  31.         column(12,
  32.                actionButton(inputId="refresh_button", label="加载数据", icon=icon("submit")
  33.                )
  34.         )
  35.       )
  36.   ),
  37.   shinyjs::hidden(
  38.     div(id="table",
  39.         # 第二部分:SQL命令执行结果显示
  40.         hr(),
  41.         dataTableOutput(outputId="sql_tab"),
  42.         # 第三部分:可视化规则设置
  43.         hr(),
  44.         textOutput(outputId="tab_button_message"),
  45.         sidebarLayout(
  46.           div(id="table_tool",
  47.               sidebarPanel(
  48.                 selectInput(inputId="group_fields", label="绘图分组字段", choices=NULL, selected=NULL, multiple=TRUE),
  49.                 selectInput(inputId="x_field", label="设置x轴字段,必须是日期时间", choices=NULL, selected=NULL, multiple=FALSE),
  50.                 selectInput(inputId="y_line_fields", label="设置y轴线图字段", choices=NULL, selected=NULL, multiple=TRUE),
  51.                 selectInput(inputId="y_point_fields", label="设置y轴点图字段", choices=NULL, selected=NULL, multiple=TRUE),
  52.                 selectInput(inputId="group_shape_field", label="设置点图形状字段", choices=NULL, selected=NULL, multiple=FALSE),
  53.                 actionButton(inputId="tab_button", label="显示分组表格", icon=icon("submit")),
  54.                 width=3
  55.               )
  56.           ),
  57.           div(id="group_content",
  58.               mainPanel(dataTableOutput(outputId="group_tab"),
  59.                         width=9
  60.               )
  61.           )
  62.         )
  63.         )
  64.   ),
  65.   # 第四部分:可视化图形
  66.   shinyjs::hidden(
  67.     div(id = "plot",
  68.         hr(),
  69.         plotlyOutput(outputId="case_viewer", height="600px")
  70.     )
  71.   )
  72.   )
  73. server <- function(input, output, session) {  observe({
  74.     # 检查SQL输入框    if(is.null(input$sql_cmd) | input$sql_cmd == "") {      shinyjs::disable("refresh_button")
  75.     }    else{      shinyjs::enable("refresh_button")
  76.     }
  77.     # 检查可视化规则设置    if (input$x_field == "" | (is.null(input$y_line_fields) & is.null(input$y_point_fields)) | is.null(input$group_fields)) {      shinyjs::disable("tab_button")
  78.     } else {      shinyjs::enable("tab_button")
  79.     }
  80.   })
  81.   # 执行SQL命令获取数据  sql_data <- eventReactive(input$refresh_button, {    cat(file=stderr(), "#### event log ####: refresh button clicked\n")    shinyjs::disable("refresh_button")    shinyjs::hide(id = "table", anim = TRUE)    shinyjs::hide(id = "plot", anim = TRUE)    res <- run.sql(input$sql_cmd, debug=TRUE)
  82.     updateSelectInput(session, inputId="group_fields", choices=colnames(res))
  83.     updateSelectInput(session, inputId="x_field", choices=colnames(res))
  84.     updateSelectInput(session, inputId="y_line_fields", choices=colnames(res))
  85.     updateSelectInput(session, inputId="y_point_fields", choices=colnames(res))
  86.     updateSelectInput(session, inputId="group_shape_field", choices=c("无",colnames(res)), selected="无")    shinyjs::enable("refresh_button")    shinyjs::show(id = "table", anim = TRUE)    shinyjs::hide(id = "group_content", anim = FALSE)    return(res)
  87.   })
  88.   # SQL命令执行状态  output$download_info <- renderText({    if(input$refresh_button == 0){      message <- "请敲入SQL select查询语句,点击按钮提交"
  89.     }    else{      message <- isolate({paste0("表格下载成功!总行数",  nrow(sql_data()), ",总列数", ncol(sql_data()), ",更新时间是", as.character(lubridate::now(), format="%Y-%m-%d %H:%M:%S"))
  90.       })
  91.     }    message
  92.   })
  93.   # 显示SQL执行结果  output$sql_tab <- DT::renderDataTable({    datatable(sql_data(), filter='top', selection='single')
  94.   })
  95.   # 获取绘图分组结果  group_data <- eventReactive(input$tab_button, {    cat(file=stderr(), "#### event log ####: tab button clicked\n")    res <- sql_data() %>%
  96.       select(one_of(input$group_fields)) %>%
  97.       distinct()
  98.     shinyjs::show(id="group_content", anim=TRUE)
  99.     return(res)
  100.   })
  101.   output$tab_button_message <- renderText({    if(input$tab_button == 0) {      message <- "请在下方左侧设置数据可视化规则;
  102.                  点击按钮后,下方右侧将以表格显示数据分组结果;
  103.                点击表格的一行,将在下方绘制该行所指分组数据的图形"
  104.     }    else {      message <- isolate({paste0("绘图分组数",  nrow(group_data()), ",更新时间是", as.character(lubridate::now(), format="%Y-%m-%d %H:%M:%S"))
  105.       })
  106.     }    message
  107.   })
  108.   # 显示绘图分组结果  output$group_tab <- DT::renderDataTable({    datatable(group_data(), filter='top', selection='single')
  109.   })
  110.   # 显示绘图  observeEvent(input$group_tab_rows_selected, {    cat(file=stderr(), paste0("#### event log ####: group table row ", input$group_tab_rows_selected, " clicked\n"))    output$case_viewer <- renderPlotly({      s <- input$group_tab_rows_selected
  111.       cat(file=stderr(), "#### event log ####: table row", s, "clicked\n")      p <- ggplot()      filter_str <- isolate({str_c(group_data()[s, input$group_fields], collapse="_")}) # 使用_以配合unite方法      target_plot_data <- sql_data() %>%
  112.         unite_("new_var", input$group_fields, remove=FALSE) %>%
  113.         filter(new_var==filter_str)
  114.       if(length(input$y_line_fields) > 0) {
  115.         target_plot_data$dt <- lubridate::ymd_hms(target_plot_data[,input$x_field], tz="UTC-8")        line_df <- target_plot_data %>%
  116.           tidyr::gather(col_name, thresh, one_of(input$y_line_fields)) %>%
  117.           dplyr::mutate(thresh=as.numeric(thresh))
  118.         p <- p + geom_line(data=line_df, aes(x=dt,y=thresh,color=col_name))
  119.       }      if(length(input$y_point_fields) > 0) {
  120.         target_plot_data$dt <- lubridate::ymd_hms(target_plot_data[,input$x_field], tz="UTC-8")        point_df <- target_plot_data %>%
  121.           tidyr::gather(col_name, thresh, one_of(input$y_point_fields)) %>%
  122.           dplyr::mutate(thresh=as.numeric(thresh))
  123.         if(input$group_shape_field != "无") {
  124.           point_df[, input$group_shape_field] <- as.factor(point_df[, input$group_shape_field])          p <- p + geom_point(data=point_df, aes_string(x="dt",y="thresh",color="col_name", shape=input$group_shape_field))
  125.         }        else{          p <- p + geom_point(data=point_df, aes(x=dt,y=thresh,color=col_name))
  126.         }
  127.       }      p <- p
  128.       ggplotly(p)
  129.     })    shinyjs::show("plot", anim = TRUE)
  130.   })
  131. }shinyApp(ui=ui, server=server)

注:为了让用户明白工具的使用方法,代码采用shinyjs在适当的时机隐藏/显示对应的组件;在eventReactive事件驱动的计算中,需要保证至少一个依赖与该reactive的组件处于显示状态,否则无法触发计算,observeEvent不存在此问题。

作者:丹追兵

来源:SegmentFault

R语言实战(中文完整版)
MySQL必知必会
中国大数据生态图谱&大数据交易市场专题研究报告
误差分位数的默示有效估计与\ 自回归时间序列的预测区间

发表评论

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen: