shinyDashboard में मेनूSubItems के बीच स्विचिंग

Question

मैं shinydashboard का उपयोग करके एक चमकदार ऐप स्थापित करने की कोशिश कर रहा हूं, और अधिकांश भाग के लिए, शुभकामनाएं। हालांकि, मैं साइडबार व्यवहार के साथ एक क्विर्क में भाग रहा हूं जो मुझे लगता है कि टालने योग्य है, लेकिन अभी तक नहीं मिला है।

नीचे एक छोटा सा उदाहरण है जो मेरी समस्या का पुनरुत्पादन करता है। असल में, दो साइडबार मेनस हैं - मेनू वन और मेनू दो, प्रत्येक में दो मेनू SubItems हैं। मेनू आइटम के भीतर सबिटैम स्विच करना ठीक काम करता है। तो, अगर मैं subItemOne से subItemTwo पर स्विच करना चाहता था, कोई समस्या नहीं। मैं वह सब दिन कर सकता हूँ।

मैं मेन्यू में सबइटम्स पर भी स्विच कर सकता हूं, जैसे कि सबइटेम से सबइटेम थ्री तक कूदना, यह ठीक है। समस्या वापस स्विच करने की कोशिश में निहित है। यदि subItemOne चुना गया है, और मैं subItemThree और वापस पर subItemOne पर जाने का प्रयास करता हूं, तो मैं इसे नहीं कर सकता। मुझे subItemTwo पर जाना है, तो मैं SubItemOne खोल सकते हैं।

क्या इस सेटअप को सही करने का कोई तरीका है कि मैं सीधे subItemOne से subItemTree (या दो और चार) तक कूद सकता हूं और फिर वापस आ सकता हूं?

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

समस्या यह है कि टैब आइटम सक्रिय रहते हैं और सक्रिय टैब आइटम पर क्लिक करने से यूआई अपडेट नहीं होता है। यह कुछ जावास्क्रिप्ट के साथ तय किया जा सकता है।

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)