r shiny - uiOutput not rendering inside menuItem
At first, I'd change uiOutput("sli_val1") into uiOutput("out_sli_val1"), to prevent duplicated Ids.
Concerning your problem: This is an odd thing going on when Shiny runs through the document and renders/binds all possible outputs. The default action is to ignore all hidden output elements - that means not ignore completely (output "sli_val1" is bound alright), but their function is suspended, letting no children to be rendered.
So the problem is, that on initiation, this output is hidden in the subitem tree and from there on ignored.
The fix can be done by unsetting this supension behaviour by calling
outputOptions(output, "out_sli_val1", suspendWhenHidden = FALSE)
But how and where? This option has to be set before you run your "data loading". But it will throw errors, if output$out_sli_val1 has nothing assigned to it (is NULL). To avoid that, one can initialize an empty UI-chunk, which gets overridden on "data load".
Here is your minimal fix with 2 extra lines of code (and modified output Id):
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(
menuItem(text = "data options",
checkboxGroupInput(inputId = "cbg_group1", label = "group 1",
choices = c("some","check","boxes","to","choose","from") ),
uiOutput("out_sli_val1"),
checkboxGroupInput(inputId = "cbg_group2", label = "group 2",
choices = c("another","set","of","check","boxes") )
),
menuItem(text = "another tab")
)
),
dashboardBody()
)
server <- function(input, output, session){
output$out_sli_val1 <- renderUI({})
outputOptions(output, "out_sli_val1", suspendWhenHidden = FALSE)
withProgress(message = "loading page", value=0.1, {
## simulate loading some data
Sys.sleep(3)
## slider input
output$out_sli_val1 <- renderUI({
sliderInput(inputId = "sli_val1", label = "values", min = 0, max = 100, value = c(25, 75) )
})
setProgress(value=1, detail="Complete")
})
}
shinyApp(ui = ui, server = server)
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.
Usage of UIOutput in multiple menuItems in R shiny dashboard
You could create a dummy tabItem which is hidden and select that bu default. This will give the illusion that no tabItem is selected. To hide the tabItem option you could use hidden function from shinyjs package.
Following is the modified ui code:
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(
shinyjs::useShinyjs(),
id = "tabs",
menuItem("Charts", icon = icon("bar-chart-o"),
shinyjs::hidden(menuSubItem("dummy", tabName = "dummy")),
menuSubItem("Sub-item 1", tabName = "subitem1"),
menuSubItem("Sub-item 2", tabName = "subitem2"),
menuSubItem("Sub-item 3", tabName = "subitem3")
))),
dashboardBody(
tabItems(tabItem("dummy"),
tabItem("subitem1", uiOutput("brand_selector")),
tabItem("subitem2", 4),
tabItem("subitem3", 7))
))
EDIT1:
As per the comments and reference from the answers given bu Joe here you can do that as follows:
candyData <- read.table(
text = "
Brand Candy value
Nestle 100Grand Choc1
Netle Butterfinger Choc2
Nestle Crunch Choc2
Hershey's KitKat Choc4
Hershey's Reeses Choc3
Hershey's Mounds Choc2
Mars Snickers Choc5
Nestle 100Grand Choc3
Nestle Crunch Choc4
Hershey's KitKat Choc5
Hershey's Reeses Choc2
Hershey's Mounds Choc1
Mars Twix Choc3
Mars Vaid Choc2",
header = TRUE,
stringsAsFactors = FALSE)
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(
shinyjs::useShinyjs(),
id = "tabs",
menuItem("Charts", icon = icon("bar-chart-o"),
shinyjs::hidden(menuSubItem("dummy", tabName = "dummy")),
menuSubItem("Sub-item 1", tabName = "subitem1"),
menuSubItem("Sub-item 2", tabName = "subitem2"),
menuSubItem("Sub-item 3", tabName = "subitem3")
))),
dashboardBody(
tabItems(tabItem("dummy"),
tabItem("subitem1", uiOutput("brand_selector")),
tabItem("subitem2", uiOutput("brand_selector1")),
tabItem("subitem3", uiOutput("brand_selector2")))
))
server <- function(input, output,session) {
observeEvent(input$Select1,{
updateSelectInput(session,'Select2',
choices=unique(candyData$Candy[candyData$Brand==input$Select1]))
})
observeEvent(input$Select2,{
updateSelectInput(session,'Select3',
choices=unique(candyData$value[candyData$Brand==input$Select1 &
candyData$Candy==input$Select2]))
})
output$brand_selector1 <- output$brand_selector2 <- output$brand_selector <- renderUI({
box(title = "Data", status = "primary", solidHeader = T, width = 12,
fluidPage(
fluidRow(
column(2,offset = 0, style='padding:1px;',
selectInput("Select1","select1",unique(candyData$Brand))),
column(2,offset = 0,
style='padding:1px;',selectInput("Select2","select2",choices = NULL)),
column(2, offset = 0,
style='padding:1px;',selectInput("Select3","select3",choices=NULL ))
)))
})}
shinyApp(ui = ui, server = server)
EDIT2:
Here is a slightly different approach without using renderUI and using shinyModule:
candyData <- read.table(
text = "
Brand Candy value
Nestle 100Grand Choc1
Netle Butterfinger Choc2
Nestle Crunch Choc2
Hershey's KitKat Choc4
Hershey's Reeses Choc3
Hershey's Mounds Choc2
Mars Snickers Choc5
Nestle 100Grand Choc3
Nestle Crunch Choc4
Hershey's KitKat Choc5
Hershey's Reeses Choc2
Hershey's Mounds Choc1
Mars Twix Choc3
Mars Vaid Choc2",
header = TRUE,
stringsAsFactors = FALSE)
library(shiny)
library(shinydashboard)
submenuUI <- function(id) {
ns <- NS(id)
tagList(
box(title = "Data", status = "primary", solidHeader = T, width = 12,
fluidPage(
fluidRow(
column(2,offset = 0, style='padding:1px;',
selectInput(ns("Select1"),"select1",unique(candyData$Brand))),
column(2,offset = 0,
style='padding:1px;',selectInput(ns("Select2"),"select2",choices = NULL)),
column(2, offset = 0,
style='padding:1px;',selectInput(ns("Select3"),"select3",choices=NULL ))
)))
)
}
# submenu <- function(input,output,session){}
submenuServ <- function(input, output, session){
observeEvent(input$Select1,{
updateSelectInput(session,'Select2',
choices=unique(candyData$Candy[candyData$Brand==input$Select1]))
})
observeEvent(input$Select2,{
updateSelectInput(session,'Select3',
choices=unique(candyData$value[candyData$Brand==input$Select1 &
candyData$Candy==input$Select2]))
})
}
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(
shinyjs::useShinyjs(),
id = "tabs",
menuItem("Charts", icon = icon("bar-chart-o"),
shinyjs::hidden(menuSubItem("dummy", tabName = "dummy")),
menuSubItem("Sub-item 1", tabName = "subitem1"),
menuSubItem("Sub-item 2", tabName = "subitem2"),
menuSubItem("Sub-item 3", tabName = "subitem3")
))),
dashboardBody(
tabItems(tabItem("dummy"),
tabItem("subitem1", submenuUI('submenu1')),
tabItem("subitem2", submenuUI('submenu2')),
tabItem("subitem3", submenuUI('submenu3'))
)
))
server <- function(input, output,session) {
callModule(submenuServ,"submenu1")
callModule(submenuServ,"submenu2")
callModule(submenuServ,"submenu3")
}
shinyApp(ui = ui, server = server)
Hope it helps!
R Shiny Dashboard does not load rendered UI inside of sidebarMenu on initialization
So I have found a solution from another SO post: r shiny - uiOutput not rendering inside menuItem and I'm slightly ashamed I did not manage to find this in my first set of search efforts. To sum up what the post says in more detail, the UI element I am rendering inside the menuItem is initialized as hidden, and hidden items are suspended by default. As the post details, you can change this option via the outputOptions function. Here is an updated version that works exactly as I wanted it to originally:
library("shiny")
library("shinydashboard")
header = dashboardHeader(
title = "Dynamic UI Example"
)
sidebar = dashboardSidebar(
sidebarMenu(
menuItemOutput("dynamic_sidebar")
)
)
body = dashboardBody(
tabBox(
tabPanel(
strong("One")
),
tabPanel(
strong("Two")
)
)
)
ui = dashboardPage(header, sidebar, body)
server = shinyServer(function(input,output,session){
output$input <- renderUI({})
outputOptions(output, "input", suspendWhenHidden = FALSE)
output$dynamic_sidebar = renderMenu({
sidebarMenu(
menuItem(
"Slider or numeric problem",
radioButtons("slider_or_numeric",
label = "Slider or Numeric Input",
choices = c("Slider", "Numeric"),
selected = "Slider",
inline = TRUE
),
uiOutput("input")
)
)
})
output$input = renderUI({
if (input$slider_or_numeric == "Slider"){
sliderInput("slider",
label = "slider",
min = 0, max = 1,
value = 0
)
} else {
numericInput("numeric",
label = "numeric",
min = 0, max = 1,
value = 0
)
}
})
})
shinyApp(ui, server)
Note that it is necessary to initialize the output object BEFORE setting it's options or else it would be null and cause an error.
Thanks to Mike for attempting to answer the question, hopefully if someone else stumbles onto this problem they'll find this solution useful.
Related Topics
How to Efficiently Read the First Character from Each Line of a Text File
Can You Pass a Vector to a Vararg: Vector to Sprintf
How to Compute Weighted Mean in R
R System Functions Always Returns Error 127
How to Add Abline with Lattice Xyplot Function
Rsqlite Query with User Specified Variable in the Where Field
Merge Records Over Time Interval
Cannot Export Data to a File in R (Write.Csv)
Subtract Every Column from Each Other Column in a R Data.Table
How to Pass Aes Parameters of Ggplot to Function
R:Loops to Process Large Dataset(Gbs) in Chunks
R: Colsums When Not All Columns Are Numeric
Changing Styles When Selecting and Deselecting Multiple Polygons with Leaflet/Shiny