光沢のあるサブメニュー項目を手作業で調整する

Question

光沢のあるダッシュボードでサイドバーのサブメニューを手動で展開しようとしています。 updateTabItems関数を使用すると、タブに移動できますが、メニューは展開されません。

質問に対する再現性の高い回答を探しています：how to manually expand a submenu in a shiny dashboard side bar これは素晴らしい実例と回答がありますが実装されていません。

Answer 1

ここにはreferred answerに基づく作業用コードがあります。この場合、JavaScriptはtabNameをセレクタとして使用して、activeクラスをツリ​​ーメニューに追加します。

library(shiny) 
library(shinydashboard) 
library(shinyjs) 

ui <- dashboardPage(
    dashboardHeader(title = "Simple tabs"), 
    dashboardSidebar(
    sidebarMenu(
     id = "tabs", 
     actionButton('switchtab', 'Switch tab'), 
     menuItem("Widgets", tabName = "widgets", icon = icon("th")), 
     menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard"), 
       menuSubItem("Sub Menu 1",icon = icon("folder-open"), tabName = "subMenu1") 
    ) 
    ) 
), 
    dashboardBody(
    useShinyjs(), 
    extendShinyjs(text = "shinyjs.activateTab = function(name){ 
        setTimeout(function(){ 
        $('a[href$=' + '\"#shiny-tab-' + name + '\"' + ']').closest('li').addClass('active') 
        }, 200); 
        }" 
    ), 
    tabItems(
     tabItem(tabName = "subMenu1", 
       h2("Dashboard tab/Sub menu 1 content") 
    ), 
     tabItem(tabName = "widgets", 
       h2("Widgets tab content") 
    ) 
    ) 
) 
) 

server <- function(input, output, session) { 
    observeEvent(input$switchtab, { 
    newtab <- switch(input$tabs, 
        "subMenu1" = "widgets", 
        "widgets" = "subMenu1" 
    ) 
    updateTabItems(session, "tabs", newtab) 
    if (newtab == "subMenu1") 
     js$activateTab("dashboard") 
    }) 
} 

shinyApp(ui, server)