virtualSelectInput and updateVirtualSelect - selected arg not working for named lists

[WillPalmquist]

When initializing or updating a virtualSelectInput with multiple = TRUE, I am unable to pass a named list to the selected argument.

The choices argument works properly (initially and on update), but the input renders with no options selected (though I pass in the identical named list as the choices argument)

Here is my code, you can see I change the subset passed to choices to make sure it's updating. However, the input initializes with no options selected. I tried using named lists instead of vectors as well to no avail.

library(shiny)
library(shinyWidgets)
#library(shinyWidgets)

ui <- fluidPage(
  tags$h2("Virtual Select"),
  
  fluidRow(
    column(
      width = 4,
      virtualSelectInput(
        inputId = "single",
        label = "Single select :",
        choices = month.name,
        selected = month.name,
        multiple = T,
        search = T
      ),
      virtualSelectInput(
        inputId = "multiple",
        label = "Multiple select:",
        # choices = split(unname(setNames(month.abb, month.name)),names(setNames(month.abb, month.name)))[1:5],
        # selected = split(unname(setNames(month.abb, month.name)),names(setNames(month.abb, month.name)))[1:5],
        choices = setNames(month.abb, month.name),
        selected = setNames(month.abb, month.name),
        search = T,
        multiple = T
      )
    ),
    column(
      width = 4,
      tags$b("Single select :"),
      verbatimTextOutput("res_single"),
      tags$b("Is virtual select open ?"),
      verbatimTextOutput(outputId = "res_single_open"),
      
      tags$br(),
      
      tags$b("Multiple select :"),
      verbatimTextOutput("res_multiple"),
      tags$b("Is virtual select open ?"),
      verbatimTextOutput(outputId = "res_multiple_open")
    )
  )
  
  
)

server <- function(input, output, session) {
  
  updateVirtualSelect(
    inputId = "multiple",
    choices = setNames(month.abb, month.name)[1:8],
    selected = setNames(month.abb, month.name)[1:8],
  )
  output$res_single <- renderPrint(input$single)
  output$res_single_open <- renderPrint(input$single_open)
  
  output$res_multiple <- renderPrint(input$multiple)
  output$res_multiple_open <- renderPrint(input$multiple_open)
  
}

if (interactive())
  shinyApp(ui, server)

[WillPalmquist]

I managed to get it working with the modified code below. It only works if you unname() the "selected" argument. Running unname() works on both named and unnamed lists so should be an easy fix. Just submitted a pull request.

library(shiny)
library(shinyWidgets)
#library(shinyWidgets)

ui <- fluidPage(
  tags$h2("Virtual Select"),
  
  fluidRow(
    column(
      width = 4,
      virtualSelectInput(
        inputId = "single",
        label = "Single select :",
        choices = month.name,
        selected = month.name,
        search = T
      ),
      virtualSelectInput(
        inputId = "multiple",
        label = "Multiple select:",
        # choices = split(unname(setNames(month.abb, month.name)),names(setNames(month.abb, month.name)))[1:5],
        # selected = split(unname(setNames(month.abb, month.name)),names(setNames(month.abb, month.name)))[1:5],
        choices = setNames(month.abb, month.name),
        selected = unname(setNames(month.abb, month.name)),
        search = T,
        multiple = T
      )
    ),
    column(
      width = 4,
      tags$b("Single select :"),
      verbatimTextOutput("res_single"),
      tags$b("Is virtual select open ?"),
      verbatimTextOutput(outputId = "res_single_open"),
      
      tags$br(),
      
      tags$b("Multiple select :"),
      verbatimTextOutput("res_multiple"),
      tags$b("Is virtual select open ?"),
      verbatimTextOutput(outputId = "res_multiple_open")
    )
  )
  
  
)

server <- function(input, output, session) {
  
  updateVirtualSelect(
    inputId = "multiple",
    choices = setNames(month.abb, month.name)[1:8],
    selected = unname(setNames(month.abb, month.name)[1:8]),
  )
  output$res_single <- renderPrint(input$single)
  output$res_single_open <- renderPrint(input$single_open)
  
  output$res_multiple <- renderPrint(input$multiple)
  output$res_multiple_open <- renderPrint(input$multiple_open)
  
}

if (interactive())
  shinyApp(ui, server)