Question

下面的R闪亮脚本显示＆＃34;输出$ brand_selector＆＃34; subItem1中的输出。我希望在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并选择该默认值。这会产生错误，即没有选择tabItem。要隐藏tabItem选项，您可以使用hidden包中的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))
    ))

<强> EDIT1：根据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)

<强> EDIT2：

这是一种略有不同的方法，不使用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闪亮仪表板中的多个menuItem中使用UIOutput

1 个答案: