Search code examples
rshinyshinydashboard

Show content for menuItem when menuSubItems exist in Shiny Dashboard

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):

enter image description here


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)
Solution

  • 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) { }
)

    enter image description here