Shiny widget to change the order of elements in a vector

Question

On quite a few websites you have a drag and drop interface to change the order of elements in a list. I am looking for something similar in Shiny. I want the user to be able to drag and drop elements of a list to change the priority by changing the order.

Right now I have a solution that abuses selectizeInput(). This works, but it quickly becomes cumbersome when the list of choices becomes larger.

An illustration:

library(shiny)

shinyApp(
  ui = shinyUI({
    fluidPage(
      title = "Example for ordering objects",
      sidebarLayout(
        sidebarPanel(uiOutput("selection"),
                     actionButton('update',"Update")),
        mainPanel(
          helpText('The order of elements'),
          tableOutput('theorder')
        )
      )
    )
  }),
  server = function(input, output, session) {
    values <- reactiveValues(x = c('Item1','Item2','Item3'))

    output$selection <- renderUI({
      selectizeInput('neworder',
                     'Select new order',
                     choices = values$x,
                     multiple = TRUE)
    })

    output$theorder <- renderTable(
      values$x
    )

    observeEvent(input$update,{
      id <- values$x %in% input$neworder
      values$x <- c(input$neworder, values$x[!id])
    })
  }
)

Downside: To change the order at the end of the list, the user has to select the entire list in the correct order. One mistake and he has to start all over again.

Wishlist: a Shiny widget (possibly from another package), preferably drag and drop, that can make this kind of action more convenient.

Answer 1

You can use a custom input object to do this. There's a bunch of libraries to do this, here's an example with this one.

Here is the Shiny binding code in javascript that needs to be included in the www folder of your app:

sortableList.js

var sortableListBinding = new Shiny.InputBinding();
$.extend(sortableListBinding, {
  find: function(scope) {
    return $(scope).find(".sortableList");
  },
  getValue: function(el) {
    if (typeof Sortable.active != 'undefined'){
      return Sortable.active.toArray();
    }
    else return "";
  },
  subscribe: function(el, callback) {
    $(el).on("change.sortableListBinding", function(e) {
      callback();
    });
  },
  unsubscribe: function(el) {
    $(el).off(".sortableListBinding");
  },
  initialize: function(el) {
    Sortable.create(el,{
      onUpdate: function (evt) {
          $(el).trigger("change");
    }});
  }
});

Shiny.inputBindings.register(sortableListBinding);

It is very minimal, it creates the Sortable instance on initialisation and returns the order of the elements whenever the user changes them using the onUpdate event of the library.

Here's an example app with the R code to create the element:

app.R

library(shiny)
library(htmlwidgets)

sortableList <- function(inputId, value) {
  tagList(
    singleton(tags$head(tags$script(src="http://rubaxa.github.io/Sortable/Sortable.js"))),
    singleton(tags$head(tags$script(src = "sortableList.js"))),
    tags$div(id = inputId,class = "sortableList list-group",
             tagList(sapply(value,function(x){
               tags$div(class="list-group-item","data-id"=x,x)
             },simplify = F)))
  )
}

ui <- fluidPage(
  sortableList('sortable_list',c(2,3,4)),
  sortableList('sortable_list2',c(5,6,7)),
  textOutput('test'),
  textOutput('test2')
)

server <- function(input, output, session) 
{
 output$test <- renderText({input$sortable_list})
 output$test2 <- renderText({input$sortable_list2})
 }

shinyApp(ui=ui, server=server)

The sortableList function includes both the Sortable library and the sortableList.js with the Shiny binding code, and creates divs holding the values of the vector passed to value.

My app directory looks like:

<application-dir>
|-- www
    |-- sortableList.js
|-- app.R

And I use runApp("application-dir") to start the app.

Answer 2

For posterity's sake; this is now handled with the sortable package from Rstudio.