Usage of UIOutput in multiple menuItems in R shiny dashboard

前端 未结 1 1757
鱼传尺愫
鱼传尺愫 2020-12-12 04:02

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

相关标签:
1条回答
  • 2020-12-12 04:19

    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!

    0 讨论(0)
提交回复
热议问题