rshinyshinydashboard
Usage of UIOutput in multiple menuItems
The R shiny script below displays "output$brand_selector" output in subItem1. I wish to display the same output in subItem2 and subItem3. Also when I open the dashboard, the output is present by default, I wish to make it appear only when I click on a subItem.
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(
id = "tabs",
menuItem("Charts", icon = icon("bar-chart-o"),
menuSubItem("Sub-item 1", tabName = "subitem1"),
menuSubItem("Sub-item 2", tabName = "subitem2"),
menuSubItem("Sub-item 3", tabName = "subitem3")
))),
dashboardBody(
tabItems(tabItem("subitem1", uiOutput("brand_selector")),
tabItem("subitem2", 4),
tabItem("subitem3", 7))
))
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_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)
Solution
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)
- Inverse of gamma function with R
- Hierarchical Bayes for R or Python
- How to insert the "Copy to clipboard" icon in an r markdown document
- Name new variables with purrr::map()
- Represent the selectInput value in an infoBox
- Display the selectInput value in a R shiny widget box
- SelectInput Value update based on previous SelectInput in R shiny
- Using Conditional Panel with PickerInput in R
- Display multiple infoboxes within one reactive function
- R shiny sever problems - reactive global environment
- Show / Hide selectinput in R shiny based on conditions
- Update data from selectInput
- Usage of UIOutput in multiple menuItems
- Automating the slider of SelectInput
- ggplot - geom_point: setting manual fill color for point jitter without changing boxplot fill color
- checkboxGroupInput delete table output in a shiny app
- ShinyApp: How to pass plot from one module into another one in order to download it in a report?
- Names of a numeric vector with HTML
- How to place elements above the dashboardHeader
- Save the path history to the radio button
- ggsurvplot not displaying number at risk for time 0
- find the first TRUE within a group
- How to make a multifactor model in R pROC?
- Error: Data source must be a dictionary (dplyr)
- How do I perform error-handling on non-existent web image that throws a HTTP 404 error?
- data.frame rows to a list
- Is there a fast/clever way to return a logical vector if elements of a vector are in at least one interval?
- How to increase the font size of auto-generated R and p-value in ggscatter plot?
- Test whether one factor is nested in another
- Renaming columns in the global environment