How to preserve the selection order of a pickerInput if multiple selections are allowed?

Question

Let's take my code as an example. If I use selectInput option where I can pick multiple choices, the first choice that I picked would be listed first, second choice would be listed second, etc.

However, if I use pickerInput option where I would pick multiple choices, no matter the order in which I pick the choice, whatever is listed first in the dropdown would be listed first instead. Is there a way for the pickerInput to emulate something similar to what selectInput does?

As an example, if I happened to pick Name 1 first and then Name 3 second, both selectInput and pickerInput would give me an output of Sunday;Tuesday.

However, if I pick Name 3 first and then Name 1 second, selectInput would give Tuesday;Sunday, but pickerInput would give Sunday;Tuesday.

How do I make sure pickerInput ordered the output similar to selectInput?

Code is below:

library(shiny)
library(shinydashboard)
library(shinyWidgets)

choices_df = data.frame(
  names = c('Name 1', 'Name 2', 'Name 3'),
  id = c("Sunday","Monday","Tuesday")#seq(3)
)

ui <- dashboardPage(
  header = dashboardHeader(),
  sidebar = dashboardSidebar(),
  body = dashboardBody(
    selectInput(
      "input",
      h5("The output should give the choice name instead of its value"),
      choices= setNames(choices_df$id,choices_df$names),
      multiple = TRUE
    ),
    textOutput("output"),
    pickerInput(
      "input2",
      h5("The output should give the choice name instead of its value"),
      choices= setNames(choices_df$id,choices_df$names),
      multiple = TRUE
    ),
    textOutput("output2")
  )
)

server <- function(input, output, session) {
  #output$output <- renderPrint({paste(choices_df$names[choices_df$id==input$input])})  
  output$output <- renderPrint({paste(input$input, collapse = ";")}) 
  output$output2 <- renderPrint({paste(input$input2, collapse = ";")})
}

shinyApp(ui = ui, server = server)

Answer 1

Do you need to do it with pickerInput? At the moment, it's not possible since pickerInput uses the bootstrap-select library which doesn't include that flexibility. See here.

One solution without pickerInput is to use the virtualSelectInput.

virtualSelectInput(
      "input2",
      h5("The output should give the choice name instead of its value"),
      choices = prepare_choices(choices_df, names, id),
      multiple = TRUE
    )

Answer 2

You could add the following JS in order to retain the selection order of a pickerInput() similar to the behaviour of a selectInput().

$(function(){
    $('#input2').on('change.bs.select loaded.bs.select',
        function(event) {
            $(this).find('option:selected').prependTo(this);
        });
});

library(shiny)
library(shinydashboard)
library(shinyWidgets)

js <- HTML(
    "
$(function(){
    $('#input2').on('change.bs.select loaded.bs.select',
        function(event) {
            $(this).find('option:selected').prependTo(this);
        });
});
"
)

choices_df = data.frame(
    names = c('Name 1', 'Name 2', 'Name 3'),
    id = c("Sunday", "Monday", "Tuesday")#seq(3)
)

ui <- dashboardPage(
    tags$head(tags$script(js)),
    header = dashboardHeader(),
    sidebar = dashboardSidebar(),
    body = dashboardBody(
        selectInput(
            "input",
            h5(
                "selectInput: The output should give the choice name instead of its value"
            ),
            choices = setNames(choices_df$id, choices_df$names),
            multiple = TRUE
        ),
        textOutput("output"),
        pickerInput(
            "input2",
            h5(
                "pickerInput: The output should give the choice name instead of its value"
            ),
            choices = setNames(choices_df$id, choices_df$names),
            multiple = TRUE
        ),
        textOutput("output2")
    )
)

server <- function(input, output, session) {
    #output$output <- renderPrint({paste(choices_df$names[choices_df$id==input$input])})
    output$output <-
        renderPrint({
            paste(input$input, collapse = ";")
        })
    output$output2 <-
        renderPrint({
            paste(input$input2, collapse = ";")
        })
}

shinyApp(ui = ui, server = server)