htmljqueryrshinyshinyjs

How to get input values with list boxes?


I would like to use a two-sided multiselect box (also known as list boxes) in a shiny app. I found a jQuery mutliselect library that seems promising: https://crlcu.github.io/multiselect/#. I made a shiny app with this library.

It seems to be working well but the input is shown only when the items are selected in the right box. Ideally, I would like the items to be selected as soon as they are entered in the right box.

The jquery dependency can be found here: https://raw.githubusercontent.com/crlcu/multiselect/master/dist/js/multiselect.js

library(shiny)

# function for make UI HTML
MultiselectHTML <- function(mylist, myname) {
    paste_sum <- ""
    for (i in 1:length(mylist)) {
        paste_sum <- paste0(paste_sum, "<option value=", i, ">", mylist[i], "</option>")
    }
    
    # make tag list
    tagList(div(class = "item_search",
                div(
                    class = "row",
                    div(
                        class = "col-xs-5",
                        tags$select(
                            name = "from[]",
                            id = myname,
                            class = "form-control",
                            multiple = "multiple",
                            size = "8",
                            HTML(paste_sum)
                        )
                    ),
                    div(
                        class = "col-xs-2",
                        tags$button(
                            type = "button",
                            class = "btn btn-primary btn-block",
                            id = paste0(myname, "_undo"),
                            "undo"
                        ),
                        tags$button(
                            type = "button",
                            class = "btn btn-block",
                            id = paste0(myname, "_rightAll"),
                            tags$i(class = "glyphicon glyphicon-forward")
                        ),
                        tags$button(
                            type = "button",
                            class = "btn btn-block",
                            id = paste0(myname, "_rightSelected"),
                            tags$i(class = "glyphicon glyphicon-chevron-right")
                        ),
                        tags$button(
                            type = "button",
                            class = "btn btn-block",
                            id = paste0(myname, "_leftSelected"),
                            tags$i(class = "glyphicon glyphicon-chevron-left")
                        ),
                        tags$button(
                            type = "button",
                            class = "btn btn-block",
                            id = paste0(myname, "_leftAll"),
                            tags$i(class = "glyphicon glyphicon-backward")
                        ),
                        tags$button(
                            type = "button",
                            class = "btn btn-warning btn-block",
                            id = paste0(myname, "_redo"),
                            "redo"
                        )
                    ),
                    div(
                        class = "col-xs-5"
                        ,
                        tags$select(
                            name = "to[]",
                            id = paste0(myname, "_to"),
                            class = "form-control" ,
                            size = "8",
                            multiple = "multiple"
                        )
                    )
                )), 
            br())
}

ui <- fluidPage(
    tags$head(includeScript("www/multiselect.js")),
    tags$script(
        HTML(
            'jQuery(document).ready(function($) {
               $("#multiselect1").multiselect({
                 search: {
                 left: \'<input type="text" name="q" class="form-control" placeholder="Search..." />\',
                 right: \'<input type="text" name="q" class="form-control" placeholder="Search..." />\',
                 },
                 fireSearch: function(value) {
                   return value.length >= 1;
                 }
               });
             });
             '
        )
    ),
    MultiselectHTML(c("a", "b", "c", "d", "e"), "multiselect1"),
    uiOutput("mselect")
)

server <- function(input, output, session) {
    output$mselect <- renderUI({
        HTML(paste(
            "multiselect1:",
            paste(input$multiselect1, collapse = ", "),
            "<br>multiselect1_to:",
            paste(input$multiselect1_to, collapse = ", "),
            "<br>q:",
            paste(input$q, collapse = ", ")
        ))
    })
}

shinyApp(ui = ui, server = server)

Solution

  • For default selecting left options can simply add a selected attribute to your <option> when they are created i.e.

    for (i in 1:length(mylist)) {
        paste_sum <- paste0(paste_sum, "<option selected value=", i, ">", mylist[i], "</option>")
    }
    

    For default selecting right options once they are moved you can make a jquery edit to append the selected attribute to the moved option using:

    $("select option").each(function(){
            $(this).attr("selected","selected");
    });
    

    Your callback will need to have a new move to right functionality. Something like (taken from documentation here) :

    tags$script(
        HTML(
            'jQuery(document).ready(function($) {
                   $("#multiselect1").multiselect({
                     search: {
                     left: \'<input type="text" name="q" class="form-control" placeholder="Search..." />\',
                     right: \'<input type="text" name="q" class="form-control" placeholder="Search..." />\',
                     },
                     fireSearch: function(value) {
                       return value.length >= 1;
                     },
                     moveToRight: function(Multiselect, $options, event, silent, skipStack) {
                        var button = $(event.currentTarget).attr("id");
                        if (button == "multiselect1_rightSelected") {
                            var $left_options = Multiselect.$left.find("> option:selected");
                            Multiselect.$right.eq(0).append($left_options);
                            $("select option").each(function(){$(this).attr("selected","selected");})
                        if ( typeof Multiselect.callbacks.sort == "function" && !silent ) {
                            Multiselect.$right.eq(0).find("> option").sort(Multiselect.callbacks.sort).appendTo(Multiselect.$right.eq(0));
                            $("select option").each(function(){$(this).attr("selected","selected");})
                        }
                        } else if (button == "multiselect1_rightAll") {
                            var $left_options = Multiselect.$left.children(":visible");
                            Multiselect.$right.eq(0).append($left_options);
     
                            if ( typeof Multiselect.callbacks.sort == "function" && !silent ) {
                                Multiselect.$right.eq(0).find("> option").sort(Multiselect.callbacks.sort).appendTo(Multiselect.$right.eq(0));
                                $("select option").each(function(){$(this).attr("selected","selected");})
                                }
                        }
                        }
                    })
                 });
                 '
        )
    )