Adding to a sortable bucketlist
The {sortable} package
{sortable} is an incredibly useful R package built upon the sortbale.js javascript library, allowing drag-and-drop features to be incorporated into shiny apps. The package works with two types of sortable lists:
- rank list: items can be sorted within a list
- bucket list: a single object containing multiple rank lists, allowing for drag-and-drop between lists.
The second option (bucket list) is useful when a user wishes to divide a set of values between two or more buckets. {sortable} integrates well within shiny but requires a few tweaks if data are added to the sortable object once it has been created.
{sortable} includes a function, update_bucket_list() which is used to update header text but not list items.
Case One. Dragging Existing Values Between Lists
Here's a simple scenario. Suppose you have a list of objects in list 1 and you wish to subset to list 2, returning the values in list 2. Using {sortable} you could define a bucket list containing two rank lists (list 1 and list 2), populate list 1 and drag-and-drop values to list 2. In a shiny app this could be coded as follows:
1library(shiny)
2library(sortable)
3
4ui <- fluidPage(
5 uiOutput("ui_sort"),
6 verbatimTextOutput("txt_output")
7)
8
9server <- function(input, output, session) {
10
11 output$ui_sort <- renderUI({
12
13 ## create styled list 1
14 list_1_tags <- lapply(LETTERS[1:5], function(x) {
15 tags$span(id = paste0('lab_', x), x, class = "label label-primary", `data-rank-id` = x)
16 })
17
18 ## create styled list 2
19 list_2_tags <- lapply(LETTERS[6:8], function(x) {
20 tags$span(id = paste0('lab_', x), x, class = "label label-primary", `data-rank-id` = x)
21 })
22
23 ## sortbale bucket list
24 sortable::bucket_list(
25 header = "Move values from list 1 to list 2",
26 group_name = "reorder_list",
27 sortable::add_rank_list(
28 input_id = "reorder_list_1",
29 text = "list 1",
30 labels = list_1_tags
31 ),
32 sortable::add_rank_list(
33 input_id = "reorder_list_2",
34 text = "list 2",
35 labels = list_2_tags
36 ))
37 })
38
39 output$txt_output <- renderPrint({
40 print(input$reorder_list)
41 })
42
43}
44
45shinyApp(ui, server)
In this example, every time list 1 or list 2 changes, input$reorder_list updates with the ordered values for each list.
Case Two. Adding a New Value to an Existing List
Updating the code above with an actionButton linked to insertUI allows us to add a new option to list 2 when the button is pressed. This approach works but you'll see that it does not update input$reorder_list until the list is updated (by moving an item).
1library(shiny)
2library(sortable)
3
4ui <- fluidPage(
5 uiOutput("ui_sort"),
6 actionButton("but_add", "Add"),
7 verbatimTextOutput("txt_output")
8)
9
10server <- function(input, output, session) {
11
12 output$ui_sort <- renderUI({
13
14 ## create styled list 1
15 list_1_tags <- lapply(LETTERS[1:5], function(x) {
16 tags$span(id = paste0('lab_', x), x, class = "label label-primary", `data-rank-id` = x)
17 })
18
19 ## create styled list 2
20 list_2_tags <- lapply(LETTERS[6:8], function(x) {
21 tags$span(id = paste0('lab_', x), x, class = "label label-primary", `data-rank-id` = x)
22 })
23
24 ## sortbale bucket list
25 sortable::bucket_list(
26 header = "Move values from list 1 to list 2",
27 group_name = "reorder_list",
28 sortable::add_rank_list(
29 input_id = "reorder_list_1",
30 text = "list 1",
31 labels = list_1_tags
32 ),
33 sortable::add_rank_list(
34 input_id = "reorder_list_2",
35 css_id = "css_reorder_list_2",
36 text = "list 2",
37 labels = list_2_tags
38 ))
39 })
40
41 observeEvent(input$but_add, {
42 ## insert a new value into list 2
43 val <- "ZZ"
44 new_tag <- tags$div(class = "rank-list-item", draggable = FALSE,
45 tags$span(id = paste0('lab_', val), val, class = "label label-primary", `data-rank-id` = val)
46 )
47 insertUI(selector = "#css_reorder_list_2", where = "beforeEnd", ui = new_tag, immediate = TRUE)
48 })
49
50 output$txt_output <- renderPrint({
51 print(input$reorder_list)
52 })
53
54}
55
56shinyApp(ui, server)
In order to make this approach work we can manage the ordered list, list 2 through a shiny input, input$sort_list_2. This shiny variable is kept up to date through two methods:
sortable::sortable_options()updates input$sort_list_2 when list 2 is first initialized, a new item is dragged from list 1 or the order is changed.- When the new item is added, a javascript function is executed, updating input$sort_list_2 with the newly ordered list. The javascript function works but identifying the identifer of the list and looping through its members, populating input$sort_list_2.
1library(shiny)
2library(sortable)
3
4ui <- fluidPage(
5
6 tagList(
7 tags$head(tags$script(src = "script.js")),
8 uiOutput("ui_sort"),
9 actionButton("but_add", "Add"),
10 verbatimTextOutput("txt_output")
11 )
12
13)
14
15l1 <- LETTERS[1:5]
16l2 <- LETTERS[6:8]
17
18server <- function(input, output, session) {
19
20 output$ui_sort <- renderUI({
21
22 list_1_tags <- lapply(l1, function(x) {
23 tags$span(id = paste0('lab_', x), x, class = "label label-primary", `data-rank-id` = x)
24 })
25
26 list_2_tags <- lapply(l2, function(x) {
27 tags$span(id = paste0('lab_', x), x, class = "label label-primary", `data-rank-id` = x)
28 })
29
30 sortable::bucket_list(
31 header = "Reorder values in 'ordered values' column",
32 group_name = "reorder_list",
33 sortable::add_rank_list(
34 input_id = "reorder_list_1",
35 text = "list 1",
36 labels = list_1_tags
37 ),
38 sortable::add_rank_list(
39 input_id = "reorder_list_2",
40 css_id = "css_reorder_list_2",
41 text = "list 2",
42 labels = list_2_tags,
43 options = sortable_options(
44 onSort = sortable_js_capture_input("sort_list_2"),
45 onLoad = sortable_js_capture_input("sort_list_2"))
46 ))
47 })
48
49 observeEvent(input$but_add, {
50 print("adding ZZ")
51 val <- "ZZ"
52 new_tag <- tags$div(class = "rank-list-item", draggable = FALSE,
53 tags$span(id = paste0('lab_', val), val, class = "label label-primary", `data-rank-id` = val)
54 )
55 insertUI(selector = "#css_reorder_list_2", where = "beforeEnd", ui = new_tag, immediate = TRUE)
56 session$sendCustomMessage('update_sortable', list(id = "css_reorder_list_2", shinyinput = "sort_list_2"))
57 })
58
59 output$txt_output <- renderPrint({
60 print(input$sort_list_2)
61 })
62
63}
64
65shinyApp(ui, server)
1Shiny.addCustomMessageHandler('update_sortable', function(x) {
2 if (typeof Shiny !== 'undefined') {
3 el = document.getElementById(x.id);
4 shinyinputname = x.shinyinput + ':sortablejs.rank_list'
5 Shiny.setInputValue(shinyinputname, $.map(el.children, function(child) {
6 return $(child).attr('data-rank-id') || $.trim(child.innerText);
7 }))
8 }
9})
Conclusion
The code above demonstrates a suitable approach to add items to a sortable bucket list in a shiny app. The concept can be extended to work with multiple lists, returning the content of each.