Shiny中updatePickerInput选择首个选项时失效问题求助

开发具备CRUD功能的Shiny应用表单时，发现使用updatePickerInput函数选择首个选项无法正常工作。已制作可复现示例：两个应用仅selected_var的取值不同，选择第二个选项时功能正常，选择首个选项则失效。

复现步骤 #

• 在下拉菜单中选择「Asset Type #1」
• 点击「Update selected option」按钮
• 预期结果：第一个示例选中「Asset Type #2」，第二个示例选中「Asset Type #1」；实际仅第二个选项的更新正常，首个选项无响应

正常工作的示例 #

library(shiny)
library(shinyWidgets)

ui <- fluidPage(
  uiOutput("pickerInput"),
  actionButton(inputId = "update_button", label = "Update selected option")
)

server <- function(input, output, session) {
  options_tbl <- structure(
    list(
      transportasset_id = c(
        "a40cf288-d3c0-11ed-8b73-2e080658eb35", 
        "b48abb72-d3c0-11ed-8b73-2e080658eb35"
      ), 
      transportasset_name = c(
        "Asset Type #1 ", 
        "Asset Type #2"
      )
    ), 
    row.names = c(NA, -2L), 
    class = c("tbl_df", "tbl", "data.frame")
  )
  var_options <- setNames(options_tbl$transportasset_id, options_tbl$transportasset_name)

  output$pickerInput <- renderUI(
    pickerInput(inputId = "my_picker", label = "Select an option:",
                choices = var_options, 
                selected = NULL, 
                options = pickerOptions(
                  liveSearch = TRUE, 
                  noneSelectedText = "No commodity selected", 
                  size = "auto", 
                  title = "Select commodity"
                )
    )
  )  
  
  observeEvent(input$update_button, {
    selected_var <- options_tbl %>% 
      filter(transportasset_id == "b48abb72-d3c0-11ed-8b73-2e080658eb35") %>% 
      pull(transportasset_id)

    updatePickerInput(session, "my_picker", selected = selected_var)
  })
}

shinyApp(ui = ui, server = server)

无法正常工作的示例 #

library(shiny)
library(shinyWidgets)

ui <- fluidPage(
  uiOutput("pickerInput"),
  actionButton(inputId = "update_button", label = "Update selected option")
)

server <- function(input, output, session) {
  options_tbl <- structure(
    list(
      transportasset_id = c(
        "a40cf288-d3c0-11ed-8b73-2e080658eb35", 
        "b48abb72-d3c0-11ed-8b73-2e080658eb35"
      ), 
      transportasset_name = c(
        "Asset Type #1 ", 
        "Asset Type #2"
      )
    ), 
    row.names = c(NA, -2L), 
    class = c("tbl_df", "tbl", "data.frame")
  )
  var_options <- setNames(options_tbl$transportasset_id, options_tbl$transportasset_name)

  output$pickerInput <- renderUI(
    pickerInput(inputId = "my_picker", label = "Select an option:",
                choices = var_options, 
                selected = NULL, 
                options = pickerOptions(
                  liveSearch = TRUE, 
                  noneSelectedText = "No commodity selected", 
                  size = "auto", 
                  title = "Select commodity"
                )
    )
  )  
  
  observeEvent(input$update_button, {
    selected_var <- options_tbl %>% 
      filter(transportasset_id == "a40cf288-d3c0-11ed-8b73-2e080658eb35") %>% 
      pull(transportasset_id)

    updatePickerInput(session, "my_picker", selected = selected_var)
  })
}

shinyApp(ui = ui, server = server)

解决思路 #

1. 强制重新传递选项列表 #

当updatePickerInput仅更新selected参数时，若目标值与当前选中值一致，Shiny可能会忽略此次更新。可在更新时重新传递choices参数，强制组件刷新状态：

updatePickerInput(session, "my_picker", choices = var_options, selected = selected_var)

2. 清理选项名称中的多余空格 #

观察到首个选项的名称"Asset Type #1 "末尾带有空格，这可能导致前端组件在匹配选项时出现异常。使用stringr::str_trim清理空格后重新生成选项列表：

library(stringr)

options_tbl$transportasset_name <- str_trim(options_tbl$transportasset_name)
var_options <- setNames(options_tbl$transportasset_id, options_tbl$transportasset_name)

3. 避免动态生成pickerInput #

通过renderUI动态生成的输入组件可能存在状态同步问题，可直接在UI中定义pickerInput，再在server中初始化选项：

# UI部分修改
ui <- fluidPage(
  pickerInput(inputId = "my_picker", label = "Select an option:",
              choices = NULL, 
              selected = NULL, 
              options = pickerOptions(
                liveSearch = TRUE, 
                noneSelectedText = "No commodity selected", 
                size = "auto", 
                title = "Select commodity"
              )
  ),
  actionButton(inputId = "update_button", label = "Update selected option")
)

# Server部分添加初始化逻辑
server <- function(input, output, session) {
  # ... 其他代码 ...
  observe({
    updatePickerInput(session, "my_picker", choices = var_options)
  })
  # ... 其他代码 ...
}

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