Show content for menuItem when menuSubItems exist in Shiny Dashboard
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) { }
)
Shiny: Output will be shown in every menuItem
You aren't using tabName correctly. First, you shouldn't reuse tab names in the sidebar. Those will be clashing. A lot of your menuSubItem tabs are have repeated values. That should be fixed to something like...
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Test1", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Test2",tabName = "charts", icon = icon("bar-chart-o"),
menuSubItem("TTest1", tabName = "subitem1"),
menuSubItem("TTest2", tabName = "subitem2"),
menuSubItem("TTest3", tabName = "subitem3"),
menuSubItem("TTest4", tabName = "subitem4")),
menuItem("Test3", tabName = "choice", icon = icon("dashboard"),
menuSubItem("TTTest1", tabName = "subitem4"),
menuSubItem("TTTest2", tabName = "subitem5"),
menuSubItem("TTTest3", tabName = "subitem6"),
menuSubItem("TTTest4", tabName = "subitem7")),
menuItem("Test4", tabName = "Prod", icon = icon("dashboard"),
menuSubItem("TTTTest1", tabName = "subitem8"),
menuSubItem("TTTTest2", tabName = "subitem9"),
menuSubItem("TTTTest3", tabName = "subitem10"),
menuSubItem("TTTTest4", tabName = "subitem11"))
)
)
Notice now there are no repeated tabNames. These are what you want to use in the dashBoardBody to associate the sidebar with the body of the app.
If you want your leaflet map to appear in Test3/TTTest1, you need to use that tabName specifically. In the code chunk above, tabName = "subitem4".
body <- dashboardBody(
tabItems(
# Map Output
tabItem(tabName = "subitem4",
fluidRow(
leafletOutput("myMap"),
tabBox(
title = "Legend",
id = "tabset1", height = "150px", width = "500px",
tabPanel("Explaining", "If this then that"),
tabPanel("Source", "Here you can find my data")
),
)
),
The connection between your sidebar menu and what appears on the body of those pages is the tabName.
Tabs of the menuItem, in Shinydashboard, not working when put items inside
That is because childfull menuItem behaves differently as noted here. Therefore, you need to define a menuItem or a menSubItem within that dashboard page so that your desired content can be displayed.
Try this
sidebarMenu(id = "tabs",
menuItem("Dashboard",
tabName = "dashboard",
icon = icon("tachometer-alt"),
selected = TRUE,
startExpanded = TRUE,
#icon = icon(fontawesome:::fa_tbl[[1]][505]),
menuItem("Sub-item 1", tabName = "subitem1"),
### menuSubItem("Sub-item 1", tabName = "subitem1"), ## it can be menuSubItem instead of menuItem
numericInput("num1",
"Put the First Number",
value = 1,
min = 0),
numericInput("num2",
"Put the Second Number",
value = 2,
min = 0)
),
menuItem("Widgets",
icon = icon("th"),
tabName = "widgets")
)
)
body <- shinydashboard::dashboardBody(
tabItems(
tabItem(tabName = "subitem1",
h2("Sub item1 tab content in Dashboard"),
fluidRow(
valueBoxOutput("box1", width = 6),
valueBoxOutput("box2", width = 6)
)
),
tabItem(tabName = "widgets",
h2("Widgets tab content")
)
)
)
# Put them together into a dashboardPage
ui <- shinydashboard::dashboardPage(
skin = "green",
shinydashboard::dashboardHeader(title = "Example"),
sidebar,
body
)
server <- function(input, output, session){
output$box1 <- renderValueBox({
valueBox(input$num1,
"First Number",
color = "aqua",
icon = icon("chart-line"))
})
output$box2 <- renderValueBox({
valueBox(input$num2,
"Second Number",
color = "aqua",
icon = icon("chart-line"))
})
observe({print(input$tabs)})
}
shinyApp(ui, server)
Shiny dashboard preselect menuSubItem when clicking menuItem
Your sidebarMenu needs an id and your server function needs the session argument, so you can use:
updateTabItems(session, inputId="sidebarID", selected="subMenu1")
Please check the following:
library(shinydashboard)
library(shiny)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(
id = "sidebarID",
menuItem("Table1" , tabname = "my_table1", icon = icon("table"), startExpanded = TRUE,
menuSubItem("sub menu1",tabName = "subMenu1", selected = TRUE),
menuSubItem("sub menu2",tabName = "subMenu2")
),
menuItem("Table2" , tabname = "my_table2", icon = icon("table"), startExpanded = FALSE,
menuSubItem("sub menu3",tabName = "subMenu3"),
menuSubItem("sub menu4",tabName = "subMenu4")
)
)),
dashboardBody(
tabItems(
tabItem(tabName = "my_table1",
h2("First Table")
),
tabItem(tabName = "my_table2",
h2("Second Table")
),
tabItem(tabName = "subMenu1",
h2("First tab")
),
tabItem(tabName = "subMenu2",
h2("Second tab")
),
tabItem(tabName = "subMenu3",
h2("Third tab")
),
tabItem(tabName = "subMenu4",
h2("Fourth tab")
)
)))
server <- function(input, output, session) {
observeEvent(input$sidebarItemExpanded, {
cat(paste("menuItem() currently expanded:", input$sidebarItemExpanded, "\n"))
if(input$sidebarItemExpanded == "Table1"){
updateTabItems(session, inputId="sidebarID", selected="subMenu1")
} else if(input$sidebarItemExpanded == "Table2"){
updateTabItems(session, inputId="sidebarID", selected="subMenu3")
}
})
observe({
cat(paste("tabItem() currently selected:", input$sidebarID, "\n"))
})
}
shinyApp(ui, server)
Furthermore please see the related docs.
Hide/show menuitem in Shiny
Another way to do it is
output$another_tab <- renderMenu({
if(input$somevalue == TRUE) {
menuItem("My tab", tabName = "tab3", icon = icon("cogs"))
}else shinyjs::hide(selector = "a[data-value='tab3']" )
})
R shinydashboard collapsible menuItem with inputs
Edit: I cleaned up the code a little to make the difference between childfull and childless menuItem's more clear - the parameters expandedName and startExpanded can only be used with a childfull menuItem in contrast tabName and selected is only used with childless menuItem's.
library(shiny)
library(shinydashboard)
ui <- function(req) {
dashboardPage(
dashboardHeader(title = "Simple tabs"),
dashboardSidebar(sidebarMenu(
id = "sidebarItemSelected",
menuItem(
"Childfull menuItem",
menuItem(
"Childless menuItem 1",
tabName = "childlessTab1",
icon = icon("dashboard"),
selected = TRUE
),
fileInput("upload", "Upload"),
bookmarkButton(),
expandedName = "childfullMenuItem",
startExpanded = TRUE
),
menuItem(
"Childless menuItem 2",
icon = icon("th"),
tabName = "childlessTab2",
badgeLabel = "new",
badgeColor = "green"
)
)),
dashboardBody(tabItems(
tabItem(tabName = "childlessTab1",
h2("Dashboard tab content")),
tabItem(tabName = "childlessTab2",
h2("Widgets tab content"))
))
)
}
server <- function(input, output, session) {
observe({
cat(
paste(
"\nsidebarItemSelected:",
input$sidebarItemSelected,
"\nsidebarItemExpanded:",
input$sidebarItemExpanded,
"\nsidebarCollapsed:",
input$sidebarCollapsed,
"\n"
)
)
})
}
shinyApp(ui, server, enableBookmarking = "url")
Initial answer:
Sure - this is possible (modified version of this example):
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Simple tabs"),
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", fileInput("upload", "Upload"), tabName = "dashboard", icon = icon("dashboard")),
menuItem("Widgets", icon = icon("th"), tabName = "widgets",
badgeLabel = "new", badgeColor = "green")
)
),
dashboardBody(
tabItems(
tabItem(tabName = "dashboard",
h2("Dashboard tab content")
),
tabItem(tabName = "widgets",
h2("Widgets tab content")
)
)
)
)
server <- function(input, output, session) {}
shinyApp(ui, server)
R Shinydashboard submenuitems using same UI
You can't have duplicate IDs, they have to be unique. You can investigate these yourself by right clicking on the page and then inspect, click on console and you will see the errors. For you its Uncaught Duplicate binding for ID chart
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenuOutput("menu"),
textOutput("res")
),
dashboardBody(
tabItems(
tabItem("dashboard", "Dashboard tab content"),
tabItem("widgets", "Widgets tab content"),
tabItem("chartsHome", "Main charts content"),
tabItem("subitem1", uiOutput("chart")),
tabItem("subitem2", uiOutput("chart2"))
)
)
)
server <- function(input, output, session) {
output$res <- renderText({
paste("You've selected:", input$tabs)
})
output$menu <- renderMenu({
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"),
menuItem("Charts", icon = icon("bar-chart-o"), tabName="chartsHome",
menuSubItem("Sub-item 1", tabName = "subitem1"),
menuSubItem("Sub-item 2", tabName = "subitem2")
)
)
})
toRender <- reactive({
if (input$tabs == "subitem1") {
HTML("Chart with first variable as output")
}
else if (input$tabs == "subitem2") {
HTML("Chart with second variable as output")
}
else{
return()
}
})
output$chart <- renderUI({
toRender()
})
output$chart2 <- renderUI({
toRender()
})
}
shinyApp(ui, server)
Related Topics
Should I Avoid Programming Packages with Pipe Operators
Represent Numeric Value with Typical Dollar Amount Format
Linear Model Function Lm() Error: Na/Nan/Inf in Foreign Function Call (Arg 1)
Ggplot2: Using Gtable to Move Strip Labels to Top of Panel for Facet_Grid
Ordering Stacks by Size in a Ggplot2 Stacked Bar Graph
Importing "Csv" File with Multiple-Character Separator to R
Calculating Sum of Previous 3 Rows in R Data.Table (By Grid-Square)
Sort Year-Month Column by Year and Month
Sort a List of Nontrivial Elements in R
Finding Non-Numeric Data in a Data Frame or Vector
Get the Index of the Values of One Vector in Another
Generate All Possible Permutations (Or N-Tuples)
Calculating Peaks in Histograms or Density Functions
Explicitly Set Panel Size (Not Just Plot Size) in Ggplot2
Add Column Containing Data Frame Name to a List of Data Frames