Блог

приведенный ниже код создает боковую панель с элементами TabItems; они снова содержат вложенные вкладки, которые в конечном итоге будут обращаться к некоторому выходу в основном корпусе при нажатии.

Моя проблема в том, что когда, например, TAB3 открыт, и я нажимаю, чтобы открыть TAB1 (или TAB2), не закрыв TAB3, TAB3 больше не загружается (хотя он открывается, как видно по значку подпункта>>)

Я использую renderUI и uiOutput для достижения этой цели, и я использую «do.call» для настройки подменю…

Я уже пытался изменить MenuItem на menuSubItem и т. Д. … Похоже, это не помогает. Это «нормальное поведение» или я что-то упускаю (?)

Вам всегда нужно закрывать вкладку перед открытием другой?

Конечно, любая помощь приветствуется!

Спасибо, Грегор

 library(shiny)
library(shinydashboard)
## set up a main body... no content needed
body <- dashboardBody( title="Title" )
## set up a sidebar with TABS containing subTABS
## the subTABS are adressed via an uiOutput() 
sidebar <- dashboardSidebar (
  ##
  sidebarMenu(
    menuItem("TAB1",menuSubItem(uiOutput("Sidebar_sub1")) ),
    menuItem("TAB2",menuSubItem(uiOutput("Sidebar_sub2"))  ),
    menuItem("TAB3",menuSubItem(uiOutput("Sidebar_sub3"))  ) )
) 
##
server <- function(input, output) {
  ## starting parameters
  nsubtabs    <- 9
  tabnames <- paste0("subtab",1:nsubtabs)
  ## set up a list for all subtabs
  Menus_sub <- vector("list", nsubtabs)
  for(i in 1:nsubtabs) {
    Menus_sub[[i]] <- menuSubItem(tabnames[i], tabName = tabnames[i]) }
  ## use renderUI to create sidebar-output
  output$Sidebar_sub1 <- renderUI({  
    do.call(function(...) sidebarMenu(id = "sidebarMenu_sub1", ...), Menus_sub[1:3])
  })
  ##
  output$Sidebar_sub2 <- renderUI({  
    do.call(function(...) sidebarMenu(id = "sidebarMenu_sub2", ...), Menus_sub[4:6])
  })
  ##
  output$Sidebar_sub3 <- renderUI({  
    do.call(function(...) sidebarMenu(id = "sidebarMenu_sub3", ...), Menus_sub[7:9])
  })
  ##
}
##
ui <- dashboardPage(dashboardHeader(title = "Title2"), sidebar,body)
##
shinyApp(ui, server)

 

Я нашел решение: замените uiOutput() в sidebarMenu() на dropdownMenuOutput(), например:

 sidebar <- dashboardSidebar (
  ##
  sidebarMenu(
    menuItem("TAB1",menuSubItem(dropdownMenuOutput("Sidebar_sub1")) ),
    menuItem("TAB2",menuSubItem(dropdownMenuOutput("Sidebar_sub2"))  ),
    menuItem("TAB3",menuSubItem(dropdownMenuOutput("Sidebar_sub3"))  ) )
) 

 

Похоже, что после этого изменения меню, которые создаются динамически, помещаются в выпадающий список вместо перехода в отдельные элементы меню. Теперь все хорошо!

Спасибо, Грегор