1

下面的 R 闪亮脚本在 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)

子项捕获

4

1 回答 1

4

您可以创建一个虚拟tabItem对象hidden并选择该 bu 默认值。这将给出没有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： 根据此处给出的答案的评论和参考，您可以按以下方式进行操作：

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)

希望能帮助到你！

于 2018-01-23T05:23:11.040 回答