使用updatePickerInput时，单选项类型无法显示选项的问题排查

我正在学习在Shiny中使用pickerInput，因此制作了这个应用。应用包含Fruit和Vegetable两个类别，Fruit对应Apple和Orange两个选项，Vegetable仅对应Carrot一个选项。我尝试使用updatePickerInput，在第一个选择框选中对应类型时更新第二个选择框的选项。

当选中Fruit时，第二个选择框能正常显示对应选项；但选中Vegetable时，无法显示Carrot选项。不确定哪里出错了，希望有人能指明方向。

原应用代码：

library(shiny, quietly = T)         # Dashboard Framework
library(bs4Dash, quietly = T)       # Style Extension
library(shinyWidgets, quietly = T)  # Widgets Extension
library(flexdashboard, quietly = T) # UI Elements
library(dplyr, quietly = T)

type <- c('Fruit','Fruit','Vegetable','Fruit','Vegetable')
meal <- c("Apple","Orange","Carrot","Apple","Carrot")
df.sample <- data.frame(type,meal,stringsAsFactors=FALSE)

picker_type<- pickerInput(
  inputId  = "picker_type",
  label    = NULL,
  choices  = sort(unique(df.sample$type)),
  selected = unique(df.sample$type),
  multiple = FALSE,
  options  = list(size = 10),
  width = "100%"
)

picker_meal <- pickerInput(
  inputId  = "picker_meal",
  label    = NULL,
  choices  = NULL,
  multiple = TRUE,
  options  = list(
    `actions-box` = TRUE,
    size = 10,
    `selected-text-format` = "count > 3"),
  width = "100%"
)

ui = bs4DashPage(

  header = bs4DashNavbar(
    skin = "secondary",
    status = "secondary",
    border = FALSE
  ),
  
  sidebar = bs4DashSidebar(
    skin = "dark",
    status = "secondary",
    elevation = 3,
    
    bs4SidebarMenu(
      bs4SidebarMenuItem(
        text = "Item",
        tabName = "item")
    )),
  
  bs4DashBody(
    
    bs4TabItems(
      
      bs4TabItem(
        tabName = "item",
    
        fluidRow(
          bs4InfoBox(title = h6("Type"),
                     width = 3,
                     elevation = 2,
                     color = "secondary",
                     fill = TRUE,
                     gradient = TRUE,
                     picker_type),
          bs4InfoBox(title = h6("Meal"),
                     width = 3,
                     elevation = 2,
                     color = "secondary",
                     fill = TRUE,
                     gradient = TRUE,
                     picker_meal)
        )
      )
    )
  )
)

# Server
server = function(session, input, output) {
  
  observe({
    print(input$picker_type)
    updatePickerInput(session = session, 
                      inputId = "picker_meal", 
                      label = NULL, 
                      choices = df.sample %>% 
                        filter(type == input$picker_type) %>%
                        select(meal) %>% 
                        unique())
  })
  
}

# Run the application 
shinyApp(ui = ui, server = server)

问题出在updatePickerInput的choices参数格式上：
当筛选Vegetable时，select(meal) %>% unique()返回的是单列数据框，而pickerInput的choices需要向量格式。多值场景下数据框会被隐式转成向量，所以Fruit能正常显示；单值场景下无法解析，导致选项不显示。

修正方法很简单，改用pull(meal)替代select(meal)，直接提取向量格式的结果：

server = function(session, input, output) {
  
  observe({
    print(input$picker_type)
    updatePickerInput(session = session, 
                      inputId = "picker_meal", 
                      label = NULL, 
                      choices = df.sample %>% 
                        filter(type == input$picker_type) %>%
                        pull(meal) %>%  # 提取向量
                        unique())
  })
  
}

也可以通过转换数据框为向量的方式修复：

choices = df.sample %>% 
  filter(type == input$picker_type) %>%
  select(meal) %>% 
  unique() %>%
  as.vector() %>%
  unname()

额外优化：初始化picker_meal时可设置choices = ""，避免初始状态下选择框完全空白。

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