Passaggio da menuSubItems a shinyDashboard

Question

Sto provando a impostare un'app lucida usando shinydashboard e, per la maggior parte, con buona fortuna. Tuttavia, mi imbatto in una stranezza con il comportamento della barra laterale che penso sia evitabile, ma non ho ancora trovato il modo.

Di seguito è riportato un piccolo esempio che riproduce il problema riscontrato. Fondamentalmente, ci sono due Menù sidebar: Menu Uno e Menu Due, ciascuno con due menu Soggetto. La commutazione di elementi secondari all'interno di una voce di menu funziona correttamente. Quindi, se volessi passare da subItemOne a subItemTwo, nessun problema. Posso farlo tutto il giorno

Posso anche passare a voci secondarie attraverso i menu, in modo tale che passando da subItemOne a subItemThree, va bene. Il problema sta nel tentativo di tornare indietro. Se subItemOne è selezionato, e provo a passare a subItemThree e indietro a subItemOne, non riesco a farlo. Devo andare a subItemTwo, quindi posso aprire SubItemOne.

C'è un modo per correggere questa configurazione in modo tale da poter passare direttamente da subItemOne a subItemThree (o due e quattro) e viceversa?

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

Il problema è che gli elementi della scheda rimangono attivi e facendo clic su un elemento della scheda attivo non si aggiorna l'IU. Questo può essere risolto con alcuni 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)