Track order of sortable menuSubItems in R shinydashboard

Question

. 。 Answers to this question are eligible for a +50 reputation bounty. code_cowboy wants to to this question: 50 points for an answer that works and is not overly complicated ：一个有效且不太复杂的答案得 50 分

I am able to render a sortable list of menuSubItems using this question, but I'd like to keep track of the order that they're in after being sorted. menuSubItem s don't show up in input on the server side (at least not the whole list), and I'd like to be able to have a way to access the order of the list of values in test_tabs without having to delve into creating custom input bindings in Shiny.

Any creative ideas would be appreciated!

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

# Define UI for shinydashboard
ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    sidebarMenu(
      menuItem("tab_one", tabName = "test_body"),
      menuItemOutput("test")
    )
  ),
  dashboardBody(
    tabItem("test_body", actionButton("click_me", "Click Me"))
  )
)

# Define server logic to dynamically create menuSubItems
server <- function(input, output) {
  observeEvent(input$click_me, {
    tabs_list <- lapply(1:5, function(x) {
      menuSubItem(text = paste("tab", x))
    })

    output$test <- renderMenu({
      menu <- menuItem("test_tabs", do.call(tagList, tabs_list))
      menu$children[[2]] <- tagAppendAttributes(menu$children[[2]], id = "test_tabs")
      tagAppendChildren(menu, sortable_js("test_tabs"))
    })
  })
}

# Run the application
shinyApp(ui = ui, server = server)

Answer 1

You can use an option from sortable_js to get an event when order changes and fire an event to notify shiny

server <- function(input, output) {
  observeEvent(input$click_me, {
    tabs_list <- lapply(1:5, function(x) {
      menuSubItem(text = paste("tab", x))
    })

    output$test <- renderMenu({
      menu <- menuItem("test_tabs", do.call(tagList, tabs_list))
      menu$children[[2]] <- tagAppendAttributes(menu$children[[2]], id = "test_tabs")

      # this javascript function will listen to onUpdate event fired by
      # sortable_js when reordering happened. From this event we get 'from'
      # that refers to the container whose items are reordered (our test_tab)
      # then it's content (items) as text (Maybe better to get items from DOM ...)
      # And finally send an event to shiny using Shiny.setInputValue
      update_notifier <- htmlwidgets::JS("function(evt) { Shiny.setInputValue('test_tabs_order',evt.from.innerText);}")

      # add an option to declare our update_notifier to the sortable menu
      tagAppendChildren(menu, sortable_js("test_tabs", options=sortable_options(onUpdate=update_notifier)))
    })

  })

  # listen to the event input fired by onUpdate listener above
  # we get a newline separated list of item text
  # after a bit of formatting we have now a vector of item text
  observeEvent(input$test_tabs_order, {
    ord <- input$test_tabs_order
    ord <- gsub("(^\\s*)|(\\s*$)","", ord) # trim
    ord <- unlist(strsplit(ord,"\\s*\n\\s*")) # split
    # ord is now a vector of reordered item text 
    message(paste(ord,collapse=","))
  })

Alternate method sending an array of item text

 update_notifier <- htmlwidgets::JS("function(evt) {
   var a=evt.from.children; 
   var b=[]; 
   for(idx=0;idx<a.length;idx++) {
     b[idx]=a[idx].innerText;
   };
   Shiny.setInputValue('test_tabs_order',b);
  }")