input $ sidebarItemExpanded не работает с convertMenuItem в R Shiny - PullRequest
0 голосов
/ 09 июля 2020

Для convertMenuItem см. Ссылку здесь: { ссылка }

Когда я пытаюсь получить имя расширенного menuItem, это не работает. Вот автономный пример:

library(shiny)
library(shinydashboard)

convertMenuItem <- function(mi,tabName) {
  mi$children[[1]]$attribs['data-toggle']="tab"
  mi$children[[1]]$attribs['data-value'] = tabName
  if(length(mi$attribs$class)>0 && mi$attribs$class=="treeview"){
    mi$attribs$class=NULL
  }
  mi
}

ui <- dashboardPage(
  dashboardHeader(), 
  dashboardSidebar(
    sidebarMenu(
      menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
      menuItem("Widgets", icon = icon("th"), tabName = "widgets"),
      convertMenuItem(menuItem("Charts", tabName = "charts", icon = icon("bar-chart-o"), expandedName = "CHARTS",
               menuSubItem("Sub-item 1", tabName = "subitem1"),
               menuSubItem("Sub-item 2", tabName = "subitem2")
      ), "charts")
    ),
    textOutput("res")
  ),
  dashboardBody(
    tabItems(
      tabItem("dashboard", "Dashboard tab content"),
      tabItem("widgets", "Widgets tab content"),
      tabItem("subitem1", "Sub-item 1 tab content"),
      tabItem("subitem2", "Sub-item 2 tab content") 
    )
  )
)

server <- function(input, output, session) {
  output$res <- renderText({
    req(input$sidebarItemExpanded)
    paste("Expanded menuItem:", input$sidebarItemExpanded)
    print(input$sidebarItemExpanded)
  })
}

shinyApp(ui, server)

Есть ли способ изменить эту функцию так, чтобы также поддерживалась функциональность Expanded Item?

1 Ответ

0 голосов
/ 10 июля 2020

Ниже приводится обходной путь, позволяющий избежать использования convertMenuItem.

Вместо него я использую скрытый menuItem, который отображается после раскрытия дочерних menuItem «Графики».

Таким образом, input$sidebarItemExpanded работает должным образом.

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

ui <- dashboardPage(
  dashboardHeader(), 
  dashboardSidebar(
    sidebarMenu(
      id = "sidebarID",
      menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
      menuItem("Widgets", icon = icon("th"), tabName = "widgets"),
      menuItem("Charts", tabName = "charts", icon = icon("bar-chart-o"), expandedName = "CHARTS",
                               menuSubItem("Sub-item 1", tabName = "subitem1"),
                               menuSubItem("Sub-item 2", tabName = "subitem2")
      ),
      hidden(menuItem("hiddenCharts", tabName = "hiddenCharts"))
    ),
    textOutput("res")
  ),
  dashboardBody(
    useShinyjs(),
    tabItems(
      tabItem("dashboard", "Dashboard tab content"),
      tabItem("widgets", "Widgets tab content"),
      tabItem("hiddenCharts", "Charts Tab"),
      tabItem("subitem1", "Sub-item 1 tab content"),
      tabItem("subitem2", "Sub-item 2 tab content") 
    )
  )
)

server <- function(input, output, session) {
  
  observeEvent(input$sidebarItemExpanded, {
    if(input$sidebarItemExpanded == "CHARTS"){
      updateTabItems(session, "sidebarID", selected = "hiddenCharts")
    }
  })
  
  output$res <- renderText({
    req(input$sidebarItemExpanded)
    paste("Expanded menuItem:", input$sidebarItemExpanded)
    print(input$sidebarItemExpanded)
  })
}

shinyApp(ui, server)
...