Show content for menuItem when menuSubItems exist in Shiny Dashboard

Question

Is there a way of actually showing content in the content pane of a Shiny Dashboard for a menuItem with existing menuSubItems. In the example: I tried to add "tabName = "charts"" to the menuItem "Charts" in order to show the content of tabItem "charts". However, no effect besides opening the menu and showing the submenu (the content pane still shows the "old" content of the previous selection):

header <- dashboardHeader()
#> Error in dashboardHeader(): konnte Funktion "dashboardHeader" nicht finden

sidebar <- dashboardSidebar(
  sidebarUserPanel("User Name",
    subtitle = a(href = "#", icon("circle", class = "text-success"), "Online"),
    # Image file should be in www/ subdir
    image = "userimage.png"
  ),
  sidebarSearchForm(label = "Enter a number", "searchText", "searchButton"),
  sidebarMenu(
    # Setting id makes input$tabs give the tabName of currently-selected tab
    id = "tabs",
    menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
    menuItem("Widgets", icon = icon("th"), tabName = "widgets", badgeLabel = "new",
             badgeColor = "green"),
    menuItem("Charts", icon = icon("bar-chart-o"),
      menuSubItem("Sub-item 1", tabName = "subitem1"),
      menuSubItem("Sub-item 2", tabName = "subitem2")
    )
  )
)
#> Error in dashboardSidebar(sidebarUserPanel("User Name", subtitle = a(href = "#", : konnte Funktion "dashboardSidebar" nicht finden

body <- dashboardBody(
  tabItems(
    tabItem("dashboard",
      div(p("Dashboard tab content"))
    ),
    tabItem("widgets",
      "Widgets tab content"
    ),
    tabItem("subitem1",
      "Sub-item 1 tab content"
    ),
    tabItem("subitem2",
      "Sub-item 2 tab content"
    )
  )
)
#> Error in dashboardBody(tabItems(tabItem("dashboard", div(p("Dashboard tab content"))), : konnte Funktion "dashboardBody" nicht finden

shinyApp(
  ui = dashboardPage(header, sidebar, body),
  server = function(input, output) { }
)
#> Error in shinyApp(ui = dashboardPage(header, sidebar, body), server = function(input, : konnte Funktion "shinyApp" nicht finden


devtools::session_info()
#> Session info -------------------------------------------------------------
#>  setting  value                       
#>  version  R version 3.4.0 (2017-04-21)
#>  system   x86_64, mingw32             
#>  ui       RTerm                       
#>  language (EN)                        
#>  collate  German_Germany.1252         
#>  tz       Europe/Berlin               
#>  date     2018-01-11
#> Packages -----------------------------------------------------------------
#>  package   * version    date       source                          
#>  backports   1.1.0      2017-05-22 CRAN (R 3.4.0)                  
#>  base      * 3.4.0      2017-04-21 local                           
#>  compiler    3.4.0      2017-04-21 local                           
#>  datasets  * 3.4.0      2017-04-21 local                           
#>  devtools    1.13.3     2017-08-02 CRAN (R 3.4.1)                  
#>  digest      0.6.13     2017-12-14 CRAN (R 3.4.3)                  
#>  evaluate    0.10.1     2017-06-24 CRAN (R 3.4.1)                  
#>  graphics  * 3.4.0      2017-04-21 local                           
#>  grDevices * 3.4.0      2017-04-21 local                           
#>  htmltools   0.3.6      2017-04-28 CRAN (R 3.4.0)                  
#>  knitr       1.17       2017-08-10 CRAN (R 3.4.1)                  
#>  magrittr    1.5        2014-11-22 CRAN (R 3.4.0)                  
#>  memoise     1.1.0      2017-04-21 CRAN (R 3.4.0)                  
#>  methods   * 3.4.0      2017-04-21 local                           
#>  Rcpp        0.12.14    2017-11-23 CRAN (R 3.4.3)                  
#>  rmarkdown   1.6        2017-06-15 CRAN (R 3.4.0)                  
#>  rprojroot   1.2        2017-01-16 CRAN (R 3.4.0)                  
#>  stats     * 3.4.0      2017-04-21 local                           
#>  stringi     1.1.5      2017-04-07 CRAN (R 3.4.0)                  
#>  stringr     1.2.0      2017-02-18 CRAN (R 3.4.0)                  
#>  tools       3.4.0      2017-04-21 local                           
#>  utils     * 3.4.0      2017-04-21 local                           
#>  withr       2.1.1.9000 2018-01-05 Github (jimhester/withr@df18523)
#>  yaml        2.1.14     2016-11-12 CRAN (R 3.4.0)

Answer 1

Much credit goes to this question React to menuItem() tab selection . The only annoying thing is that you would have to click on the Charts tab again but I think that should be fine

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
}

header <- dashboardHeader()

sidebar <- dashboardSidebar(
  sidebarUserPanel("Pork Chop",
                   subtitle = a(href = "#", icon("circle", class = "text-success"), "Online"),
                   # Image file should be in www/ subdir
                   image = "https://vignette.wikia.nocookie.net/fanfictiondisney/images/9/9e/Pumba_3.jpg/revision/latest?cb=20120708163413"
  ),
  sidebarSearchForm(label = "Enter a number", "searchText", "searchButton"),
  sidebarMenu(
    # Setting id makes input$tabs give the tabName of currently-selected tab
    id = "tabs",
    menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
    menuItem("Widgets", icon = icon("th"), tabName = "widgets", badgeLabel = "new", badgeColor = "green"),
    convertMenuItem(menuItem("Charts", tabName = "charts",icon = icon("bar-chart-o"),selected=T,
             menuSubItem("Sub-item 1", tabName = "subitem1"),
             menuSubItem("Sub-item 2", tabName = "subitem2")),"charts")
  )
)

body <- dashboardBody(
  tabItems(
    tabItem("dashboard",div(p("Dashboard tab content"))),
    tabItem("widgets","Widgets tab content"),
    tabItem("charts","Charts Tab"),
    tabItem("subitem1","Sub-item 1 tab content"),
    tabItem("subitem2","Sub-item 2 tab content")
  )
)

shinyApp(
  ui = dashboardPage(header, sidebar, body),
  server = function(input, output) { }
)

Answer 2

Coming from here. This is an alternative approach showing a hidden, childless menuItem associated with a tabItem, once the childful menuItem is expanded.

Two advantages over @PorkChop's current solution are, that input$sidebarItemExpanded remains functional (doesn't get updated when using convertMenuItem) and there is no second click needed to expand the menu.

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", id = "chartsID", 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"))
    )
  ),
  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")
    }
  })
}

shinyApp(ui, server)

PS: Here and here related GitHub issues can be found.

If you want to expand / collapse menuItem's in the sidebar when using updateTabItems please check this.