我正在尝试制作一个带有一堆不同选项卡的shinydashboard，这些选项卡显示不同类型的数据。我想要的是当某个tabItem被选中时，selectInput项目会显示在侧边栏中。(最终，我希望这种情况发生在多个选项卡上，但我现在只处理一个选项卡。(
下面是一个我想要的可执行示例：
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)
您可以使用input$mtcars来确定tabsetPanel中的哪个选项卡处于活动状态。要渲染动态/条件UI元素，可以使用uiOutput/renderUI。在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)