R Shiny中observeEvent配合actionButton时updateSelectizeInput不更新输入值

背景 #

需实现满足以下要求的Shiny输入组件：

• 支持用户输入，且可选选项来自服务端列表
• 可通过URL查询字符串控制输入值
• 空值代表选中全部选项
• 配合actionButton让用户完成全部选择后再触发高耗时计算

问题描述 #

通过observeEvent监听查询字符串变更，触发后调用updateSelectizeInput，但调用后立刻读取input$letters仍为旧值，仅前端展示更新成功。

示例代码 #

library(shiny)

possibleLetters = LETTERS[1:10]

ui <- fluidPage(
   
   sidebarLayout(
      sidebarPanel(
        selectizeInput(inputId='letters', 
                       label='Your letters:', 
                       choices=NULL,
                       selected=NULL, 
                       multiple=T, 
                       width='100%'),
        actionButton("recompute",
                     "Recompute now")
      ),
      
      mainPanel(
        h3("Letters: "),
        textOutput('lettersDisplay'),
        h3("Indices of letters: "),
        textOutput('lettersIndicesDisplay')
      )
   )
)

server <- function(input, output, session) {
   
  updateSelectizeInput(inputId='letters',
                       choices=c('',possibleLetters),
                       server=T)

  userLetters = eventReactive(input$recompute, ignoreNULL=FALSE, {
    if (length(input$letters) == 0) {
      return (possibleLetters)
    } else (
      return (input$letters)
    )
  })
  
  userLetterIndices = reactive({
    return(match(userLetters(),LETTERS))
  })
  
  queryStringObserver = observeEvent(session$clientData$url_search, {
    query <- parseQueryString(session$clientData$url_search)
    if (!is.null(query$letters)) {
      cat(file=stderr(), paste0('observeEvent running - user specified param is: ',query$letters,'\n'))
      updateSelectizeInput(session, 
                           inputId="letters",
                           choices = possibleLetters,
                           selected = query$letters,
                           server=T)
      cat(file=stderr(), paste0('observeEvent running - ran updateSelectizeInput, input$letters is now: ',input$letters,'\n'))
    }
  })
  
  
  output$lettersDisplay = renderText({
    return(paste(userLetters(),collapse=' '))
  })
  
  output$lettersIndicesDisplay = renderText({
    return(paste(userLetterIndices(), collapse=' '))
  })

}

shinyApp(ui = ui, server = server, options = list(port=1111))

复现步骤 #

启动应用后访问 http://localhost:1111/?letters=A，可观察到浏览器端selectize输入框已填入"A"，但input对应值未更新，控制台输出如下：

observeEvent running - user specified param is: A
observeEvent running - ran updateSelectizeInput, input$letters is now: 

原因解析 #

所有Shiny的update*系列输入更新函数都是异步执行的：调用该函数时，Shiny仅将更新指令加入待发送给前端的消息队列，不会立刻同步修改后端的input对象。当前observeEvent的执行周期内，读取input$xxx拿到的永远是本次响应式事件触发时的旧值。input值的更新需要等前端收到更新指令、修改组件状态、再把新值回传给后端后才会完成。
另外代码还存在两个可优化的问题：

1. 初始化调用updateSelectizeInput时缺少必填的session参数
2. URL参数触发更新时重复传入了choices和server=T参数，和初始化的选项配置冲突，会清空初始化时设置的空选项

修复方案 #

如果需要URL参数赋值后直接使用该值，可直接调用已经解析得到的query$letters，不需要等待input更新。如果需要URL参数生效后自动触发一次计算，可调用click()函数主动触发按钮的点击事件。修复后的完整代码如下：

library(shiny)
possibleLetters = LETTERS[1:10]
ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectizeInput(inputId='letters', 
                     label='Your letters:', 
                     choices=NULL,
                     selected=NULL, 
                     multiple=T, 
                     width='100%'),
      actionButton("recompute",
                   "Recompute now")
    ),
    mainPanel(
      h3("Letters: "),
      textOutput('lettersDisplay'),
      h3("Indices of letters: "),
      textOutput('lettersIndicesDisplay')
    )
  )
)
server <- function(input, output, session) {
  # 补全session参数
  updateSelectizeInput(session,
                       inputId='letters',
                       choices=c('', possibleLetters),
                       server=T)
  userLetters = eventReactive(input$recompute, ignoreNULL=FALSE, {
    if (length(input$letters) == 0) {
      return(possibleLetters)
    } else {
      return(input$letters)
    }
  })
  userLetterIndices = reactive({
    return(match(userLetters(), LETTERS))
  })
  queryStringObserver = observeEvent(session$clientData$url_search, {
    query <- parseQueryString(session$clientData$url_search)
    if (!is.null(query$letters)) {
      cat(file=stderr(), paste0('observeEvent running - user specified param is: ', query$letters, '\n'))
      # 去掉多余的choices和server参数，仅更新选中值
      updateSelectizeInput(session, 
                           inputId="letters",
                           selected = query$letters)
      # 主动触发计算，不需要用户手动点击按钮
      click("recompute")
      # 此处input$letters仍为旧值，属于正常现象，后续响应式更新会自动使用新值
      cat(file=stderr(), paste0('observeEvent running - ran updateSelectizeInput, current input$letters is still old value: ', input$letters, '\n'))
    }
  })
  output$lettersDisplay = renderText({
    return(paste(userLetters(), collapse=' '))
  })
  output$lettersIndicesDisplay = renderText({
    return(paste(userLetterIndices(), collapse=' '))
  })
}
shinyApp(ui = ui, server = server, options = list(port=1111))

内容的提问来源于stack exchange，提问作者ericminikel