Shiny - Using package 'sortable' to return custom id

[jordanwebb10]

Happy Monday!

While using the package sortable, I need to return the order of the box 'id' instead of the 'Title' of the box. Secondly, as each box will be dynamically generated via insertUI and also have a component that will remove each box. I need to wrap each box in a tags$div(). However, when I include the div wrap I lose the ability to properly sort/drag and drop.

## Example shiny app with correct sorting. No Div tag around boxes. 

library(shiny)
library(tidyverse)
library(sortable)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    fluidPage(
      div(
        id = "sortable",
        box(id = "id1", title = "Test1",solidHeader = T, width = 12, actionButton('btntest1', "btn 1")),
        box(id = "id2", title = "Test2",solidHeader = T, width = 12, actionButton('btntest2', "btn 2")),
        box(id = "id3", title = "Test3",solidHeader = T, width = 12, actionButton('btntest2', "btn 3")),
        box(id = "id4", title = "Test4",solidHeader = T, width = 12, actionButton('btntest2', "btn 4"))
      ),
      verbatimTextOutput("chosen"),
      sortable_js(
        css_id = "sortable",
        options = sortable_options(
          onSort = sortable_js_capture_input(input_id = "selected"),
          onLoad = sortable_js_capture_input(input_id = "selected")
        )
      )
    )#fluidPage
  )
)


server <- function(input, output) {
  
  output$chosen <- renderPrint(str_split(input$selected, "\n",simplify = T)[,1])
  
}

shinyApp(ui, server)

## Example shiny app with div tag around box, sorting does not work. 

library(shiny)
library(tidyverse)
library(sortable)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    fluidPage(
      tags$div(id = "sortable",
        tags$div(id = "id", 
          box(title = "Test1",solidHeader = T, width = 12, actionButton('btntest1', "btn 1"))
        ),
        tags$div(id = "id", 
          box(title = "Test2",solidHeader = T, width = 12, actionButton('btntest2', "btn 2"))
        ),
        tags$div(id = "id", 
          box(title = "Test3",solidHeader = T, width = 12, actionButton('btntest3', "btn 3"))
        )
      ),
     
      verbatimTextOutput("chosen"),
      sortable_js(
        css_id = "sortable",
        options = sortable_options(
          onSort = sortable_js_capture_input(input_id = "selected"),
          onLoad = sortable_js_capture_input(input_id = "selected")
        )
      )
    )#fluidPage
  )
)


server <- function(input, output) {
  
  output$chosen <- renderPrint(str_split(input$selected, "\n",simplify = T)[,1])
  
  
}

shinyApp(ui, server)

[nirgrahamuk]

Here is a solution without knowing really anything about sortable...
I maintain a list of the id to title relationships. when I get the titles back, i look up the ids (using purrr package)

## Example shiny app with rank list

library(shiny)
library(tidyverse)
library(sortable)
library(shinydashboard)

mylookup <- list()
mylookup$Test1 <- "id1"
mylookup$Test2 <- "id2"
mylookup$Test3 <- "id3"
mylookup$Test4 <- "id4"

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    fluidPage(
      div(
        id = "sortable",
        box(id = "id1", title = "Test1",solidHeader = T, width = 12, actionButton('btntest1', "btn 1")),
        box(id = "id2", title = "Test2",solidHeader = T, width = 12, actionButton('btntest2', "btn 2")),
        box(id = "id3", title = "Test3",solidHeader = T, width = 12, actionButton('btntest2', "btn 3")),
        box(id = "id4", title = "Test4",solidHeader = T, width = 12, actionButton('btntest2', "btn 4"))
      ),
      verbatimTextOutput("chosen"),
      verbatimTextOutput("chosen2"),
      sortable_js(
        css_id = "sortable",
        options = sortable_options(
          onSort = sortable_js_capture_input(input_id = "selected"),
          onLoad = sortable_js_capture_input(input_id = "selected")
        )
      )
    )#fluidPage
  )
)


server <- function(input, output) {
  
  output$chosen <- renderPrint(str_split(input$selected, "\n",simplify = T)[,1])
  output$chosen2 <- renderPrint(purrr::map_chr(str_split(input$selected, "\n",simplify = T)[,1],
                                           ~mylookup[[.]]))
  
}

shinyApp(ui, server)

[jordanwebb10]

Nirgrahamuk, thank you for your answer. I had a similar idea. Please see my edited original post as I realized I have another need.

[nirgrahamuk]

you can give them unique id names, also the proper behaviour seems to need class adding to the div

tags$div(
        id = "sortable",
        div(
          id = "id1",
          class = "col-sm-12",
          box(title = "Test1", solidHeader = T, width = 12, actionButton("btntest1", "btn 1"))
        ),
        div(
          id = "id2",
          class = "col-sm-12",
          box(title = "Test2", solidHeader = T, width = 12, actionButton("btntest2", "btn 2"))
        ),
        div(
          id = "id3",
          class = "col-sm-12",
          box(title = "Test3", solidHeader = T, width = 12, actionButton("btntest3", "btn 3"))
        )
      )

[jordanwebb10]

nirgrahamuk - Thank you very much. I think this should work well. Id still love to be able to return the ID. directly. But I think this is a solid workaround. I'm going to let this sit for a day or so before I mark the answer.

Thank you again!