Shiny/Sortable - How to limit number of items that can be dropped?

[lorin]

Hi, I am using the sortable package and would like to place a limit on the number of items the user is allowed to drop into a container. This JS Fiddle example accomplishes exactly what I want to be able to do using javascript, but I can't find a way to apply it in R Shiny. Does anyone know how this could be accomplished? Thank you!

[barret]

This was a fun one. I learned that the group variable of a SortableJS object can be an object with more information in it... such as a put function which determines if objects may be placed.

Demo (gif):

App:

library(shiny)
library(sortable)

max_1_item_opts <- sortable_options(
  # inspiration from https://jsbin.com/nacoyah/edit?js,output
  # Sortable.create(qux, {
  #   group: {
  #     name: 'qux',
  #     put: function (to) {
  #       return to.el.children.length < 4;
  #     }
  #   },
  #   animation: 100
  # });

  # I have not seen a group value be done as an object before this post.
  # Glad to see `sortable` handle it!
  group = list(
    # use a group name to allow sharing between lists
    name = "my_shared_group",
    # add a `put` function that can determine if an element may be placed
    put = htmlwidgets::JS("
      function(to) {
        // only allow a 'put' if there is less than 1 child already
        return to.el.children.length < 1;
      }
    ")
  )
)

ui <- fluidPage(
  fluidRow(
    column(
      width = 3,
      tags$h2("Main list"),
      rank_list(
        # text = "Main List",
        labels = sample(paste0("list item ", 1:5)),
        input_id = "main_list",
        # be sure to have the same group name
        options = sortable_options(group = "my_shared_group")
      ),
    ),
    column(
      width = 12 - 3,
      tags$h2("1 item per list max!!!"),
      column(width = 12/3, # 1/3 of width available
        rank_list(
          # text = "List 1",
          labels = c(),
          input_id = "list_1",
          options = max_1_item_opts
        )
      ),
      column(width = 12/3,
        rank_list(
          # text = "List 2",
          labels = c(),
          input_id = "list_2",
          options = max_1_item_opts
        )
      ),
      column(width = 12/3,
        rank_list(
          # text = "List 3",
          labels = c(),
          input_id = "list_3",
          options = max_1_item_opts
        )
      )
    )
  ),
  # display answers
  tags$p("Answers"),
  "Main: ", verbatimTextOutput("result_main"),
  "1st: ", verbatimTextOutput("result_1"),
  "2nd: ", verbatimTextOutput("result_2"),
  "3rd: ", verbatimTextOutput("result_3")
)

server <- function(input, output) {
  output$result_main <- renderPrint({
    # This matches the input_id of each rank list
    input$main_list 
  })
  output$result_1 <- renderPrint({ input$list_1 })
  output$result_2 <- renderPrint({ input$list_2 })
  output$result_3 <- renderPrint({ input$list_3 })
}

shinyApp(ui, server)

I did not incorporate the CSS into app. Please look into using class argument for rank_list. For inspiration on how the css is currently defined, see sortable's compiled css.

---

Note: The JS fiddle provided used a jQuery sortable plugin. The R sortable package was built using SortableJS (which is independent of the jQuery sortable plugin)

[lorin]

Wow, this is amazing! I would have never guessed I could use a js function in a group. You are a life saver.