简体   繁体   English

如何根据闪亮仪表板中的活动选项卡使条件面板显示菜单项

[英]How to make conditionalPanel show menu item based on active tab in shinydashboard

I am trying to make a shinydashboard with a bunch of different tabs that show up for different types of data.我正在尝试制作一个带有一堆不同选项卡的闪亮仪表板,这些选项卡显示不同类型的数据。 What I want is when a certain tabItem is selected, for a selectInput item to show up in the sidebar.我想要的是选择某个tabiTem时,要在侧边栏中显示SelectInput项目。 (Eventually I would like for this to happen for multiple tabs, but I will work on just one tab for now.) (最终我希望这发生在多个选项卡上,但我现在只处理一个选项卡。)

Here's an executable example of what I want:这是我想要的一个可执行示例:


library(shiny)
library(shinythemes)
library(shinydashboard)
library(tidyverse)

options(warn=-1)
data(iris)
data(mtcars)

tabset1 = tabsetPanel(id = "mtcars",
                            tabPanel(id = "mtplots","mtcars plots",
                                     fluidRow(box(title = "Plot1", plotOutput("mtcarsplot1"))
                            )),
                            
                            
                            tabPanel(id = "mttable","MTcars tables",
                                     fluidRow(box(title = "Table 1",  tableOutput("mtcarstable1")))
                            ))



tabset2 = tabsetPanel(id = "iris",
                      tabPanel(id = "iris","iris plots",
                               fluidRow(box(title = "Plot1", plotOutput("irisplot1"))
                               )),
                      
                      
                      tabPanel(id = "mttable","iris tables",
                               fluidRow(box(title = "Table 1",  tableOutput("iristable1")))
                      ))




# Define UI for application that draws a histogram
ui <- dashboardPage(

  
  dashboardHeader(),
  
  
  dashboardSidebar(
    sidebarMenu(
    menuItem("MTCARS", tabName = "mt", icon = icon("user-tie")),
    selectInput("mtvar", "Choose a variable", choices = colnames(mtcars)),
    sliderInput("mtlines", "Number of lines", 1,50,10),
    

# **I would like a conditionalPanel here such that if the tab mtplots is selected, a selectInput as below shows up - but only is visible for that tab **

#selectInput("colorvar", "choose a color", choices = c("red", "yellow", "green", "blue"))


menuItem("IRIS", icon = icon("envelope-open-text"), tabName = "ir"),    
    selectInput("irvar", "Choose a variable", choices = colnames(iris)),
    sliderInput("irislines", "Number of lines", 1,50,10)
    )
  ),
  
  dashboardBody(
    tabItems(
      tabItem("ir", tabset2),
      tabItem("mt", tabset1)
      )
      
    )
  )






# Begin Server ----------------------------------------------

server <- function(input, output, session) {
 
  output$mtcarsplot1=renderPlot({
    
    
    ggplot(mtcars, aes_string(x = input$mtvar)) + geom_histogram()
    
    
  })
  
  output$irisplot1=renderPlot({
    ggplot(iris, aes_string(x = input$irvar)) + geom_histogram()
    
    
  })
  
  
  output$mtcarstable1=renderTable({
    head(mtcars, input$mtlines)
    
  })
 
  
  output$iristable1=renderTable({
    head(iris, input$irislines)
    
  })
  
  
  
  
}

shinyApp(ui, server)

You can use input$mtcars to determine which tab in the tabsetPanel is active.您可以使用input$mtcars来确定 tabsetPanel 中的哪个选项卡处于活动状态。 To render a dynamic/conditional UI element, you can use uiOutput/renderUI .要呈现动态/条件 UI 元素,您可以使用uiOutput/renderUI In renderUI , I use req to only render it if the correct tabPanel is chosen:renderUI中,我使用req仅在选择了正确的 tabPanel 时才呈现它:

library(shiny)
library(shinythemes)
library(shinydashboard)
library(tidyverse)

data(iris)
data(mtcars)

tabset1 = tabsetPanel(id = "mtcars",
                      tabPanel(id = "mtplots","mtcars plots",
                               fluidRow(box(title = "Plot1", plotOutput("mtcarsplot1"))
                               )),
                      
                      
                      tabPanel(id = "mttable","MTcars tables",
                               fluidRow(box(title = "Table 1",  tableOutput("mtcarstable1")))
                      ))



tabset2 = tabsetPanel(id = "iris",
                      tabPanel(id = "iris","iris plots",
                               fluidRow(box(title = "Plot1", plotOutput("irisplot1"))
                               )),
                      
                      
                      tabPanel(id = "mttable","iris tables",
                               fluidRow(box(title = "Table 1",  tableOutput("iristable1")))
                      ))




# Define UI for application that draws a histogram
ui <- dashboardPage(
  
  
  dashboardHeader(),
  
  
  dashboardSidebar(
    sidebarMenu(
      menuItem("MTCARS", tabName = "mt", icon = icon("user-tie")),
      selectInput("mtvar", "Choose a variable", choices = colnames(mtcars)),
      sliderInput("mtlines", "Number of lines", 1,50,10),
      
      
      # **I would like a conditionalPanel here such that if the tab mtplots is selected, a selectInput as below shows up - but only is visible for that tab **
      
      
      uiOutput("UI_conditional_input"),
      
      menuItem("IRIS", icon = icon("envelope-open-text"), tabName = "ir"),    
      selectInput("irvar", "Choose a variable", choices = colnames(iris)),
      sliderInput("irislines", "Number of lines", 1,50,10)
    )
  ),
  
  dashboardBody(
    tabItems(
      tabItem("ir", tabset2),
      tabItem("mt", tabset1)
    )
    
  )
)






# Begin Server ----------------------------------------------

server <- function(input, output, session) {
  
  output$mtcarsplot1=renderPlot({
    
    
    ggplot(mtcars, aes_string(x = input$mtvar)) + geom_histogram()
    
    
  })
  
  output$irisplot1=renderPlot({
    ggplot(iris, aes_string(x = input$irvar)) + geom_histogram()
    
    
  })
  
  
  output$mtcarstable1=renderTable({
    head(mtcars, input$mtlines)
    
  })
  
  
  output$iristable1=renderTable({
    head(iris, input$irislines)
    
  })
  
  output$UI_conditional_input <- renderUI({
    req(input$mtcars == "mtcars plots")
    selectInput("colorvar", "choose a color", choices = c("red", "yellow", "green", "blue"))
    
  })
  
  
  
  
}

shinyApp(ui, server)

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM