在 R shiny 仪表板的多个菜单项中使用 UIOutput

Question

下面的 R shiny 脚本在 subItem1 中显示 "output$brand_selector" 输出。我希望在 subItem2 和 subItem3 中显示相同的输出。请帮忙，当我打开仪表板时，默认情况下会出现输出，我希望仅当我单击子项目时才显示它，谢谢，请帮忙。

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)

Answer 1

您可以创建一个虚拟 tabItem，即默认的 hidden 和 select。这会给人一种错觉，即没有 tabItem 被 selected。要隐藏 tabItem 选项，您可以使用 shinyjs 包中的 hidden 函数。

以下是修改后的 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)

希望对您有所帮助！

在 R shiny 仪表板的多个菜单项中使用 UIOutput

Usage of UIOutput in multiple menuItems in R shiny dashboard

r

shiny

shinydashboard

shinyapps