Shiny進階：Busy Button

背景

在一個Shiny App中，若是點擊一個按鈕，每每意味着一些R代碼會被執行。若是這段代碼執行時間很短，用戶體驗不會受到影響；若是這段代碼執行時間很長，界面上若是不提供給用戶一些即時的反饋，就會讓用戶感到困惑。

本文從Github上找到了做者daattali的一個做品，專門用來提高長時運算按鈕的點擊體驗。當點擊一個按鈕後，按鈕狀態轉爲disabled，同時顯示處於計算狀態；計算成功後，返回執行成功額標識；計算失敗時，返回具體的失敗信息。源代碼的連接請點這裏

本文對這段代碼進行詳細地解讀，須要讀者有必定的HTML和shinyjs基礎。

界面加強

withBusyIndicatorUI <- function(button) {
  id <- button[['attribs']][['id']]  # 使用str(actionButton("test", "test"))查看Button的結構，是一個長度爲3的list，其中一個元素是名爲attribs的list，裏面包含id、type和class屬性
  div(
    `data-for-btn` = id, # 爲div建立一個attribute，取值爲button id，這樣方便CSS Selector對其進行查詢
    button, # 等價於 <button id="test" type="button" class="btn btn-default action-button">test</button>
    span(
      class = "btn-loading-container",
      hidden(
        strong("loading...", class = "btn-loading-indicator"),,
        icon("check", class = "btn-done-indicator")
      )
    ), # 內聯元素，會跟在button的右側顯示，初始狀態爲隱藏，用於顯示正在執行和執行成功
    hidden(
      div(class = "btn-err",
          div(icon("exclamation-circle"),
              tags$b("Error: "),
              span(class = "btn-err-msg")
          )
      )
    ) # 塊級元素，會在button的下側顯示，初始狀態爲隱藏，用於顯示執行錯誤的消息
  )
}

後端處理

withBusyIndicatorServer <- function(buttonId, expr) {
  # UX stuff: show the "busy" message, hide the other messages, disable the button
  # 構造CSS選擇器，根據attribute定位按鈕，根據class獲取按鈕所處的狀態
  loadingEl <- sprintf("[data-for-btn=%s] .btn-loading-indicator", buttonId) 
  doneEl <- sprintf("[data-for-btn=%s] .btn-done-indicator", buttonId)
  errEl <- sprintf("[data-for-btn=%s] .btn-err", buttonId)
  # 使按鈕失效
  shinyjs::disable(buttonId)
  # 顯示正在執行部分
  shinyjs::show(selector = loadingEl)
  # 隱藏執行成功部分
  shinyjs::hide(selector = doneEl)
  # 隱藏執行失敗部分
  shinyjs::hide(selector = errEl)
  # 執行完成後須要調用的函數：使按鈕有效，隱藏正在執行部分
  on.exit({
    shinyjs::enable(buttonId)
    shinyjs::hide(selector = loadingEl)
  })
  
  # Try to run the code when the button is clicked and show an error message if
  # an error occurs or a success message if it completes
  tryCatch({
    # 執行按鈕點擊後的expr
    value <- expr
    # 顯示執行成功
    shinyjs::show(selector = doneEl)
    # 延時兩秒後，隱藏執行成功
    shinyjs::delay(2000, shinyjs::hide(selector = doneEl, anim = TRUE, animType = "fade",
                     time = 0.5))
    # 返回執行結果
    value
  }, error = function(err) { errorFunc(err, buttonId) })
}

errorFunc <- function(err, buttonId) {
  errEl <- sprintf("[data-for-btn=%s] .btn-err", buttonId)
  errElMsg <- sprintf("[data-for-btn=%s] .btn-err-msg", buttonId)
  errMessage <- err$message
  shinyjs::html(html = errMessage, selector = errElMsg)
  shinyjs::show(selector = errEl, anim = TRUE, animType = "fade")
}

Demo

library(shiny)
library(shinyjs)

ui <- fluidPage(
  useShinyjs(),
  tags$style(appCSS),
  selectInput("select", "Select an option",
              c("This one is okay" = "ok",
                "This will give an error" = "error")),
  
  # Wrap the button in the function `withBusyIndicatorUI()`
  withBusyIndicatorUI(
    actionButton(
      "uploadFilesBtn",
      "Process data",
      class = "btn-primary"
    )
  )
)

server <- function(input, output, session) {
  observeEvent(input$uploadFilesBtn, {
    # When the button is clicked, wrap the code in a call to `withBusyIndicatorServer()`
    withBusyIndicatorServer("uploadFilesBtn", {
      Sys.sleep(1)
      if (input$select == "error") {
        stop("choose another option")
      }
    })
  })
}

shinyApp(ui = ui, server = server)