為什么用Shiny
Shiny讓數據分析師寫完分析與可視化代碼后，稍微再花幾十分鍾，就可以把分析代碼工程化，將分析成果快速轉化為交互式網頁分享給別人。所以，如果你是一名使用R的數據分析師，選擇Shiny是非常明智的，因為它不需要你有新的技能，且開發起來實在太快。它跟通常我們了解的其他框架不一樣：其他框架一般都是前后端分離，后端提供json，前端根據json繪圖繪表，需要若干個程序員協同開發完成。然而這種可視化的小工具往往是得不到研發資源的支持，只能本數據分析師一人操刀前后端全包。
#########################＃一個時間序列數據可視化栗子
#########################
library(shiny)
library(shinyjs)
library(DT)
library(dplyr)
library(tidyr)
library(stringr)
library(ggplot2)
library(scales)
library(plotly)
run.sql <- function(sql, debug=FALSE) { if(debug==FALSE){ df <- XXXXX # 自行定義函數，根據數據存儲位置，執行SQL語句 } else{ # 測試數據 group_id <- rep(1, nrow(economics)) dt <- paste(as.character(economics$date), "00:00:00") df <- cbind(group_id, dt, economics) } return(df) } ui <- fluidPage( useShinyjs(), titlePanel("時間序列數據可視化工具"), # 第一部分：SQL命令提交界面 div(id="download"， fluidRow( column(12, textOutput(outputId="download_info") ) ), fluidRow( column(12, HTML( paste('<textarea id="sql_cmd" rows="10", cols="180">', "select * from xxxx limit 1000;", '</textarea>') ) ) ), fluidRow( column(12, actionButton(inputId="refresh_button", label="加載數據", icon=icon("submit") ) ) ) ), shinyjs::hidden( div(id="table", # 第二部分：SQL命令執行結果顯示 hr(), dataTableOutput(outputId="sql_tab"), # 第三部分：可視化規則設置 hr(), textOutput(outputId="tab_button_message"), sidebarLayout( div(id="table_tool", sidebarPanel( selectInput(inputId="group_fields", label="繪圖分組字段", choices=NULL, selected=NULL, multiple=TRUE), selectInput(inputId="x_field", label="設置x軸字段，必須是日期時間", choices=NULL, selected=NULL, multiple=FALSE), selectInput(inputId="y_line_fields", label="設置y軸線圖字段", choices=NULL, selected=NULL, multiple=TRUE), selectInput(inputId="y_point_fields", label="設置y軸點圖字段", choices=NULL, selected=NULL, multiple=TRUE), selectInput(inputId="group_shape_field", label="設置點圖形狀字段", choices=NULL, selected=NULL, multiple=FALSE), actionButton(inputId="tab_button", label="顯示分組表格", icon=icon("submit")), width=3 ) ), div(id="group_content", mainPanel(dataTableOutput(outputId="group_tab"), width=9 ) ) ) ) ), # 第四部分：可視化圖形 shinyjs::hidden( div(id = "plot", hr(), plotlyOutput(outputId="case_viewer", height="600px") ) ) ) server <- function(input, output, session) { observe({ # 檢查SQL輸入框 if(is.null(input$sql_cmd) | input$sql_cmd == "") { shinyjs::disable("refresh_button") } else{ shinyjs::enable("refresh_button") } # 檢查可視化規則設置 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") } else { shinyjs::enable("tab_button") } }) # 執行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) updateSelectInput(session, inputId="group_fields", choices=colnames(res)) updateSelectInput(session, inputId="x_field", choices=colnames(res)) updateSelectInput(session, inputId="y_line_fields", choices=colnames(res)) updateSelectInput(session, inputId="y_point_fields", choices=colnames(res)) 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) }) # SQL命令執行狀態 output$download_info <- renderText({ if(input$refresh_button == 0){ message <- "請敲入SQL select查詢語句，點擊按鈕提交" } else{ message <- isolate({paste0("表格下載成功！總行數", nrow(sql_data()), "，總列數", ncol(sql_data()), "，更新時間是", as.character(lubridate::now(), format="%Y-%m-%d %H:%M:%S")) }) } message }) # 顯示SQL執行結果 output$sql_tab <- DT::renderDataTable({ datatable(sql_data(), filter='top', selection='single') }) # 獲取繪圖分組結果 group_data <- eventReactive(input$tab_button, { cat(file=stderr(), "#### event log ####: tab button clicked\n") res <- sql_data() %>% select(one_of(input$group_fields)) %>% distinct() shinyjs::show(id="group_content", anim=TRUE) return(res) }) output$tab_button_message <- renderText({ if(input$tab_button == 0) { message <- "請在下方左側設置數據可視化規則； 點擊按鈕后，下方右側將以表格顯示數據分組結果； 點擊表格的一行，將在下方繪制該行所指分組數據的圖形" } else { message <- isolate({paste0("繪圖分組數", nrow(group_data()), "，更新時間是", as.character(lubridate::now(), format="%Y-%m-%d %H:%M:%S")) }) } message }) # 顯示繪圖分組結果 output$group_tab <- DT::renderDataTable({ datatable(group_data(), filter='top', selection='single') }) # 顯示繪圖 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_row_last_clicked 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() %>% unite_("new_var", input$group_fields, remove=FALSE) %>% filter(new_var==filter_str) if(length(input$y_line_fields) > 0) { target_plot_data$dt <- lubridate::ymd_hms(target_plot_data[,input$x_field], tz="UTC-8") line_df <- target_plot_data %>% tidyr::gather(col_name, thresh, one_of(input$y_line_fields)) %>% dplyr::mutate(thresh=as.numeric(thresh)) p <- p + geom_line(data=line_df, aes(x=dt,y=thresh,color=col_name)) } if(length(input$y_point_fields) > 0) { target_plot_data$dt <- lubridate::ymd_hms(target_plot_data[,input$x_field], tz="UTC-8") point_df <- target_plot_data %>% tidyr::gather(col_name, thresh, one_of(input$y_point_fields)) %>% dplyr::mutate(thresh=as.numeric(thresh)) if(input$group_shape_field != "無") { 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)) } else{ p <- p + geom_point(data=point_df, aes(x=dt,y=thresh,color=col_name)) } } p <- p ggplotly(p) }) shinyjs::show("plot", anim = TRUE) }) } shinyApp(ui=ui, server=server)注：為了讓用戶明白工具的使用方法，代碼采用shinyjs在適當的時機隱藏/顯示對應的組件；在eventReactive事件驅動的計算中，需要保證至少一個依賴與該reactive的組件處於顯示狀態，否則無法觸發計算，observeEvent不存在此問題。