在ShinyDashboard中的menuSubItems之間切換

Question

我正在嘗試使用Shinydashboard設置一個閃亮的應用程序，並且在大多數情況下，祝您好運。 但是，我遇到了一個帶有邊欄行為的怪癖，我認為這是可以避免的，但尚未找到方法。

以下是一個重現我所遇到的問題的小示例。 基本上，有兩個側邊欄菜單-菜單一和菜單二，每個都有兩個menuSubItems。 在菜單項中切換子項可以正常工作。 因此，如果我想從subItemOne切換到subItemTwo，沒有問題。 我可以整天做。

我還可以跨菜單切換到subItems，這樣就可以從subItemOne跳轉到subItemThree。 問題出在試圖切換回來。 如果選擇了subItemOne，而我嘗試轉到subItemThree，然后返回到subItemOne，則無法執行此操作。 我必須轉到subItemTwo，然后才能打開SubItemOne。

有沒有一種方法可以糾正此設置，以便我可以直接從subItemOne跳到subItemThree（或兩個和四個）然后再次返回？

library('shiny')
library('shinydashboard')
# Sidebar #############################
sidebar <- dashboardSidebar(
  width = 290,

  sidebarMenu(
    menuItem('Menu One', tabName = 'menuOne', icon = icon('line-chart'), 
        collapsible = 
            menuSubItem('Sub-Item One', tabName = 'subItemOne'),
            menuSubItem('Sub-Item Two', tabName = 'subItemTwo')
            )
  ),

  sidebarMenu(
    menuItem('Menu Two', tabName = 'menuTwo', icon = icon('users'), 
             collapsible = 
               menuSubItem('Sub-Item Three', tabName = 'subItemThree'),
             menuSubItem('Sub-Item Four', tabName = 'subItemFour')
    )
  )

)
# Body #############################
body <- dashboardBody(

  tabItems(
    tabItem(tabName = 'subItemOne',
            h2('Selected Sub-Item One')
    ),
    tabItem(tabName = 'subItemTwo',
            h2('Selected Sub-Item Two')
    ),
    tabItem(tabName = 'subItemThree',
            h2('Selected Sub-Item Three')
    ),
    tabItem(tabName = 'subItemFour',
            h2('Selected Sub-Item Four')
    )
  )
)
# UI #############################
ui <- dashboardPage(
  dashboardHeader(title = 'Test', titleWidth = 290),
  sidebar,
  body
)
# Server #############################
server <- function(input, output){

}

shinyApp(ui, server)

Answer 1

問題在於選項卡項保持活動狀態，並且單擊活動的選項卡項不會更新UI。 這可以用一些Javascript來解決。

library('shiny')
library('shinydashboard')
# Sidebar #############################
sidebar <- dashboardSidebar(
  tags$head(
    tags$script(
      HTML(
        "
        $(document).ready(function(){
          // Bind classes to menu items, easiet to fill in manually
          var ids = ['subItemOne','subItemTwo','subItemThree','subItemFour'];
          for(i=0; i<ids.length; i++){
            $('a[data-value='+ids[i]+']').addClass('my_subitem_class');
          }

          // Register click handeler
          $('.my_subitem_class').on('click',function(){
            // Unactive menuSubItems
            $('.my_subitem_class').parent().removeClass('active');
          })
        })
        "
      )
    )
  ),
  width = 290,

  sidebarMenu(
    menuItem('Menu One', tabName = 'menuOne', icon = icon('line-chart'),
             collapsible = 
               menuSubItem('Sub-Item One', tabName = 'subItemOne'),
             menuSubItem('Sub-Item Two', tabName = 'subItemTwo')
    )
  ),

  sidebarMenu(
    menuItem('Menu Two', tabName = 'menuTwo', icon = icon('users'), 
             collapsible = 
               menuSubItem('Sub-Item Three', tabName = 'subItemThree'),
             menuSubItem('Sub-Item Four', tabName = 'subItemFour')
    )
  )

)
# Body #############################
body <- dashboardBody(

  tabItems(
    tabItem(tabName = 'subItemOne',
            h2('Selected Sub-Item One')
    ),
    tabItem(tabName = 'subItemTwo',
            h2('Selected Sub-Item Two')
    ),
    tabItem(tabName = 'subItemThree',
            h2('Selected Sub-Item Three')
    ),
    tabItem(tabName = 'subItemFour',
            h2('Selected Sub-Item Four')
    )
  )
)
# UI #############################
ui <- dashboardPage(
  dashboardHeader(title = 'Test', titleWidth = 290),
  sidebar,
  body
)
# Server #############################
server <- function(input, output){

}

shinyApp(ui, server)