代码之家  ›  专栏  ›  技术社区  ›  Adam Shaw

在R shiny dashboard中的多个菜单项中使用UIOutput

  •  1
  • Adam Shaw  · 技术社区  · 7 年前

    下面的R闪亮脚本在子项1中显示“output$brand\u selector”输出。我希望在子项2和子项3中显示相同的输出。请帮助,当我打开仪表板时,默认情况下会显示输出,我希望仅当我单击子项时才会显示输出,谢谢,请帮助。

    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)
    

    Subitem capture

    1 回复  |  直到 7 年前
        1
  •  4
  •   SBista    7 年前

    你可以创建一个假人 tabItem 这就是 hidden 并选择bu默认值。这会给人一种错觉 选项卡项 已选中。隐藏 选项卡项 您可以使用的选项 隐藏的 功能来自 shinyjs 包裹

    以下是修改后的 ui 代码:

    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))
        ))
    

    编辑1: 根据bu Joe给出的答案中的评论和参考 here 您可以按以下方式进行操作:

    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)
    

    编辑2:

    这里有一种稍微不同的方法,不使用 renderUI 和使用 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)
    

    希望有帮助!