跟蹤 R shinydashboard 中可排序 menuSubItems 的順序

Question

賞金將在 6 天后到期。 此問題的答案有資格獲得+50聲望賞金。 code_cowboy想引起對這個問題的更多關注：一個有效且不太復雜的答案得 50 分

我可以使用這個問題呈現可排序的 menuSubItems 列表，但我想跟蹤它們在排序后的順序。 menuSubItem不會出現在服務器端的input中（至少不是整個列表），我希望能夠有一種方法來訪問test_tabs中值列表的順序，而無需深入研究在 Shiny 中創建自定義輸入綁定。

任何有創意的想法將不勝感激！

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

您可以使用 sortable_js 中的選項在訂單更改時獲取事件並觸發事件以通知 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=","))
  })

發送項目文本數組的替代方法

 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);
  }")