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, # 等价于 test
    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)