Usage of UIOutput in multiple menuItems in R shiny dashboard

Question

The R shiny script below displays "output$brand_selector" output in subItem1. I wish to display the same output in subItem2 and subItem3. Please help, 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, thanks and please help.

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)

SBista · Accepted Answer · 2018-01-23T06:49:12.450

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!

thank you so much for replying, this solves the on-click issue, however the major issue here is that I want the "brand_selector" to be used under multiple sub menu items. Please help me with a fix there, I shall provide you with a good post for reference, https://stackoverflow.com/questions/48337624/using-similar-ui-script-in-r-shiny-under-multiple-submenuitems/48338347#48338347 — Adam Shaw, Jan 23 '18 at 05:29
@AdamShaw, I have edited the answer. Hope it helps you with the solution. — SBista, Jan 23 '18 at 05:39
Thanks but if I run this code, the functionality I want only appears in the first subMenuItem, for the other two, I am not seeing the values in the selectInputs appear like the first one, kindly check and suggest. — Adam Shaw, Jan 23 '18 at 05:43
the post I have provided above tries to achieve a somewhat same functionality, I just am not getting how to integrate the menuItems with shinyModules, please help me here. — Adam Shaw, Jan 23 '18 at 06:15
I have never worked with shinyModules before. Will edit the answer if I figure it out. — SBista, Jan 23 '18 at 06:16
way to go, to the point it is, Many Many thanks for the help. — Adam Shaw, Jan 23 '18 at 06:54
Kindly help me with this one link, I need a little tweak at one place https://stackoverflow.com/questions/48417489/adding-additional-label-value-when-clicked-on-sankey-chart-lines-in-r-shiny — Adam Shaw, Jan 24 '18 at 08:25
thanks for the help regarding the above requirement, I just wish to add an infobox under the box with box inputs, and display the selected value in the infobox box in R shiny. can you help me here, else I should raise a new query. — Adam Shaw, Jan 29 '18 at 07:01
You could render `infobox` using `renderUI` from the server side and give the value as `input$select1` . — SBista, Jan 29 '18 at 07:04
I just did that but am not able to tweak the script, output$valuen <- renderUI( infoBox("box1",value = input$select3) ), kindly update the above script if got the fix, thanks. — Adam Shaw, Jan 29 '18 at 07:08
You want to use it with `shinyModules`? As I said before I have never worked with `shinyModules` so will have to look into how it could be done. Posting a new question regarding it would be a better option. — SBista, Jan 29 '18 at 07:10
can I suggest something here, I guess you need to add an extra observeEvent in the above script, kindly suggest else I'll raise a new query. — Adam Shaw, Jan 29 '18 at 07:12
No, you could use the current `observeEvent`. The main hurdle would be making `renderUI` work with `shinyModules`. — SBista, Jan 29 '18 at 07:24
sure, I have created a new question as suggested with the snapshot, kindly help me here if you can suggest a fix. — Adam Shaw, Jan 29 '18 at 07:36
Here is the link, https://stackoverflow.com/questions/48496426/display-the-selectinput-value-in-a-r-shiny-widget-box, kindly help. Also, like how updateSelectInput works under observeEvent, isn't there anything for infobox like that? — Adam Shaw, Jan 29 '18 at 09:17
thanks again for the help above with the script, It has helped me nicely, however, I would like to point one possible fix that you can suggest here, the selectInput is not able to understand common values, hence output is going wrong, please check the script and help https://stackoverflow.com/questions/48519138/selectinput-value-update-based-on-previous-selectinput-in-r-shiny — Adam Shaw, Jan 30 '18 at 10:30
Hi regarding the latest code that you helped me with above, I have to implement this within multiple tabs, kindly check the link here https://stackoverflow.com/questions/48660367/creating-tabs-in-r-shiny-and-placing-box-widgets — Adam Shaw, Feb 07 '18 at 09:40

Usage of UIOutput in multiple menuItems in R shiny dashboard

1 Answers1

Linked